Commit 2ed67559 authored by simonmar's avatar simonmar

[project @ 2004-03-10 11:17:38 by simonmar]

remove dependencies on hslibs packages
parent 8ec8a8c0
......@@ -17,6 +17,6 @@ test('arr010', normal, compile_and_run, [''])
test('arr011', normal, compile_and_run, [''])
test('arr012', normal, compile_and_run, [''])
test('arr013', normal, compile_and_run, [''])
test('arr014', normal, compile_and_run, ['-package lang'])
test('arr014', normal, compile_and_run, [''])
test('arr015', normal, compile_and_run, [''])
test('arr016', normal, compile_and_run, ['-fglasgow-exts'])
-- !!! multi-dimensional arrays
module Main ( main ) where
import ST
import Array
import Control.Monad.ST
import Data.Array.ST
type TwoD s = STArray s Int (STArray s Int Int)
......@@ -14,10 +14,10 @@ setup = let isz = 10
do
-- gives : undefined reference to `IOBase_error_closure'
-- x <- newArray (0, omax) (error "uninitialised")
dmy <- newSTArray (0, imax) 0
x <- newSTArray (0, omax) dmy
as <- (sequence . replicate osz) (newSTArray (0, imax) 6)
mapM_ (\(i,v) -> writeSTArray x i v) (zip [0..omax] as)
dmy <- newArray (0, imax) 0
x <- newArray (0, omax) dmy
as <- (sequence . replicate osz) (newArray (0, imax) 6)
mapM_ (\(i,v) -> writeArray x i v) (zip [0..omax] as)
return x
main :: IO ()
......
......@@ -25,7 +25,7 @@ test('cg024', normal, compile_and_run, [''])
test('cg025', compose(extra_run_opts('cg025.hs'),exit_code(1)), \
compile_and_run, [''])
test('cg026', normal, compile_and_run, ['-fglasgow-exts -package lang'])
test('cg026', normal, compile_and_run, [''])
test('cg027', normal, compile_and_run, [''])
test('cg028', normal, compile_and_run, [''])
test('cg031', normal, compile_and_run, ['-fglasgow-exts'])
......@@ -38,9 +38,8 @@ test('cg037', normal, compile_and_run, [''])
test('cg038', normal, compile_and_run, [''])
test('cg039', normal, compile_and_run, [''])
test('cg040', normal, compile_and_run, [''])
test('cg042', normal, compile_and_run, ['-fglasgow-exts -package lang'])
test('cg043', normal, compile_and_run, [''])
test('cg044', normal, compile_and_run, ['-cpp -package lang'])
test('cg044', normal, compile_and_run, [''])
test('cg045', exit_code(1), compile_and_run, [''])
test('cg046', normal, compile_and_run, [''])
test('cg047', normal, compile_and_run, [''])
......
{-# OPTIONS -fglasgow-exts #-}
-- !!! simple tests of primitive arrays
--
module Main ( main ) where
import GHC.Exts
import Char ( chr )
import Data.Char ( chr )
import Addr
import ST
import ST
import MutableArray
import ByteArray
import Control.Monad.ST
import Data.Array.ST
import Data.Array.Unboxed
import Ratio
import Array
import Data.Ratio
main = putStr
(test_chars ++ "\n" ++
......@@ -32,33 +31,33 @@ test_chars
in
shows (lookup_range arr# 42# 416#) "\n"
where
f :: Int -> ByteArray Int
f :: Int -> UArray Int Char
f size@(I# size#)
= runST (
-- allocate an array of the specified size
newCharArray (0, (size-1)) >>= \ arr# ->
newArray_ (0, (size-1)) >>= \ arr# ->
-- fill in all elements; elem i has "i" put in it
fill_in arr# 0# (size# -# 1#) >>
-- freeze the puppy:
freezeByteArray arr#
freeze arr#
)
fill_in :: MutableByteArray s Int -> Int# -> Int# -> ST s ()
fill_in :: STUArray s Int Char -> Int# -> Int# -> ST s ()
fill_in arr_in# first# last#
= if (first# ># last#)
then return ()
else writeCharArray arr_in# (I# first#) ((chr (I# first#))) >>
else writeArray arr_in# (I# first#) ((chr (I# first#))) >>
fill_in arr_in# (first# +# 1#) last#
lookup_range :: ByteArray Int -> Int# -> Int# -> [Char]
lookup_range :: UArray Int Char -> Int# -> Int# -> [Char]
lookup_range arr from# to#
= if (from# ># to#)
then []
else (indexCharArray arr (I# from#))
else (arr ! (I# from#))
: (lookup_range arr (from# +# 1#) to#)
-- Arr# Int# -------------------------------------------
......@@ -69,33 +68,33 @@ test_ints
in
shows (lookup_range arr# 42# 416#) "\n"
where
f :: Int -> ByteArray Int
f :: Int -> UArray Int Int
f size@(I# size#)
= runST (
-- allocate an array of the specified size
newIntArray (0, (size-1)) >>= \ arr# ->
newArray_ (0, (size-1)) >>= \ arr# ->
-- fill in all elements; elem i has i^2 put in it
fill_in arr# 0# (size# -# 1#) >>
-- freeze the puppy:
freezeByteArray arr#
freeze arr#
)
fill_in :: MutableByteArray s Int -> Int# -> Int# -> ST s ()
fill_in :: STUArray s Int Int -> Int# -> Int# -> ST s ()
fill_in arr_in# first# last#
= if (first# ># last#)
then return ()
else writeIntArray arr_in# (I# first#) (I# (first# *# first#)) >>
else writeArray arr_in# (I# first#) (I# (first# *# first#)) >>
fill_in arr_in# (first# +# 1#) last#
lookup_range :: ByteArray Int -> Int# -> Int# -> [Int]
lookup_range :: UArray Int Int -> Int# -> Int# -> [Int]
lookup_range arr from# to#
= if (from# ># to#)
then []
else (indexIntArray arr (I# from#))
else (arr ! (I# from#))
: (lookup_range arr (from# +# 1#) to#)
-- Arr# Addr# -------------------------------------------
......@@ -106,37 +105,37 @@ test_addrs
in
shows (lookup_range arr# 42# 416#) "\n"
where
f :: Int -> ByteArray Int
f :: Int -> UArray Int (Ptr ())
f size@(I# size#)
= runST (
-- allocate an array of the specified size
newAddrArray (0, (size-1)) >>= \ arr# ->
newArray_ (0, (size-1)) >>= \ arr# ->
-- fill in all elements; elem i has i^2 put in it
fill_in arr# 0# (size# -# 1#) >>
-- freeze the puppy:
freezeByteArray arr#
freeze arr#
)
fill_in :: MutableByteArray s Int -> Int# -> Int# -> ST s ()
fill_in :: STUArray s Int (Ptr ()) -> Int# -> Int# -> ST s ()
fill_in arr_in# first# last#
= if (first# ># last#)
then return ()
else writeAddrArray arr_in# (I# first#)
(A# (int2Addr# (first# *# first#))) >>
else writeArray arr_in# (I# first#)
(Ptr (int2Addr# (first# *# first#))) >>
fill_in arr_in# (first# +# 1#) last#
lookup_range :: ByteArray Int -> Int# -> Int# -> [ Int ]
lookup_range :: UArray Int (Ptr ()) -> Int# -> Int# -> [ Int ]
lookup_range arr from# to#
= let
a2i (A# a#) = I# (addr2Int# a#)
a2i (Ptr a#) = I# (addr2Int# a#)
in
if (from# ># to#)
then []
else (a2i (indexAddrArray arr (I# from#)))
else (a2i (arr ! (I# from#)))
: (lookup_range arr (from# +# 1#) to#)
-- Arr# Float# -------------------------------------------
......@@ -147,21 +146,21 @@ test_floats
in
shows (lookup_range arr# 42# 416#) "\n"
where
f :: Int -> ByteArray Int
f :: Int -> UArray Int Float
f size@(I# size#)
= runST (
-- allocate an array of the specified size
newFloatArray (0, (size-1)) >>= \ arr# ->
newArray_ (0, (size-1)) >>= \ arr# ->
-- fill in all elements; elem i has "i * pi" put in it
fill_in arr# 0# (size# -# 1#) >>
-- freeze the puppy:
freezeByteArray arr#
freeze arr#
)
fill_in :: MutableByteArray s Int -> Int# -> Int# -> ST s ()
fill_in :: STUArray s Int Float -> Int# -> Int# -> ST s ()
fill_in arr_in# first# last#
= if (first# ># last#)
......@@ -170,14 +169,14 @@ test_floats
in trace (show e) $ writeFloatArray arr_in# (I# first#) e >>
fill_in arr_in# (first# +# 1#) last#
-}
else writeFloatArray arr_in# (I# first#) ((fromIntegral (I# first#)) * pi) >>
else writeArray arr_in# (I# first#) ((fromIntegral (I# first#)) * pi) >>
fill_in arr_in# (first# +# 1#) last#
lookup_range :: ByteArray Int -> Int# -> Int# -> [Float]
lookup_range :: UArray Int Float -> Int# -> Int# -> [Float]
lookup_range arr from# to#
= if (from# ># to#)
then []
else (indexFloatArray arr (I# from#))
else (arr ! (I# from#))
: (lookup_range arr (from# +# 1#) to#)
-- Arr# Double# -------------------------------------------
......@@ -188,33 +187,33 @@ test_doubles
in
shows (lookup_range arr# 42# 416#) "\n"
where
f :: Int -> ByteArray Int
f :: Int -> UArray Int Double
f size@(I# size#)
= runST (
-- allocate an array of the specified size
newDoubleArray (0, (size-1)) >>= \ arr# ->
newArray_ (0, (size-1)) >>= \ arr# ->
-- fill in all elements; elem i has "i * pi" put in it
fill_in arr# 0# (size# -# 1#) >>
-- freeze the puppy:
freezeByteArray arr#
freeze arr#
)
fill_in :: MutableByteArray s Int -> Int# -> Int# -> ST s ()
fill_in :: STUArray s Int Double -> Int# -> Int# -> ST s ()
fill_in arr_in# first# last#
= if (first# ># last#)
then return ()
else writeDoubleArray arr_in# (I# first#) ((fromIntegral (I# first#)) * pi) >>
else writeArray arr_in# (I# first#) ((fromIntegral (I# first#)) * pi) >>
fill_in arr_in# (first# +# 1#) last#
lookup_range :: ByteArray Int -> Int# -> Int# -> [Double]
lookup_range :: UArray Int Double -> Int# -> Int# -> [Double]
lookup_range arr from# to#
= if (from# ># to#)
then []
else (indexDoubleArray arr (I# from#))
else (arr ! (I# from#))
: (lookup_range arr (from# +# 1#) to#)
-- Arr# (Ratio Int) (ptrs) ---------------------------------
......@@ -230,10 +229,10 @@ test_ptrs
f size
= runST (
newSTArray (1, size) (3 % 5) >>= \ arr# ->
newArray (1, size) (3 % 5) >>= \ arr# ->
-- don't fill in the whole thing
fill_in arr# 1 400 >>
freezeSTArray arr#
freeze arr#
)
fill_in :: STArray s Int (Ratio Int) -> Int -> Int -> ST s ()
......@@ -241,7 +240,7 @@ test_ptrs
fill_in arr_in# first last
= if (first > last)
then return ()
else writeSTArray arr_in# first (fromIntegral (first * first)) >>
else writeArray arr_in# first (fromIntegral (first * first)) >>
fill_in arr_in# (first + 1) last
lookup_range :: Array Int (Ratio Int) -> Int -> Int -> [Ratio Int]
......
"*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~\DEL\128\129\130\131\132\133\134\135\136\137\138\139\140\141\142\143\144\145\146\147\148\149\150\151\152\153\154\155\156\157\158\159\160\161\162\163\164\165\166\167\168\169\170\171\172\173\174\175\176\177\178\179\180\181\182\183\184\185\186\187\188\189\190\191\192\193\194\195\196\197\198\199\200\201\202\203\204\205\206\207\208\209\210\211\212\213\214\215\216\217\218\219\220\221\222\223\224\225\226\227\228\229\230\231\232\233\234\235\236\237\238\239\240\241\242\243\244\245\246\247\248\249\250\251\252\253\254\255\NUL\SOH\STX\ETX\EOT\ENQ\ACK\a\b\t\n\v\f\r\SO\SI\DLE\DC1\DC2\DC3\DC4\NAK\SYN\ETB\CAN\EM\SUB\ESC\FS\GS\RS\US !\"#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~\DEL\128\129\130\131\132\133\134\135\136\137\138\139\140\141\142\143\144\145\146\147\148\149\150\151\152\153\154\155\156\157\158\159\160"
"*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\\]^_`abcdefghijklmnopqrstuvwxyz{|}~\DEL\128\129\130\131\132\133\134\135\136\137\138\139\140\141\142\143\144\145\146\147\148\149\150\151\152\153\154\155\156\157\158\159\160\161\162\163\164\165\166\167\168\169\170\171\172\173\174\175\176\177\178\179\180\181\182\183\184\185\186\187\188\189\190\191\192\193\194\195\196\197\198\199\200\201\202\203\204\205\206\207\208\209\210\211\212\213\214\215\216\217\218\219\220\221\222\223\224\225\226\227\228\229\230\231\232\233\234\235\236\237\238\239\240\241\242\243\244\245\246\247\248\249\250\251\252\253\254\255\256\257\258\259\260\261\262\263\264\265\266\267\268\269\270\271\272\273\274\275\276\277\278\279\280\281\282\283\284\285\286\287\288\289\290\291\292\293\294\295\296\297\298\299\300\301\302\303\304\305\306\307\308\309\310\311\312\313\314\315\316\317\318\319\320\321\322\323\324\325\326\327\328\329\330\331\332\333\334\335\336\337\338\339\340\341\342\343\344\345\346\347\348\349\350\351\352\353\354\355\356\357\358\359\360\361\362\363\364\365\366\367\368\369\370\371\372\373\374\375\376\377\378\379\380\381\382\383\384\385\386\387\388\389\390\391\392\393\394\395\396\397\398\399\400\401\402\403\404\405\406\407\408\409\410\411\412\413\414\415\416"
[1764,1849,1936,2025,2116,2209,2304,2401,2500,2601,2704,2809,2916,3025,3136,3249,3364,3481,3600,3721,3844,3969,4096,4225,4356,4489,4624,4761,4900,5041,5184,5329,5476,5625,5776,5929,6084,6241,6400,6561,6724,6889,7056,7225,7396,7569,7744,7921,8100,8281,8464,8649,8836,9025,9216,9409,9604,9801,10000,10201,10404,10609,10816,11025,11236,11449,11664,11881,12100,12321,12544,12769,12996,13225,13456,13689,13924,14161,14400,14641,14884,15129,15376,15625,15876,16129,16384,16641,16900,17161,17424,17689,17956,18225,18496,18769,19044,19321,19600,19881,20164,20449,20736,21025,21316,21609,21904,22201,22500,22801,23104,23409,23716,24025,24336,24649,24964,25281,25600,25921,26244,26569,26896,27225,27556,27889,28224,28561,28900,29241,29584,29929,30276,30625,30976,31329,31684,32041,32400,32761,33124,33489,33856,34225,34596,34969,35344,35721,36100,36481,36864,37249,37636,38025,38416,38809,39204,39601,40000,40401,40804,41209,41616,42025,42436,42849,43264,43681,44100,44521,44944,45369,45796,46225,46656,47089,47524,47961,48400,48841,49284,49729,50176,50625,51076,51529,51984,52441,52900,53361,53824,54289,54756,55225,55696,56169,56644,57121,57600,58081,58564,59049,59536,60025,60516,61009,61504,62001,62500,63001,63504,64009,64516,65025,65536,66049,66564,67081,67600,68121,68644,69169,69696,70225,70756,71289,71824,72361,72900,73441,73984,74529,75076,75625,76176,76729,77284,77841,78400,78961,79524,80089,80656,81225,81796,82369,82944,83521,84100,84681,85264,85849,86436,87025,87616,88209,88804,89401,90000,90601,91204,91809,92416,93025,93636,94249,94864,95481,96100,96721,97344,97969,98596,99225,99856,100489,101124,101761,102400,103041,103684,104329,104976,105625,106276,106929,107584,108241,108900,109561,110224,110889,111556,112225,112896,113569,114244,114921,115600,116281,116964,117649,118336,119025,119716,120409,121104,121801,122500,123201,123904,124609,125316,126025,126736,127449,128164,128881,129600,130321,131044,131769,132496,133225,133956,134689,135424,136161,136900,137641,138384,139129,139876,140625,141376,142129,142884,143641,144400,145161,145924,146689,147456,148225,148996,149769,150544,151321,152100,152881,153664,154449,155236,156025,156816,157609,158404,159201,160000,160801,161604,162409,163216,164025,164836,165649,166464,167281,168100,168921,169744,170569,171396,172225,173056]
......
-- !!! mutable Double array test (ncg test)
--
module Main ( main ) where
import GHC.Exts
import ByteArray
import MutableArray
import ST
import Ratio -- 1.3
import Array -- 1.3
main = --primIOToIO (newDoubleArray (0,1) >>= \ arr -> readDoubleArray arr 0) >>= print
putStr test_doubles
test_doubles :: String
test_doubles
= let arr# = f 1000
in
shows (lookup_range arr# 42# 416#) "\n"
where
f :: Int -> ByteArray Int
f size@(I# size#)
= runST (
-- allocate an array of the specified size
newDoubleArray (0, (size-1)) >>= \ arr# ->
-- fill in all elements; elem i has "i * pi" put in it
fill_in arr# 0# (size# -# 1#) >>
-- freeze the puppy:
freezeByteArray arr#
)
fill_in :: MutableByteArray s Int -> Int# -> Int# -> ST s ()
fill_in arr_in# first# last#
= if (first# ># last#)
then return ()
else writeDoubleArray arr_in# (I# first#) ((fromIntegral (I# first#)) * pi) >>
fill_in arr_in# (first# +# 1#) last#
lookup_range :: ByteArray Int -> Int# -> Int# -> [Double]
lookup_range arr from# to#
= if (from# ># to#)
then []
else (indexDoubleArray arr (I# from#))
: (lookup_range arr (from# +# 1#) to#)
[131.94689145077132,135.0884841043611,138.23007675795088,141.3716694115407,144.51326206513048,147.6548547187203,150.79644737231007,153.93804002589985,157.07963267948966,160.22122533307945,163.36281798666926,166.50441064025904,169.64600329384882,172.78759594743863,175.92918860102841,179.0707812546182,182.212373908208,185.3539665617978,188.49555921538757,191.63715186897738,194.77874452256717,197.92033717615698,201.06192982974676,204.20352248333654,207.34511513692635,210.48670779051614,213.62830044410595,216.76989309769573,219.9114857512855,223.05307840487532,226.1946710584651,229.3362637120549,232.4778563656447,235.61944901923448,238.76104167282426,241.90263432641407,245.04422698000386,248.18581963359367,251.32741228718345,254.46900494077323,257.610597594363,260.75219024795285,263.89378290154264,267.0353755551324,270.1769682087222,273.318560862312,276.46015351590177,279.6017461694916,282.7433388230814,285.88493147667117,289.02652413026095,292.16811678385073,295.3097094374406,298.45130209103036,301.59289474462014,304.7344873982099,307.8760800517997,311.01767270538954,314.1592653589793,317.3008580125691,320.4424506661589,323.5840433197487,326.7256359733385,329.8672286269283,333.0088212805181,336.15041393410786,339.29200658769764,342.4335992412874,345.57519189487726,348.71678454846705,351.85837720205683,354.9999698556466,358.1415625092364,361.28315516282623,364.424747816416,367.5663404700058,370.7079331235956,373.84952577718536,376.99111843077515,380.132711084365,383.27430373795477,386.41589639154455,389.55748904513433,392.6990816987241,395.84067435231395,398.98226700590374,402.1238596594935,405.2654523130833,408.4070449666731,411.5486376202629,414.6902302738527,417.8318229274425,420.97341558103227,424.11500823462205,427.2566008882119,430.3981935418017,433.53978619539146,436.68137884898124,439.822971502571,442.9645641561608,446.10615680975064,449.2477494633404,452.3893421169302,455.53093477052,458.6725274241098,461.8141200776996,464.9557127312894,468.0973053848792,471.23889803846896,474.38049069205874,477.5220833456485,480.66367599923836,483.80526865282815,486.94686130641793,490.0884539600077,493.2300466135975,496.37163926718733,499.5132319207771,502.6548245743669,505.7964172279567,508.93800988154646,512.0796025351362,515.221195188726,518.3627878423158,521.5043804959057,524.6459731494955,527.7875658030853,530.929158456675,534.0707511102648,537.2123437638546,540.3539364174444,543.4955290710342,546.637121724624,549.7787143782137,552.9203070318035,556.0618996853934,559.2034923389832,562.345084992573,565.4866776461628,568.6282702997526,571.7698629533423,574.9114556069321,578.0530482605219,581.1946409141117,584.3362335677015,587.4778262212914,590.6194188748811,593.7610115284709,596.9026041820607,600.0441968356505,603.1857894892403,606.3273821428301,609.4689747964198,612.6105674500096,615.7521601035994,618.8937527571892,622.0353454107791,625.1769380643689,628.3185307179587,631.4601233715484,634.6017160251382,637.743308678728,640.8849013323178,644.0264939859076,647.1680866394973,650.3096792930871,653.451271946677,656.5928646002668,659.7344572538566,662.8760499074464,666.0176425610362,669.1592352146259,672.3008278682157,675.4424205218055,678.5840131753953,681.7256058289851,684.8671984825748,688.0087911361647,691.1503837897545,694.2919764433443,697.4335690969341,700.5751617505239,703.7167544041137,706.8583470577034,709.9999397112932,713.141532364883,716.2831250184728,719.4247176720626,722.5663103256525,725.7079029792422,728.849495632832,731.9910882864218,735.1326809400116,738.2742735936014,741.4158662471912,744.557458900781,747.6990515543707,750.8406442079605,753.9822368615503,757.1238295151402,760.26542216873,763.4070148223198,766.5486074759095,769.6902001294993,772.8317927830891,775.9733854366789,779.1149780902687,782.2565707438584,785.3981633974482,788.5397560510381,791.6813487046279,794.8229413582177,797.9645340118075,801.1061266653973,804.247719318987,807.3893119725768,810.5309046261666,813.6724972797564,816.8140899333462,819.955682586936,823.0972752405258,826.2388678941156,829.3804605477054,832.5220532012952,835.663645854885,838.8052385084748,841.9468311620645,845.0884238156543,848.2300164692441,851.3716091228339,854.5132017764238,857.6547944300136,860.7963870836033,863.9379797371931,867.0795723907829,870.2211650443727,873.3627576979625,876.5043503515523,879.645943005142,882.7875356587318,885.9291283123216,889.0707209659115,892.2123136195013,895.3539062730911,898.4954989266809,901.6370915802706,904.7786842338604,907.9202768874502,911.06186954104,914.2034621946298,917.3450548482195,920.4866475018093,923.6282401553992,926.769832808989,929.9114254625788,933.0530181161686,936.1946107697584,939.3362034233481,942.4777960769379,945.6193887305277,948.7609813841175,951.9025740377073,955.044166691297,958.185759344887,961.3273519984767,964.4689446520665,967.6105373056563,970.7521299592461,973.8937226128359,977.0353152664256,980.1769079200154,983.3185005736052,986.460093227195,989.6016858807849,992.7432785343747,995.8848711879644,999.0264638415542,1002.168056495144,1005.3096491487338,1008.4512418023236,1011.5928344559134,1014.7344271095031,1017.8760197630929,1021.0176124166827,1024.1592050702725,1027.3007977238624,1030.442390377452,1033.583983031042,1036.7255756846316,1039.8671683382215,1043.0087609918114,1046.150353645401,1049.291946298991,1052.4335389525806,1055.5751316061705,1058.7167242597602,1061.85831691335,1064.9999095669398,1068.1415022205297,1071.2830948741193,1074.4246875277092,1077.5662801812991,1080.7078728348888,1083.8494654884787,1086.9910581420684,1090.1326507956583,1093.274243449248,1096.4158361028378,1099.5574287564275,1102.6990214100174,1105.840614063607,1108.982206717197,1112.1237993707869,1115.2653920243765,1118.4069846779664,1121.548577331556,1124.690169985146,1127.8317626387357,1130.9733552923256,1134.1149479459152,1137.2565405995051,1140.398133253095,1143.5397259066847,1146.6813185602746,1149.8229112138642,1152.9645038674541,1156.1060965210438,1159.2476891746337,1162.3892818282234,1165.5308744818133,1168.672467135403,1171.8140597889928,1174.9556524425827,1178.0972450961724,1181.2388377497623,1184.380430403352,1187.5220230569419,1190.6636157105315,1193.8052083641214,1196.946801017711,1200.088393671301,1203.2299863248907,1206.3715789784806,1209.5131716320705,1212.6547642856601,1215.79635693925,1218.9379495928397,1222.0795422464296,1225.2211349000193,1228.3627275536091,1231.5043202071988,1234.6459128607887,1237.7875055143784,1240.9290981679683,1244.0706908215582,1247.2122834751478,1250.3538761287377,1253.4954687823274,1256.6370614359173,1259.778654089507,1262.9202467430969,1266.0618393966865,1269.2034320502764,1272.345024703866,1275.486617357456,1278.628210011046,1281.7698026646356,1284.9113953182255,1288.0529879718151,1291.194580625405,1294.3361732789947,1297.4777659325846,1300.6193585861743,1303.7609512397642,1306.902543893354]
{-# OPTIONS -cpp #-}
-- !!! Testing IEEE Float and Double extremity predicates.
module Main(main) where
import Char
import ST
import MutableArray
import Data.Char
import Control.Monad.ST
import Data.Word
import Data.Array.ST
#include "config.h"
......@@ -38,7 +40,7 @@ double_numbers :: [Double]
double_numbers =
[ 0
, encodeFloat 0 0 -- 0 using encodeFloat method
, mkDouble (map chr (reverse_if_bigendian [0,0,0,0,0,0, 0xf0, 0x7f])) -- +inf
, mkDouble (reverse_if_bigendian [0,0,0,0,0,0, 0xf0, 0x7f]) -- +inf
, encodeFloat 1 2047 -- +Inf
, encodeFloat 1 2048
, encodeFloat 1 2047 -- signalling NaN
......@@ -173,12 +175,13 @@ doubleOrFloat ls
-- make a double from a list of 8 bytes
-- (caller deals with byte ordering.)
mkDouble :: [Char] -> Double
mkDouble :: [Word8] -> Double
mkDouble ls =
runST ( do
arr <- newCharArray (0,7)
sequence (zipWith (writeCharArray arr) [(0::Int)..] (take 8 ls))
readDoubleArray arr 0
arr <- newArray_ (0,7)
sequence (zipWith (writeArray arr) [(0::Int)..] (take 8 ls))
arr' <- castSTUArray arr
readArray arr' 0
)
showAndPerform :: (Show a, Show b)
......
......@@ -39,7 +39,7 @@ test('ds031', normal, compile, [''])
test('ds032', normal, compile, [''])
test('ds033', normal, compile, [''])
test('ds034', normal, compile, [''])
test('ds035', normal, compile, ['-fglasgow-exts -package lang'])
test('ds035', normal, compile, [''])
test('ds036', normal, compile, [''])
test('ds037', normal, compile, [''])
test('ds038', normal, compile, [''])
......@@ -53,7 +53,6 @@ test('ds045', normal, compile, [''])
test('ds046', normal, compile, ['-funbox-strict-fields'])
test('ds047', normal, compile, [''])
test('ds048', normal, compile, [''])
test('ds049', normal, compile, ['-package lang'])
test('ds050', normal, compile, ['-fglasgow-exts'])
test('ds051', normal, compile, [''])
test('ds052', expect_fail, compile, [''])
......
{-# OPTIONS -fglasgow-exts #-}
module ShouldCompile where
import GlaExts
import GHC.Exts
data CList = CNil | CCons Int# CList
......
{-# OPTIONS -fglasgow-exts #-}
module ShouldCompile where
-- !!! test lit-lits in patterns
import Addr
{- Litlits are deprecated, aren't they?!
litlit_int (``1'' :: Int) = 42
litlit_word (``1'' :: Word) = 42
litlit_char (`` '\n' '' :: Char) = 42
litlit_addr (``NULL'' :: Addr) = 42
litlit_float (``1.0'' :: Float) = 42
litlit_double (``1.0'' :: Double) = 42
-}
\ No newline at end of file
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment