From: sof Date: Sun, 27 Jul 1997 00:12:30 +0000 (+0000) Subject: [project @ 1997-07-27 00:11:16 by sof] X-Git-Tag: Approximately_1000_patches_recorded~186 X-Git-Url: http://git.megacz.com/?p=ghc-hetmet.git;a=commitdiff_plain;h=c0f0f9baf4c49acdeab981e503d8b7737ec74571 [project @ 1997-07-27 00:11:16 by sof] --- diff --git a/ghc/tests/codeGen/cg001.hs b/ghc/tests/codeGen/cg001.hs new file mode 100644 index 0000000..f60d045 --- /dev/null +++ b/ghc/tests/codeGen/cg001.hs @@ -0,0 +1,6 @@ +--!! cg001: main = -42 -- take 1 + +main = print ( f () ) + where + f :: a -> Int + f x = -42 diff --git a/ghc/tests/codeGen/cg001.stdout b/ghc/tests/codeGen/cg001.stdout new file mode 100644 index 0000000..6a0e60d --- /dev/null +++ b/ghc/tests/codeGen/cg001.stdout @@ -0,0 +1 @@ +-42 diff --git a/ghc/tests/codeGen/cg002.hs b/ghc/tests/codeGen/cg002.hs new file mode 100644 index 0000000..dddaabd --- /dev/null +++ b/ghc/tests/codeGen/cg002.hs @@ -0,0 +1,12 @@ +main = print ((f id2) (10 + thirty_two)) + where + f x = g x + where + g x = h x + where + h x = x + + thirty_two :: Int + thirty_two = 32 + +id2 x = x diff --git a/ghc/tests/codeGen/cg002.stdout b/ghc/tests/codeGen/cg002.stdout new file mode 100644 index 0000000..d81cc07 --- /dev/null +++ b/ghc/tests/codeGen/cg002.stdout @@ -0,0 +1 @@ +42 diff --git a/ghc/tests/codeGen/cg003.hs b/ghc/tests/codeGen/cg003.hs new file mode 100644 index 0000000..47b2d9e --- /dev/null +++ b/ghc/tests/codeGen/cg003.hs @@ -0,0 +1,11 @@ +main = print (id2 (id2 id2) (42::Int)) +-- where +-- id2 = s k k + +-- id2 x = s k k x + +id2 = s k k + +s x y z = x z (y z) + +k x y = x diff --git a/ghc/tests/codeGen/cg003.stdout b/ghc/tests/codeGen/cg003.stdout new file mode 100644 index 0000000..d81cc07 --- /dev/null +++ b/ghc/tests/codeGen/cg003.stdout @@ -0,0 +1 @@ +42 diff --git a/ghc/tests/codeGen/cg004.hs b/ghc/tests/codeGen/cg004.hs new file mode 100644 index 0000000..1f4a273 --- /dev/null +++ b/ghc/tests/codeGen/cg004.hs @@ -0,0 +1 @@ +main = print (length ([9,8,7,6,5,4,3,2,1] :: [Int])) diff --git a/ghc/tests/codeGen/cg004.stdout b/ghc/tests/codeGen/cg004.stdout new file mode 100644 index 0000000..ec63514 --- /dev/null +++ b/ghc/tests/codeGen/cg004.stdout @@ -0,0 +1 @@ +9 diff --git a/ghc/tests/codeGen/cg005.hs b/ghc/tests/codeGen/cg005.hs new file mode 100644 index 0000000..60cf856 --- /dev/null +++ b/ghc/tests/codeGen/cg005.hs @@ -0,0 +1,6 @@ +--!! answer: 65532 + +main = print foo + +foo :: Int +foo = ((1 + 2 + 32767 - 4) * 6) --later? `div` 3 diff --git a/ghc/tests/codeGen/cg005.stdout b/ghc/tests/codeGen/cg005.stdout new file mode 100644 index 0000000..12bd33f --- /dev/null +++ b/ghc/tests/codeGen/cg005.stdout @@ -0,0 +1 @@ +196596 diff --git a/ghc/tests/codeGen/cg006.hs b/ghc/tests/codeGen/cg006.hs new file mode 100644 index 0000000..609c3c2 --- /dev/null +++ b/ghc/tests/codeGen/cg006.hs @@ -0,0 +1,6 @@ +main = print (length thirteen_ones) + where + thirteen_ones = take (13::Int) ones + + ones :: [Int] + ones = 1 : ones diff --git a/ghc/tests/codeGen/cg006.stdout b/ghc/tests/codeGen/cg006.stdout new file mode 100644 index 0000000..b1bd38b --- /dev/null +++ b/ghc/tests/codeGen/cg006.stdout @@ -0,0 +1 @@ +13 diff --git a/ghc/tests/codeGen/cg007.hs b/ghc/tests/codeGen/cg007.hs new file mode 100644 index 0000000..317b921 --- /dev/null +++ b/ghc/tests/codeGen/cg007.hs @@ -0,0 +1,14 @@ +data Tree a = Leaf a | Branch (Tree a) (Tree a) + +main = print (height our_tree) + where + our_tree :: Tree Int + our_tree = + Branch (Branch (Leaf 1) (Branch (Branch (Leaf 1) (Leaf 1)) (Leaf 1))) + (Branch (Leaf 1) (Leaf 1)) + + +height :: Tree a -> Int + +height (Leaf _) = 1 +height (Branch t1 t2) = 1 + max (height t1) (height t2) diff --git a/ghc/tests/codeGen/cg007.stdout b/ghc/tests/codeGen/cg007.stdout new file mode 100644 index 0000000..7ed6ff8 --- /dev/null +++ b/ghc/tests/codeGen/cg007.stdout @@ -0,0 +1 @@ +5 diff --git a/ghc/tests/codeGen/cg008.hs b/ghc/tests/codeGen/cg008.hs new file mode 100644 index 0000000..1713b48 --- /dev/null +++ b/ghc/tests/codeGen/cg008.hs @@ -0,0 +1,12 @@ +main = print (length comp_list) + where + comp_list :: [(Int,Int)] + comp_list = [ (elem1,elem2) + | elem1 <- given_list, + elem2 <- given_list, + elem1 >= (4::Int), + elem2 < (3::Int) + ] + + given_list :: [Int] + given_list = [1,2,3,4,5,6,7,8,9] diff --git a/ghc/tests/codeGen/cg008.stdout b/ghc/tests/codeGen/cg008.stdout new file mode 100644 index 0000000..48082f7 --- /dev/null +++ b/ghc/tests/codeGen/cg008.stdout @@ -0,0 +1 @@ +12 diff --git a/ghc/tests/codeGen/cg009.hs b/ghc/tests/codeGen/cg009.hs new file mode 100644 index 0000000..de03fc4 --- /dev/null +++ b/ghc/tests/codeGen/cg009.hs @@ -0,0 +1,7 @@ +main = print (length take_list) + where + take_list :: [Int] + take_list = takeWhile (\ x -> x < 6) given_list + + given_list :: [Int] + given_list = [1,2,3,4,5,6,7,8,9] diff --git a/ghc/tests/codeGen/cg009.stdout b/ghc/tests/codeGen/cg009.stdout new file mode 100644 index 0000000..7ed6ff8 --- /dev/null +++ b/ghc/tests/codeGen/cg009.stdout @@ -0,0 +1 @@ +5 diff --git a/ghc/tests/codeGen/cg010.hs b/ghc/tests/codeGen/cg010.hs new file mode 100644 index 0000000..ccc323d --- /dev/null +++ b/ghc/tests/codeGen/cg010.hs @@ -0,0 +1,5 @@ +main = print a + where + a :: Int + b :: Int + (a, b) = (3 + 4, 5 + 6) diff --git a/ghc/tests/codeGen/cg010.stdout b/ghc/tests/codeGen/cg010.stdout new file mode 100644 index 0000000..7f8f011 --- /dev/null +++ b/ghc/tests/codeGen/cg010.stdout @@ -0,0 +1 @@ +7 diff --git a/ghc/tests/codeGen/cg011.hs b/ghc/tests/codeGen/cg011.hs new file mode 100644 index 0000000..e8efca4 --- /dev/null +++ b/ghc/tests/codeGen/cg011.hs @@ -0,0 +1,29 @@ +--!!! simple overloading example + +class Foo a where + foo :: a -> a -> Bool + +class (Foo a) => Bar a where + bar :: a -> a -> Bool + +instance Foo Int where + foo a b = a /= b + +instance Foo Bool where + foo a b = a /= b + +instance Bar Int where + bar a b = a < b + +instance Bar Bool where + bar a b = a < b + +foO = if bar (2::Int) (3::Int) then + if bar False True then + (42::Int) + else + (888::Int) + else + (999::Int) + +main = print foO diff --git a/ghc/tests/codeGen/cg011.stdout b/ghc/tests/codeGen/cg011.stdout new file mode 100644 index 0000000..d81cc07 --- /dev/null +++ b/ghc/tests/codeGen/cg011.stdout @@ -0,0 +1 @@ +42 diff --git a/ghc/tests/codeGen/cg012.hs b/ghc/tests/codeGen/cg012.hs new file mode 100644 index 0000000..1b2d6ae --- /dev/null +++ b/ghc/tests/codeGen/cg012.hs @@ -0,0 +1,38 @@ +--!!! move arguments around on the stacks, mainly the B stack + +import PrelBase ( Float#, Double#, Int#, Int(..) ) + + +main = print foo + +foo = I# + ( f 1.1## + 2.1# + True + 3.1## + 4.1# + 5.1## + 6.1## + 42# -- the answer! + 7.1# + 8.1# ) + where + f :: Double# -> Float# -> Bool -> Double# -> Float# + -> Double# -> Double# -> Int# -> Float# -> Float# + -> Int# + f b1 s2 t b3 s4 b5 b6 i42 s7 s8 + -- evens, then odds + = g s2 b3 b5 i42 s8 b1 t s4 b6 s7 + + g :: Float# -> Double# -> Double# -> Int# -> Float# + -> Double# -> Bool -> Float# -> Double# -> Float# + -> Int# + g s2 b3 b5 i42 s8 b1 t s4 b6 s7 + -- powers of 2 backwards, then others forwards + = h s7 b6 t b5 s2 b3 i42 s8 b1 s4 + + h :: Float# -> Double# -> Bool -> Double# -> Float# + -> Double# -> Int# -> Float# -> Double# -> Float# + -> Int# + h s7 b6 t b5 s2 b3 i42 s8 b1 s4 + = i42 diff --git a/ghc/tests/codeGen/cg012.stdout b/ghc/tests/codeGen/cg012.stdout new file mode 100644 index 0000000..d81cc07 --- /dev/null +++ b/ghc/tests/codeGen/cg012.stdout @@ -0,0 +1 @@ +42 diff --git a/ghc/tests/codeGen/cg013.hs b/ghc/tests/codeGen/cg013.hs new file mode 100644 index 0000000..4d2f06d --- /dev/null +++ b/ghc/tests/codeGen/cg013.hs @@ -0,0 +1,78 @@ +{- +From: Kevin Hammond +To: partain +Subject: Nasty Overloading +Date: Wed, 23 Oct 91 16:19:46 BST +-} +module Main where + +class Foo a where + o1 :: a -> a -> Bool + o2 :: a -> Int + +-- o2 :: Int + -- Lennart: The type of method o2 does not contain the variable a + -- (and it must according to line 1 page 29 of the manual). + +class Foo tyvar => Bar tyvar where + o3 :: a -> tyvar -> tyvar + +-- class (Eq a, Foo a) => Baz a where +class (Ord a, Foo a) => Baz a where + o4 :: a -> a -> (String,String,String,a) + +instance (Ord a, Foo a) => Foo [a] where + o2 x = 100 + o1 a b = a < b || o1 (head a) (head b) + +-- instance Bar [a] where +instance (Ord a, Foo a) => Bar [a] where + o3 x l = [] + -- + -- Lennart: I guess the instance declaration + -- instance Bar [w] where + -- o3 x l = [] + -- is wrong because to be a Bar you have to be a Foo. For [w] to + -- be a Foo, w has to be Ord and Foo. But w is not Ord or Foo in + -- this instance declaration so it must be wrong. (Page 31, line + -- 7: The context c' must imply ...) + +instance Baz a => Baz [a] where + o4 [] [] = ("Nil", "Nil", "Nil", []) + o4 l1 l2 = + (if o1 l1 l2 then "Y" else "N", + if l1 == l2 then "Y" else "N", +-- if o4 (head l1) (head l2) then "Y" else "N", + case o4 (head l1) (head l2) of + (_,_,_,l3) -> if (o1 (head l1) l3) then "Y" else "N", + l1 ++ l2 ) + +instance Foo Int where + o2 x = x + o1 i j = i == j + +instance Bar Int where + o3 _ j = j + 1 + +instance Baz Int where +-- o4 i j = i > j + o4 i j = (if i>j then "Y" else "Z", "p", "q", i+j) +--simpl:o4 i j = ("Z", "p", "q", i+j) + +{- also works w/ glhc! -} + +main = if o4 [1,2,3] [1,3,2::Int] /= ("Y","N","Y",[1,2,3,1,3,2]) then + (print "43\n") + else (print "144\n") + +{- works: glhc +main = case o4 [1,2,3] [1,3,2::Int] of + (s1,s2,s3,x) -> print s1 + +main = case o4 ([]::[Int]) ([]::[Int]) of + (s1,s2,s3,x) -> print s1 +-} + +{- simple main: breaks nhc, works w/ glhc +main = case o4 (3::Int) (4::Int) of (s1,s2,s3,x) -> print s1 +-} diff --git a/ghc/tests/codeGen/cg013.stdout b/ghc/tests/codeGen/cg013.stdout new file mode 100644 index 0000000..a865e6b --- /dev/null +++ b/ghc/tests/codeGen/cg013.stdout @@ -0,0 +1 @@ +"43\n" diff --git a/ghc/tests/codeGen/cg014.hs b/ghc/tests/codeGen/cg014.hs new file mode 100644 index 0000000..bfa1ddf --- /dev/null +++ b/ghc/tests/codeGen/cg014.hs @@ -0,0 +1,3 @@ +--!! cg014: main = -42 -- twice: in Float and Double + +main = print ((show ( (-42) :: Float )) ++ " " ++ (show ( (-42) :: Double )) ++ "\n") diff --git a/ghc/tests/codeGen/cg014.stdout b/ghc/tests/codeGen/cg014.stdout new file mode 100644 index 0000000..6f6cbc5 --- /dev/null +++ b/ghc/tests/codeGen/cg014.stdout @@ -0,0 +1 @@ +"-42.0 -42.0\n" diff --git a/ghc/tests/codeGen/cg015.hs b/ghc/tests/codeGen/cg015.hs new file mode 100644 index 0000000..9c0f07b --- /dev/null +++ b/ghc/tests/codeGen/cg015.hs @@ -0,0 +1,26 @@ +module GHCmain ( mainPrimIO ) where + +import GlaExts +import PrelBase + +data CList = CNil | CCons Int# CList + +mk :: Int# -> CList +mk n = if (n ==# 0#) + then CNil + else CCons 1# (mk (n -# 1#)) + +clen :: CList -> Int# +clen CNil = 0# +clen (CCons _ cl) = 1# +# (clen cl) + +mainPrimIO = case (clen list4) of + len4 -> + case (len4 +# len4) of + 8# -> finish 65# -- 'A' + _ -> finish 66# -- 'B' + where + list4 = mk 4# + +finish :: Int# -> PrimIO () +finish n = _ccall_ putchar (C# (chr# n)) `seqPrimIO` returnPrimIO () diff --git a/ghc/tests/codeGen/cg015.stdout b/ghc/tests/codeGen/cg015.stdout new file mode 100644 index 0000000..8c7e5a6 --- /dev/null +++ b/ghc/tests/codeGen/cg015.stdout @@ -0,0 +1 @@ +A \ No newline at end of file diff --git a/ghc/tests/codeGen/cg016.hs b/ghc/tests/codeGen/cg016.hs new file mode 100644 index 0000000..b39fdbc --- /dev/null +++ b/ghc/tests/codeGen/cg016.hs @@ -0,0 +1,9 @@ +--!!! tests calls of `error' (that make calls of `error'...) +-- +main = error ("1st call to error\n"++( + error ("2nd call to error\n"++( + error ("3rd call to error\n"++( + error ("4th call to error\n"++( + error ("5th call to error\n"++( + error ("6th call to error" + ))))))))))) diff --git a/ghc/tests/codeGen/cg016.stdout b/ghc/tests/codeGen/cg016.stdout new file mode 100644 index 0000000..e69de29 diff --git a/ghc/tests/codeGen/cg017.hs b/ghc/tests/codeGen/cg017.hs new file mode 100644 index 0000000..5206c8f --- /dev/null +++ b/ghc/tests/codeGen/cg017.hs @@ -0,0 +1,33 @@ +--!!! test of cyclic default methods +-- +class Foo a where + op1 :: Fractional b => a -> b -> Bool + op2 :: Fractional b => a -> b -> Bool + op3 :: Fractional b => a -> b -> Bool + op4 :: Fractional b => a -> b -> Bool + op5 :: Fractional b => a -> b -> Bool + op6 :: Fractional b => a -> b -> Bool + + -- each depends on the next: + op1 a b = not (op2 a b) + op2 a b = not (op3 a b) + op3 a b = not (op4 a b) + op4 a b = not (op5 a b) + op5 a b = not (op6 a b) + op6 a b = not (op1 a b) + +-- now some instance decls to break the cycle: +instance Foo Int where + op1 a b = a == 42 + +instance Foo Char where + op1 a b = a == 'c' + +instance Foo a => Foo [a] where + op1 a b = null a + +-- try it: +main = do + putStr (show (op2 (3::Int) 3.14159)) + putStr (show (op2 'X' 3.14159)) + putStr (show (op2 ([]::[Char])3.14159)) diff --git a/ghc/tests/codeGen/cg017.stdout b/ghc/tests/codeGen/cg017.stdout new file mode 100644 index 0000000..c5b23b3 --- /dev/null +++ b/ghc/tests/codeGen/cg017.stdout @@ -0,0 +1 @@ +TrueTrueFalse \ No newline at end of file diff --git a/ghc/tests/codeGen/cg018.hs b/ghc/tests/codeGen/cg018.hs new file mode 100644 index 0000000..29dd3cd --- /dev/null +++ b/ghc/tests/codeGen/cg018.hs @@ -0,0 +1,23 @@ +--!!! test of datatype with many unboxed fields +-- +import PrelBase + +main = putStr (shows (selectee1 + selectee2) "\n") + +data Tfo = Tfo Float# Float# Float# Float# Float# Float# Float# Float# Float# Float# Float# Float# + +yyy = (Tfo (-0.0018#) (-0.8207#) (0.5714#) + (0.2679#) (-0.5509#) (-0.7904#) + (0.9634#) (0.1517#) (0.2209#) + (0.0073#) (8.4030#) (0.6232#)) + +xxx = (Tfo (-0.8143#) (-0.5091#) (-0.2788#) + (-0.0433#) (-0.4257#) (0.9038#) + (-0.5788#) (0.7480#) (0.3246#) + (1.5227#) (6.9114#) (-7.0765#)) + +selectee1 = F# (case xxx of + Tfo _ _ _ _ _ _ _ x _ _ _ _ -> x) + +selectee2 = F# (case xxx of + Tfo _ _ y _ _ _ _ _ _ _ _ _ -> y) diff --git a/ghc/tests/codeGen/cg018.stdout b/ghc/tests/codeGen/cg018.stdout new file mode 100644 index 0000000..441d36b --- /dev/null +++ b/ghc/tests/codeGen/cg018.stdout @@ -0,0 +1 @@ +0.4692 diff --git a/ghc/tests/codeGen/cg019.hs b/ghc/tests/codeGen/cg019.hs new file mode 100644 index 0000000..ae20eaf --- /dev/null +++ b/ghc/tests/codeGen/cg019.hs @@ -0,0 +1,3 @@ +--!!! printing of floating-pt numbers +-- +main = print (1.234e5 :: Float) diff --git a/ghc/tests/codeGen/cg019.stdout b/ghc/tests/codeGen/cg019.stdout new file mode 100644 index 0000000..9ed4dbb --- /dev/null +++ b/ghc/tests/codeGen/cg019.stdout @@ -0,0 +1 @@ +123400.0 diff --git a/ghc/tests/codeGen/cg020.hs b/ghc/tests/codeGen/cg020.hs new file mode 100644 index 0000000..a5103b0 --- /dev/null +++ b/ghc/tests/codeGen/cg020.hs @@ -0,0 +1,3 @@ +--!!! reading/showing of Ints/Integers +-- +main = print ((read "-1") :: Integer) diff --git a/ghc/tests/codeGen/cg020.stdout b/ghc/tests/codeGen/cg020.stdout new file mode 100644 index 0000000..3a2e3f4 --- /dev/null +++ b/ghc/tests/codeGen/cg020.stdout @@ -0,0 +1 @@ +-1 diff --git a/ghc/tests/codeGen/cg021.hs b/ghc/tests/codeGen/cg021.hs new file mode 100644 index 0000000..32d015e --- /dev/null +++ b/ghc/tests/codeGen/cg021.hs @@ -0,0 +1,60 @@ +--!!! Tests garbage collection in the branch of a case +--!!! alternative where the constructor is returned in the heap. + +{- This is also a rather stressful test for another reason. + The mutual recursion between munch and f causes lots of + closures to be built, of the form (munch n s), for some n and s. + Now, all of these closures are entered and each has as its value + the result delivere by the next; so the result is that there is + a massive chain of identical updates. + + As it turns out, they are mostly garbage, so the GC could eliminate + them (though this isn't implemented at present), but that isn't + necessarily the case. + + The only correct solution is to spot that the updates are all + updating with the same value (update frames stacked on top of each + other), and update all but one with indirections to the last + remaining one. This could be done by GC, or at the moment the + frame is pushed. + + Incidentally, hbc won't have this particular problem, because it + updates immediately. + + NOTE: [March 97] Now that stack squeezing happens when GC happens, + the stack is squished at GC. So this program uses a small stack + in a small heap (eg 4m heap 2m stack), but in a big heap (no GC) + it needs a much bigger stack (10m)! It would be better to try GC/stack + squeezing on stack oflo. +-} + +module Main where + +main = munch 100000 (inf 3) + +data Stream a + = MkStream a a a a a a a a a (Stream a) + | Empty + +inf :: Int -> Stream Int +inf n = MkStream n n n n n n n n n (inf n) + +munch :: Int -> Stream a -> IO () + +munch n Empty = return () -- error "this never happens!\n" + -- this first equation mks it non-strict in "n" + -- (NB: call the "error" makes it strict) + +munch 0 _ = putStr "I succeeded!\n" +munch n s = case (f n s) of + (True, rest) -> rest + (False, _) -> error "this never happens either\n" + +--f :: Int -> Stream a -> (Bool, [Request]) + +f n (MkStream _ _ _ _ _ _ _ _ _ rest) + = -- garbage collection *HERE*, please! + -- (forced by the closure for n-1) + (True, munch (n - 1) rest) + +-- munch and f are mutually recursive, just to be nasty diff --git a/ghc/tests/codeGen/cg021.stdout b/ghc/tests/codeGen/cg021.stdout new file mode 100644 index 0000000..17203ef --- /dev/null +++ b/ghc/tests/codeGen/cg021.stdout @@ -0,0 +1 @@ +I succeeded! diff --git a/ghc/tests/codeGen/cg022.hs b/ghc/tests/codeGen/cg022.hs new file mode 100644 index 0000000..78b6881 --- /dev/null +++ b/ghc/tests/codeGen/cg022.hs @@ -0,0 +1,10 @@ +--!!! tests stack stubbing: if "f" doesn't stub "ns", +--!!! the program has a space leak. + +module Main where + +main = f (putStr "a") + (take 1000000 (repeat True)) + (putStr "b") + +f a ns b = if last ns then a else b diff --git a/ghc/tests/codeGen/cg022.stdout b/ghc/tests/codeGen/cg022.stdout new file mode 100644 index 0000000..2e65efe --- /dev/null +++ b/ghc/tests/codeGen/cg022.stdout @@ -0,0 +1 @@ +a \ No newline at end of file diff --git a/ghc/tests/codeGen/cg023.stdout b/ghc/tests/codeGen/cg023.stdout new file mode 100644 index 0000000..c1f22fb --- /dev/null +++ b/ghc/tests/codeGen/cg023.stdout @@ -0,0 +1 @@ +False \ No newline at end of file diff --git a/ghc/tests/codeGen/cg024.hs b/ghc/tests/codeGen/cg024.hs new file mode 100644 index 0000000..7fa997c --- /dev/null +++ b/ghc/tests/codeGen/cg024.hs @@ -0,0 +1,8 @@ +--!!! test super-dictionary grabification +-- + +main = putStr (show (is_one (1.2::Double))) + +is_one :: RealFloat a => a -> Bool + +is_one x = x == 1.0 diff --git a/ghc/tests/codeGen/cg024.stdout b/ghc/tests/codeGen/cg024.stdout new file mode 100644 index 0000000..c1f22fb --- /dev/null +++ b/ghc/tests/codeGen/cg024.stdout @@ -0,0 +1 @@ +False \ No newline at end of file diff --git a/ghc/tests/codeGen/cg025.hs b/ghc/tests/codeGen/cg025.hs new file mode 100644 index 0000000..6b2a820 --- /dev/null +++ b/ghc/tests/codeGen/cg025.hs @@ -0,0 +1,21 @@ +--!!! test various I/O Requests +-- +-- +import IO +import System +import IOBase (trace) +--import Trace ToDo: get this via GlaExts -- SOF + +main = do + prog <- getProgName + hPutStr stderr (shows prog "\n") + args <- getArgs + hPutStr stderr (shows args "\n") + path <- getEnv "PATH" + hPutStr stderr (shows path "\n") + stdin_txt <- getContents + putStr stdin_txt + file_cts <- readFile (head args) + hPutStr stderr file_cts + trace "hello, trace" $ + catch (getEnv "__WURBLE__" >> return ()) (\ e -> error "hello, error\n") diff --git a/ghc/tests/codeGen/cg025.stdout b/ghc/tests/codeGen/cg025.stdout new file mode 100644 index 0000000..6b2a820 --- /dev/null +++ b/ghc/tests/codeGen/cg025.stdout @@ -0,0 +1,21 @@ +--!!! test various I/O Requests +-- +-- +import IO +import System +import IOBase (trace) +--import Trace ToDo: get this via GlaExts -- SOF + +main = do + prog <- getProgName + hPutStr stderr (shows prog "\n") + args <- getArgs + hPutStr stderr (shows args "\n") + path <- getEnv "PATH" + hPutStr stderr (shows path "\n") + stdin_txt <- getContents + putStr stdin_txt + file_cts <- readFile (head args) + hPutStr stderr file_cts + trace "hello, trace" $ + catch (getEnv "__WURBLE__" >> return ()) (\ e -> error "hello, error\n") diff --git a/ghc/tests/codeGen/cg026.hs b/ghc/tests/codeGen/cg026.hs new file mode 100644 index 0000000..c39dc41 --- /dev/null +++ b/ghc/tests/codeGen/cg026.hs @@ -0,0 +1,216 @@ +--!!! simple tests of primitive arrays +-- +module Main ( main ) where + +import PrelBase --ghc1.3 +import GlaExts +import ST + +import Ratio -- 1.3 +import Array -- 1.3 + +main = putStr + (test_chars ++ "\n" ++ + test_ints ++ "\n" ++ + test_addrs ++ "\n" ++ + test_floats ++ "\n" ++ + test_doubles ++ "\n" ++ + test_ptrs ++ "\n") + + +-- Arr# Char# ------------------------------------------- +-- (main effort is in packString#) + +test_chars :: String +test_chars + = let str = reverse "Now is the time for all good men to come to...\n" + in + unsafePerformPrimIO ( + _ccall_ fprintf (``stdout''::Addr) "%d %s\n" 93 str >> + returnPrimIO "" + ) + +-- Arr# Int# ------------------------------------------- + +test_ints :: String +test_ints + = 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 + newIntArray (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: + freezeIntArray arr# + ) + + fill_in :: MutableByteArray s Int -> Int# -> Int# -> ST s () + + fill_in arr_in# first# last# + = if (first# ># last#) + then returnST () + else writeIntArray arr_in# (I# first#) (I# (first# *# first#)) >> + fill_in arr_in# (first# +# 1#) last# + + lookup_range :: ByteArray Int -> Int# -> Int# -> [Int] + lookup_range arr from# to# + = if (from# ># to#) + then [] + else (indexIntArray arr (I# from#)) + : (lookup_range arr (from# +# 1#) to#) + +-- Arr# Addr# ------------------------------------------- + +test_addrs :: String +test_addrs + = 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 + newAddrArray (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: + freezeAddrArray arr# + ) + + fill_in :: MutableByteArray s Int -> Int# -> Int# -> ST s () + + fill_in arr_in# first# last# + = if (first# ># last#) + then returnST () + else writeAddrArray arr_in# (I# first#) + (A# (int2Addr# (first# *# first#))) >> + fill_in arr_in# (first# +# 1#) last# + + lookup_range :: ByteArray Int -> Int# -> Int# -> [ Int ] + lookup_range arr from# to# + = let + a2i (A# a#) = I# (addr2Int# a#) + in + if (from# ># to#) + then [] + else (a2i (indexAddrArray arr (I# from#))) + : (lookup_range arr (from# +# 1#) to#) + +-- Arr# Float# ------------------------------------------- + +test_floats :: String +test_floats + = 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 + newFloatArray (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: + freezeFloatArray arr# + ) + + fill_in :: MutableByteArray s Int -> Int# -> Int# -> ST s () + + fill_in arr_in# first# last# + = if (first# ># last#) + then returnST () + else writeFloatArray arr_in# (I# first#) ((fromInt (I# first#)) * pi) >> + fill_in arr_in# (first# +# 1#) last# + + lookup_range :: ByteArray Int -> Int# -> Int# -> [Float] + lookup_range arr from# to# + = if (from# ># to#) + then [] + else (indexFloatArray arr (I# from#)) + : (lookup_range arr (from# +# 1#) to#) + +-- Arr# Double# ------------------------------------------- + +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: + freezeDoubleArray arr# + ) + + fill_in :: MutableByteArray s Int -> Int# -> Int# -> ST s () + + fill_in arr_in# first# last# + = if (first# ># last#) + then returnST () + else writeDoubleArray arr_in# (I# first#) ((fromInt (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#) + +-- Arr# (Ratio Int) (ptrs) --------------------------------- +-- just like Int# test + +test_ptrs :: String +test_ptrs + = let arr# = f 1000 + in + shows (lookup_range arr# 42 416) "\n" + where + f :: Int -> Array Int (Ratio Int) + + f size + = runST ( + newArray (1, size) (3 % 5) >>= \ arr# -> + -- don't fill in the whole thing + fill_in arr# 1 400 >> + freezeArray arr# + ) + + fill_in :: MutableArray s Int (Ratio Int) -> Int -> Int -> ST s () + + fill_in arr_in# first last + = if (first > last) + then returnST () + else writeArray arr_in# first (fromInt (first * first)) >> + fill_in arr_in# (first + 1) last + + lookup_range :: Array Int (Ratio Int) -> Int -> Int -> [Ratio Int] + lookup_range array from too + = if (from > too) + then [] + else (array ! from) : (lookup_range array (from + 1) too) diff --git a/ghc/tests/codeGen/cg026.stdout b/ghc/tests/codeGen/cg026.stdout new file mode 100644 index 0000000..d62b80c --- /dev/null +++ b/ghc/tests/codeGen/cg026.stdout @@ -0,0 +1,13 @@ +93 +...ot emoc ot nem doog lla rof emit eht si woN + +[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] + +[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] + +[131.9469, 135.08849, 138.23009, 141.37167, 144.51326, 147.65486, 150.79645, 153.93805, 157.07964, 160.22124, 163.36282, 166.50441, 169.64601, 172.7876, 175.9292, 179.07079, 182.21237, 185.35397, 188.49556, 191.63716, 194.77875, 197.92035, 201.06194, 204.20352, 207.34512, 210.48671, 213.62831, 216.7699, 219.9115, 223.05309, 226.19467, 229.33627, 232.47786, 235.61946, 238.76105, 241.90263, 245.04424, 248.18582, 251.32742, 254.46901, 257.6106, 260.7522, 263.8938, 267.03537, 270.17697, 273.31857, 276.46017, 279.60175, 282.74335, 285.88495, 289.02652, 292.16812, 295.30972, 298.45132, 301.5929, 304.7345, 307.8761, 311.01767, 314.15927, 317.30087, 320.44247, 323.58405, 326.72565, 329.86725, 333.00882, 336.15042, 339.29202, 342.4336, 345.5752, 348.7168, 351.8584, 354.99997, 358.14157, 361.28317, 364.42474, 367.56635, 370.70795, 373.84955, 376.99112, 380.13272, 383.27432, 386.4159, 389.5575, 392.6991, 395.8407, 398.98227, 402.12387, 405.26547, 408.40704, 411.54865, 414.69025, 417.83185, 420.97342, 424.11502, 427.25662, 430.3982, 433.5398, 436.6814, 439.823, 442.96457, 446.10617, 449.24777, 452.38934, 455.53094, 458.67255, 461.81415, 464.95572, 468.09732, 471.23892, 474.3805, 477.5221, 480.6637, 483.80527, 486.94687, 490.08847, 493.23007, 496.37164, 499.51324, 502.65485, 505.79642, 508.93802, 512.0796, 515.2212, 518.3628, 521.5044, 524.646, 527.7876, 530.9292, 534.07074, 537.21234, 540.35394, 543.49554, 546.63715, 549.77875, 552.92035, 556.0619, 559.2035, 562.3451, 565.4867, 568.6283, 571.7699, 574.9115, 578.05304, 581.19464, 584.33624, 587.47784, 590.61945, 593.76105, 596.90265, 600.0442, 603.1858, 606.3274, 609.469, 612.6106, 615.7522, 618.8938, 622.03534, 625.17694, 628.31854, 631.46014, 634.60175, 637.74335, 640.88495, 644.0265, 647.1681, 650.3097, 653.4513, 656.5929, 659.7345, 662.8761, 666.01764, 669.15924, 672.30084, 675.44244, 678.58405, 681.72565, 684.8672, 688.0088, 691.1504, 694.292, 697.4336, 700.5752, 703.7168, 706.85834, 709.99994, 713.14154, 716.28314, 719.42474, 722.56635, 725.70795, 728.8495, 731.9911, 735.1327, 738.2743, 741.4159, 744.5575, 747.6991, 750.84064, 753.98224, 757.12384, 760.26544, 763.40704, 766.54865, 769.69025, 772.8318, 775.9734, 779.115, 782.2566, 785.3982, 788.5398, 791.6814, 794.82294, 797.96454, 801.10614, 804.24774, 807.38934, 810.53094, 813.67255, 816.8141, 819.9557, 823.0973, 826.2389, 829.3805, 832.5221, 835.6637, 838.80524, 841.94684, 845.08844, 848.23004, 851.37164, 854.51324, 857.65485, 860.7964, 863.938, 867.0796, 870.2212, 873.3628, 876.5044, 879.646, 882.78754, 885.92914, 889.07074, 892.21234, 895.35394, 898.49554, 901.63715, 904.7787, 907.9203, 911.0619, 914.2035, 917.3451, 920.4867, 923.6283, 926.76984, 929.91144, 933.05304, 936.19464, 939.33624, 942.47784, 945.6194, 948.761, 951.9026, 955.0442, 958.1858, 961.3274, 964.469, 967.61053, 970.75214, 973.89374, 977.03534, 980.17694, 983.31854, 986.46014, 989.6017, 992.7433, 995.8849, 999.0265, 1002.1681, 1005.3097, 1008.4513, 1011.59283, 1014.73444, 1017.87604, 1021.01764, 1024.1592, 1027.3008, 1030.4424, 1033.584, 1036.7256, 1039.8672, 1043.0088, 1046.1504, 1049.292, 1052.4336, 1055.5752, 1058.7168, 1061.8584, 1065.0, 1068.1415, 1071.2831, 1074.4247, 1077.5663, 1080.7079, 1083.8495, 1086.9911, 1090.1327, 1093.2743, 1096.4159, 1099.5575, 1102.6991, 1105.8407, 1108.9822, 1112.1238, 1115.2654, 1118.407, 1121.5486, 1124.6902, 1127.8318, 1130.9734, 1134.115, 1137.2566, 1140.3982, 1143.5398, 1146.6814, 1149.823, 1152.9645, 1156.1061, 1159.2477, 1162.3893, 1165.5309, 1168.6725, 1171.8141, 1174.9557, 1178.0973, 1181.2389, 1184.3805, 1187.5221, 1190.6637, 1193.8053, 1196.9468, 1200.0884, 1203.23, 1206.3716, 1209.5132, 1212.6548, 1215.7964, 1218.938, 1222.0796, 1225.2212, 1228.3628, 1231.5044, 1234.646, 1237.7876, 1240.9291, 1244.0707, 1247.2123, 1250.3539, 1253.4955, 1256.6371, 1259.7787, 1262.9203, 1266.0619, 1269.2035, 1272.3451, 1275.4867, 1278.6283, 1281.7699, 1284.9114, 1288.053, 1291.1946, 1294.3362, 1297.4778, 1300.6194, 1303.761, 1306.9026] + +[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] + +[1764 % 1, 1849 % 1, 1936 % 1, 2025 % 1, 2116 % 1, 2209 % 1, 2304 % 1, 2401 % 1, 2500 % 1, 2601 % 1, 2704 % 1, 2809 % 1, 2916 % 1, 3025 % 1, 3136 % 1, 3249 % 1, 3364 % 1, 3481 % 1, 3600 % 1, 3721 % 1, 3844 % 1, 3969 % 1, 4096 % 1, 4225 % 1, 4356 % 1, 4489 % 1, 4624 % 1, 4761 % 1, 4900 % 1, 5041 % 1, 5184 % 1, 5329 % 1, 5476 % 1, 5625 % 1, 5776 % 1, 5929 % 1, 6084 % 1, 6241 % 1, 6400 % 1, 6561 % 1, 6724 % 1, 6889 % 1, 7056 % 1, 7225 % 1, 7396 % 1, 7569 % 1, 7744 % 1, 7921 % 1, 8100 % 1, 8281 % 1, 8464 % 1, 8649 % 1, 8836 % 1, 9025 % 1, 9216 % 1, 9409 % 1, 9604 % 1, 9801 % 1, 10000 % 1, 10201 % 1, 10404 % 1, 10609 % 1, 10816 % 1, 11025 % 1, 11236 % 1, 11449 % 1, 11664 % 1, 11881 % 1, 12100 % 1, 12321 % 1, 12544 % 1, 12769 % 1, 12996 % 1, 13225 % 1, 13456 % 1, 13689 % 1, 13924 % 1, 14161 % 1, 14400 % 1, 14641 % 1, 14884 % 1, 15129 % 1, 15376 % 1, 15625 % 1, 15876 % 1, 16129 % 1, 16384 % 1, 16641 % 1, 16900 % 1, 17161 % 1, 17424 % 1, 17689 % 1, 17956 % 1, 18225 % 1, 18496 % 1, 18769 % 1, 19044 % 1, 19321 % 1, 19600 % 1, 19881 % 1, 20164 % 1, 20449 % 1, 20736 % 1, 21025 % 1, 21316 % 1, 21609 % 1, 21904 % 1, 22201 % 1, 22500 % 1, 22801 % 1, 23104 % 1, 23409 % 1, 23716 % 1, 24025 % 1, 24336 % 1, 24649 % 1, 24964 % 1, 25281 % 1, 25600 % 1, 25921 % 1, 26244 % 1, 26569 % 1, 26896 % 1, 27225 % 1, 27556 % 1, 27889 % 1, 28224 % 1, 28561 % 1, 28900 % 1, 29241 % 1, 29584 % 1, 29929 % 1, 30276 % 1, 30625 % 1, 30976 % 1, 31329 % 1, 31684 % 1, 32041 % 1, 32400 % 1, 32761 % 1, 33124 % 1, 33489 % 1, 33856 % 1, 34225 % 1, 34596 % 1, 34969 % 1, 35344 % 1, 35721 % 1, 36100 % 1, 36481 % 1, 36864 % 1, 37249 % 1, 37636 % 1, 38025 % 1, 38416 % 1, 38809 % 1, 39204 % 1, 39601 % 1, 40000 % 1, 40401 % 1, 40804 % 1, 41209 % 1, 41616 % 1, 42025 % 1, 42436 % 1, 42849 % 1, 43264 % 1, 43681 % 1, 44100 % 1, 44521 % 1, 44944 % 1, 45369 % 1, 45796 % 1, 46225 % 1, 46656 % 1, 47089 % 1, 47524 % 1, 47961 % 1, 48400 % 1, 48841 % 1, 49284 % 1, 49729 % 1, 50176 % 1, 50625 % 1, 51076 % 1, 51529 % 1, 51984 % 1, 52441 % 1, 52900 % 1, 53361 % 1, 53824 % 1, 54289 % 1, 54756 % 1, 55225 % 1, 55696 % 1, 56169 % 1, 56644 % 1, 57121 % 1, 57600 % 1, 58081 % 1, 58564 % 1, 59049 % 1, 59536 % 1, 60025 % 1, 60516 % 1, 61009 % 1, 61504 % 1, 62001 % 1, 62500 % 1, 63001 % 1, 63504 % 1, 64009 % 1, 64516 % 1, 65025 % 1, 65536 % 1, 66049 % 1, 66564 % 1, 67081 % 1, 67600 % 1, 68121 % 1, 68644 % 1, 69169 % 1, 69696 % 1, 70225 % 1, 70756 % 1, 71289 % 1, 71824 % 1, 72361 % 1, 72900 % 1, 73441 % 1, 73984 % 1, 74529 % 1, 75076 % 1, 75625 % 1, 76176 % 1, 76729 % 1, 77284 % 1, 77841 % 1, 78400 % 1, 78961 % 1, 79524 % 1, 80089 % 1, 80656 % 1, 81225 % 1, 81796 % 1, 82369 % 1, 82944 % 1, 83521 % 1, 84100 % 1, 84681 % 1, 85264 % 1, 85849 % 1, 86436 % 1, 87025 % 1, 87616 % 1, 88209 % 1, 88804 % 1, 89401 % 1, 90000 % 1, 90601 % 1, 91204 % 1, 91809 % 1, 92416 % 1, 93025 % 1, 93636 % 1, 94249 % 1, 94864 % 1, 95481 % 1, 96100 % 1, 96721 % 1, 97344 % 1, 97969 % 1, 98596 % 1, 99225 % 1, 99856 % 1, 100489 % 1, 101124 % 1, 101761 % 1, 102400 % 1, 103041 % 1, 103684 % 1, 104329 % 1, 104976 % 1, 105625 % 1, 106276 % 1, 106929 % 1, 107584 % 1, 108241 % 1, 108900 % 1, 109561 % 1, 110224 % 1, 110889 % 1, 111556 % 1, 112225 % 1, 112896 % 1, 113569 % 1, 114244 % 1, 114921 % 1, 115600 % 1, 116281 % 1, 116964 % 1, 117649 % 1, 118336 % 1, 119025 % 1, 119716 % 1, 120409 % 1, 121104 % 1, 121801 % 1, 122500 % 1, 123201 % 1, 123904 % 1, 124609 % 1, 125316 % 1, 126025 % 1, 126736 % 1, 127449 % 1, 128164 % 1, 128881 % 1, 129600 % 1, 130321 % 1, 131044 % 1, 131769 % 1, 132496 % 1, 133225 % 1, 133956 % 1, 134689 % 1, 135424 % 1, 136161 % 1, 136900 % 1, 137641 % 1, 138384 % 1, 139129 % 1, 139876 % 1, 140625 % 1, 141376 % 1, 142129 % 1, 142884 % 1, 143641 % 1, 144400 % 1, 145161 % 1, 145924 % 1, 146689 % 1, 147456 % 1, 148225 % 1, 148996 % 1, 149769 % 1, 150544 % 1, 151321 % 1, 152100 % 1, 152881 % 1, 153664 % 1, 154449 % 1, 155236 % 1, 156025 % 1, 156816 % 1, 157609 % 1, 158404 % 1, 159201 % 1, 160000 % 1, 3 % 5, 3 % 5, 3 % 5, 3 % 5, 3 % 5, 3 % 5, 3 % 5, 3 % 5, 3 % 5, 3 % 5, 3 % 5, 3 % 5, 3 % 5, 3 % 5, 3 % 5, 3 % 5] + diff --git a/ghc/tests/codeGen/cg027.hs b/ghc/tests/codeGen/cg027.hs new file mode 100644 index 0000000..0c58972 --- /dev/null +++ b/ghc/tests/codeGen/cg027.hs @@ -0,0 +1,13 @@ +--!!! simple test of 0-method classes +-- + +class (Num a, Integral a) => Foo a + +main = putStr (shows (f ((fromInteger 21)::Int) + ((fromInteger 37))) "\n") + +instance Foo Int + +f :: Foo a => a -> a -> Integer + +f a b = toInteger (a + b) diff --git a/ghc/tests/codeGen/cg027.stdout b/ghc/tests/codeGen/cg027.stdout new file mode 100644 index 0000000..8c61d23 --- /dev/null +++ b/ghc/tests/codeGen/cg027.stdout @@ -0,0 +1 @@ +58 diff --git a/ghc/tests/codeGen/cg028.hs b/ghc/tests/codeGen/cg028.hs new file mode 100644 index 0000000..3fa877c --- /dev/null +++ b/ghc/tests/codeGen/cg028.hs @@ -0,0 +1,10 @@ +main = putStr (shows (f (read "42.0")) "\n") + +-- f compiled to bogus code with ghc 0.18 and earlier +-- switch() on a DoubleReg + +f :: Double -> Int +f 1.0 = 1 +f 2.0 = 2 +f 3.0 = 3 +f x = round x diff --git a/ghc/tests/codeGen/cg028.stdout b/ghc/tests/codeGen/cg028.stdout new file mode 100644 index 0000000..d81cc07 --- /dev/null +++ b/ghc/tests/codeGen/cg028.stdout @@ -0,0 +1 @@ +42 diff --git a/ghc/tests/codeGen/cg029.hs b/ghc/tests/codeGen/cg029.hs new file mode 100644 index 0000000..7c14131 --- /dev/null +++ b/ghc/tests/codeGen/cg029.hs @@ -0,0 +1,15 @@ +module Main(main) where + +-- In 0.19, we lost the ability to do ccalls with more than 6 arguments +-- on the Sparc. Just to make sure it never happens again... + +import GlaExts + +main = + _ccall_ printf "Testing %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d %d\n" + (01::Int) (02::Int) (03::Int) (04::Int) (05::Int) (06::Int) (07::Int) (08::Int) + (11::Int) (12::Int) (13::Int) (14::Int) (15::Int) (16::Int) (17::Int) (18::Int) + (21::Int) (22::Int) (23::Int) (24::Int) (25::Int) (26::Int) (27::Int) (28::Int) + (31::Int) (32::Int) (33::Int) (34::Int) (35::Int) (36::Int) (37::Int) (38::Int) + `thenIO_Prim` \ _ -> + return () diff --git a/ghc/tests/codeGen/cg029.stdout b/ghc/tests/codeGen/cg029.stdout new file mode 100644 index 0000000..d00a3d3 --- /dev/null +++ b/ghc/tests/codeGen/cg029.stdout @@ -0,0 +1 @@ +Testing 1 2 3 4 5 6 7 8 11 12 13 14 15 16 17 18 21 22 23 24 25 26 27 28 31 32 33 34 35 36 37 38 diff --git a/ghc/tests/codeGen/cg030.hs b/ghc/tests/codeGen/cg030.hs new file mode 100644 index 0000000..e5bb55e --- /dev/null +++ b/ghc/tests/codeGen/cg030.hs @@ -0,0 +1,6 @@ +module GHCmain(mainPrimIO) where + +import ST +import STBase + +mainPrimIO = _ccall_ puts "123\n" >> return () diff --git a/ghc/tests/codeGen/cg030.stdout b/ghc/tests/codeGen/cg030.stdout new file mode 100644 index 0000000..cc12087 --- /dev/null +++ b/ghc/tests/codeGen/cg030.stdout @@ -0,0 +1,2 @@ +123 + diff --git a/ghc/tests/codeGen/cg031.hs b/ghc/tests/codeGen/cg031.hs new file mode 100644 index 0000000..10dede2 --- /dev/null +++ b/ghc/tests/codeGen/cg031.hs @@ -0,0 +1,43 @@ +--!! test GEN reps w/ unboxed values in them +--!! NB: it was the static ones that were hosed... +-- +module Main ( main ) where + +import PrelBase + +main = do + putStr (shows (sum ([1..1{-30-}]++[1..1{-40-}]++[11,22])) "\n") + putStr (shows (prog 1{-30-} 1{-40-}) "\n") + +data Foo a + = MkFoo [a] Int# [Int] Int# [(a,Int)] Int# + -- The above will cause a *horrible* GEN rep'n. + +prog :: Int -> Int -> Int + +prog size_1 size_2 + = let + list1 = static1 : (map mk_foo [1 .. size_1]) + list2 = static2 : (map mk_foo [1 .. size_2]) + in + I# (add_up 0# list1 (reverse list2)) + +static1 = MkFoo (error "static11") 11# [] 11# (error "static12") 11# +static2 = MkFoo (error "static21") 22# [] 22# (error "static22") 22# + +one, two :: Int +one = 1; two = 2 + +mk_foo i@(I# i#) + = MkFoo (error "list1") i# [i,i] i# (error "list2") i# + +add_up :: Int# -> [Foo a] -> [Foo a] -> Int# + +add_up acc [] [] = acc +add_up acc [] ys = add_up acc ys [] +add_up acc (x:xs) (y:ys) = add_up (acc +# add x y) xs ys +add_up acc (x:xs) [] = add_up acc xs [] + +add :: Foo a -> Foo a -> Int# +add (MkFoo _ _ _ _ _ x) (MkFoo _ _ _ _ _ y) + = x +# y diff --git a/ghc/tests/codeGen/cg031.stdout b/ghc/tests/codeGen/cg031.stdout new file mode 100644 index 0000000..a91166f --- /dev/null +++ b/ghc/tests/codeGen/cg031.stdout @@ -0,0 +1,2 @@ +35 +35 diff --git a/ghc/tests/codeGen/cg032.hs b/ghc/tests/codeGen/cg032.hs new file mode 100644 index 0000000..e8c0680 --- /dev/null +++ b/ghc/tests/codeGen/cg032.hs @@ -0,0 +1,20 @@ +--!! pattern-matching failure on functions that return Int# + +import PrelBase --ghc1.3 + +main = putStr (shows (I# (foo bar1 bar2)) "\n") + where + bar1 = Bar1 40 (39,38) resps + bar2 = Bar1 2 ( 1, 0) resps + resps = error "1.2 responses" + +data Response = Response -- stub + +data Bar + = Bar1 Int (Int,Int) [Response] + | Bar2 Int Int# + | Bar3 Int + +foo :: Bar -> Bar -> Int# + +foo (Bar1 (I# i) _ _) (Bar1 (I# j) _ _) = i +# j diff --git a/ghc/tests/codeGen/cg032.stdout b/ghc/tests/codeGen/cg032.stdout new file mode 100644 index 0000000..d81cc07 --- /dev/null +++ b/ghc/tests/codeGen/cg032.stdout @@ -0,0 +1 @@ +42 diff --git a/ghc/tests/codeGen/cg033.hs b/ghc/tests/codeGen/cg033.hs new file mode 100644 index 0000000..b709a78 --- /dev/null +++ b/ghc/tests/codeGen/cg033.hs @@ -0,0 +1,77 @@ +--!! worker/wrapper turns ( \ -> Int# ) function +--!! into Int# -- WRONG + +import PrelBase --ghc1.3 + +main = putStr (shows true_or_false "\n") + where + true_or_false + = case (cmp_name True imp1 imp2) of + -1# -> False + 0# -> True + 1# -> False + + imp1 = Imp s "Imp1" s s + imp2 = Imp s "Imp2" s s + + s = "String!" + +-- taken from compiler: basicTypes/ProtoName.lhs + +cmp_name :: Bool -> ProtoName -> ProtoName -> Int# + +cmp_name by_local (Unk n1) (Unk n2) = cmpString n1 n2 +cmp_name by_local (Unk n1) (Imp m n2 _ o2) = cmpString n1 (if by_local then o2 else n2) +cmp_name by_local (Unk n1) (Prel nm) + = let (_, n2) = getOrigName nm in + cmpString n1 n2 + +cmp_name by_local (Prel n1) (Prel n2) = cmpName n1 n2 + +cmp_name True (Imp _ _ _ o1) (Imp _ _ _ o2) = cmpString o1 o2 + +cmp_name False (Imp m1 n1 _ _) (Imp m2 n2 _ _) + = case cmpString n1 n2 of { + -1# -> -1#; + 0# -> case cmpString m1 m2 of { + 0# -> 0#; + xxx -> if null m1 || null m2 + then 0# + else xxx + }; + _ -> 1# + } + +cmp_name True (Imp _ _ _ o1) (Prel nm) + = let + (_, n2) = getOrigName nm + in + cmpString o1 n2 + +cmp_name False (Imp m1 n1 _ _) (Prel nm) + = case getOrigName nm of { (m2, n2) -> + case cmpString n1 n2 of { -1# -> -1#; 0# -> cmpString m1 m2; _ -> 1# }} + +cmp_name by_local other_p1 other_p2 + = case cmp_name by_local other_p2 other_p1 of -- compare the other way around + -1# -> 1# + 0# -> 0# + _ -> -1# + +data ProtoName + = Unk String -- local name in module + + | Imp String -- name of defining module + String -- name used in defining name + String -- name of the module whose interface told me + -- about this thing + String -- occurrence name + + | Prel String{-Name-} + +cmpString, cmpName :: String -> String -> Int# +cmpString a b = 0# +cmpName = cmpString + +getOrigName :: String -> (String, String) +getOrigName x = ("MODULE", x) diff --git a/ghc/tests/codeGen/cg033.stdout b/ghc/tests/codeGen/cg033.stdout new file mode 100644 index 0000000..0ca9514 --- /dev/null +++ b/ghc/tests/codeGen/cg033.stdout @@ -0,0 +1 @@ +True diff --git a/ghc/tests/codeGen/cg034.hs b/ghc/tests/codeGen/cg034.hs new file mode 100644 index 0000000..2f01c9b --- /dev/null +++ b/ghc/tests/codeGen/cg034.hs @@ -0,0 +1,162 @@ +import Ratio -- 1.3 + +main = putStr ( + shows tinyFloat ( '\n' + : shows t_f ( '\n' + : shows hugeFloat ( '\n' + : shows h_f ( '\n' + : shows tinyDouble ( '\n' + : shows t_d ( '\n' + : shows hugeDouble ( '\n' + : shows h_d ( '\n' + : shows x_f ( '\n' + : shows x_d ( '\n' + : shows y_f ( '\n' + : shows y_d ( "\n" + ))))))))))))) + where + t_f :: Float + t_d :: Double + h_f :: Float + h_d :: Double + x_f :: Float + x_d :: Double + y_f :: Float + y_d :: Double + t_f = fromRationalX (toRational tinyFloat) + t_d = fromRationalX (toRational tinyDouble) + h_f = fromRationalX (toRational hugeFloat) + h_d = fromRationalX (toRational hugeDouble) + x_f = fromRationalX (1.82173691287639817263897126389712638972163e-300 :: Rational) + x_d = fromRationalX (1.82173691287639817263897126389712638972163e-300 :: Rational) + y_f = 1.82173691287639817263897126389712638972163e-300 + y_d = 1.82173691287639817263897126389712638972163e-300 + +--!! fromRational woes + +fromRationalX :: (RealFloat a) => Rational -> a +fromRationalX r = + let + h = ceiling (huge `asTypeOf` x) + b = toInteger (floatRadix x) + x = fromRat 0 r + fromRat e0 r' = + let d = denominator r' + n = numerator r' + in if d > h then + let e = integerLogBase b (d `div` h) + 1 + in fromRat (e0-e) (n % (d `div` (b^e))) + else if abs n > h then + let e = integerLogBase b (abs n `div` h) + 1 + in fromRat (e0+e) ((n `div` (b^e)) % d) + else + scaleFloat e0 (rationalToRealFloat {-fromRational-} r') + in x + +{- +fromRationalX r = + rationalToRealFloat r +{- Hmmm... + let + h = ceiling (huge `asTypeOf` x) + b = toInteger (floatRadix x) + x = fromRat 0 r + + fromRat e0 r' = +{--} trace (shows e0 ('/' : shows r' ('/' : shows h "\n"))) ( + let d = denominator r' + n = numerator r' + in if d > h then + let e = integerLogBase b (d `div` h) + 1 + in fromRat (e0-e) (n % (d `div` (b^e))) + else if abs n > h then + let e = integerLogBase b (abs n `div` h) + 1 + in fromRat (e0+e) ((n `div` (b^e)) % d) + else + scaleFloat e0 (rationalToRealFloat r') + -- now that we know things are in-bounds, + -- we use the "old" Prelude code. +{--} ) + in x +-} +-} + +-- Compute the discrete log of i in base b. +-- Simplest way would be just divide i by b until it's smaller then b, but that would +-- be very slow! We are just slightly more clever. +integerLogBase :: Integer -> Integer -> Int +integerLogBase b i = + if i < b then + 0 + else + -- Try squaring the base first to cut down the number of divisions. + let l = 2 * integerLogBase (b*b) i + doDiv :: Integer -> Int -> Int + doDiv i l = if i < b then l else doDiv (i `div` b) (l+1) + in doDiv (i `div` (b^l)) l + + +------------ + +-- Compute smallest and largest floating point values. +tiny :: (RealFloat a) => a +tiny = + let (l, _) = floatRange x + x = encodeFloat 1 (l-1) + in x + +huge :: (RealFloat a) => a +huge = + let (_, u) = floatRange x + d = floatDigits x + x = encodeFloat (floatRadix x ^ d - 1) (u - d) + in x + +tinyDouble = tiny :: Double +tinyFloat = tiny :: Float +hugeDouble = huge :: Double +hugeFloat = huge :: Float + +{- +[In response to a request by simonpj, Joe Fasel writes:] + +A quite reasonable request! This code was added to the Prelude just +before the 1.2 release, when Lennart, working with an early version +of hbi, noticed that (read . show) was not the identity for +floating-point numbers. (There was a one-bit error about half the time.) +The original version of the conversion function was in fact simply +a floating-point divide, as you suggest above. The new version is, +I grant you, somewhat denser. + +How's this? + +--Joe +-} + + +rationalToRealFloat :: (RealFloat a) => Rational -> a + +rationalToRealFloat x = x' + where x' = f e + +-- If the exponent of the nearest floating-point number to x +-- is e, then the significand is the integer nearest xb^(-e), +-- where b is the floating-point radix. We start with a good +-- guess for e, and if it is correct, the exponent of the +-- floating-point number we construct will again be e. If +-- not, one more iteration is needed. + + f e = if e' == e then y else f e' + where y = encodeFloat (round (x * (1%b)^^e)) e + (_,e') = decodeFloat y + b = floatRadix x' + +-- We obtain a trial exponent by doing a floating-point +-- division of x's numerator by its denominator. The +-- result of this division may not itself be the ultimate +-- result, because of an accumulation of three rounding +-- errors. + + (s,e) = decodeFloat (fromInteger (numerator x) `asTypeOf` x' + / fromInteger (denominator x)) + diff --git a/ghc/tests/codeGen/cg034.stdout b/ghc/tests/codeGen/cg034.stdout new file mode 100644 index 0000000..fd88e41 --- /dev/null +++ b/ghc/tests/codeGen/cg034.stdout @@ -0,0 +1,12 @@ +1.1754944e-38 +1.1754944e-38 +NaN +NaN +2.2250738585072014e-308 +2.2250738585072014e-308 +1.7976931348623157e308 +1.7976931348623157e308 +0.0 +1.821736912876398e-300 +0.0 +1.821736912876398e-300 diff --git a/ghc/tests/codeGen/cg035.hs b/ghc/tests/codeGen/cg035.hs new file mode 100644 index 0000000..947dc95 --- /dev/null +++ b/ghc/tests/codeGen/cg035.hs @@ -0,0 +1,13 @@ +module Main (main) where + +--import PreludeGlaST +import ST +import STBase + +po :: Double -> Double +po rd = 0.5 + 0.5 * erf ((rd / 1.04) / sqrt 2) + where + erf :: Double -> Double + erf x = unsafePerformPrimIO (_ccall_ erf x) + +main = putStr (shows (po 2.0) "\n") diff --git a/ghc/tests/codeGen/cg035.stdout b/ghc/tests/codeGen/cg035.stdout new file mode 100644 index 0000000..a00e9a2 --- /dev/null +++ b/ghc/tests/codeGen/cg035.stdout @@ -0,0 +1 @@ +0.9727648049862613 diff --git a/ghc/tests/codeGen/cg036.hs b/ghc/tests/codeGen/cg036.hs new file mode 100644 index 0000000..b32f67f --- /dev/null +++ b/ghc/tests/codeGen/cg036.hs @@ -0,0 +1,16 @@ +--!! Won't compile unless the compile succeeds on +--!! the "single occurrence of big thing in a duplicated small thing" +--!! inlining old-chestnut. WDP 95/03 +-- +module Main ( main, g ) where + +main = putStr (shows (g 42) "\n") + +g :: Int -> Int -> Int -> (Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int, Int) + +g x y z + = let + f a b = a + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + b * a * b - a + a + b + g c = f c c + in + (g x, g y, g z, g x, g y, g z, g x, g y, g z, g x, g y, g z, g x, g y, g z, g x, g y, g z, g x, g y, g z, g x, g y, g z, g x, g y, g z, g x, g y, g z, g x, g y) diff --git a/ghc/tests/codeGen/cg036.stdout b/ghc/tests/codeGen/cg036.stdout new file mode 100644 index 0000000..3713268 --- /dev/null +++ b/ghc/tests/codeGen/cg036.stdout @@ -0,0 +1 @@ +<> diff --git a/ghc/tests/codeGen/cg037.hs b/ghc/tests/codeGen/cg037.hs new file mode 100644 index 0000000..9c16f37 --- /dev/null +++ b/ghc/tests/codeGen/cg037.hs @@ -0,0 +1,6 @@ +-- Andy Gill bug report 95/08: +-- Constant strings with '\0' in them don't work :- +-- +main = putStrLn "hello\0 world" +--main = putStrLn "hello0 world" + diff --git a/ghc/tests/codeGen/cg037.stdout b/ghc/tests/codeGen/cg037.stdout new file mode 100644 index 0000000..fa50190 Binary files /dev/null and b/ghc/tests/codeGen/cg037.stdout differ diff --git a/ghc/tests/codeGen/cg038.hs b/ghc/tests/codeGen/cg038.hs new file mode 100644 index 0000000..ffbc697 --- /dev/null +++ b/ghc/tests/codeGen/cg038.hs @@ -0,0 +1,12 @@ +{- +From: Rajiv Mirani +Date: Sat, 26 Aug 95 21:14:47 -0400 +Subject: GHC bug + +GHC can't parse the following program when there is no newline at the +end of the last line: +-} + +module Main where +main = return () +-- random comment \ No newline at end of file diff --git a/ghc/tests/codeGen/cg038.stdout b/ghc/tests/codeGen/cg038.stdout new file mode 100644 index 0000000..e69de29 diff --git a/ghc/tests/codeGen/cg039.hs b/ghc/tests/codeGen/cg039.hs new file mode 100644 index 0000000..8a8d988 --- /dev/null +++ b/ghc/tests/codeGen/cg039.hs @@ -0,0 +1,14 @@ +--! From a Rick Morgan bug report: +--! Single-method class with a locally-polymorphic +--! method. + +module Main where + +class Poly a where + poly :: a -> b -> b + +instance Poly [a] where + poly [] y = y + poly x y = y + +main = print ("hurrah" `poly` "Hello, world!\n") diff --git a/ghc/tests/codeGen/cg039.stdout b/ghc/tests/codeGen/cg039.stdout new file mode 100644 index 0000000..1c2d5d6 --- /dev/null +++ b/ghc/tests/codeGen/cg039.stdout @@ -0,0 +1 @@ +"Hello, world!\n" diff --git a/ghc/tests/codeGen/cg040.hs b/ghc/tests/codeGen/cg040.hs new file mode 100644 index 0000000..b2592f0 --- /dev/null +++ b/ghc/tests/codeGen/cg040.hs @@ -0,0 +1,16 @@ +module Main(main) where + +data Burble a = B1 { op1 :: a -> Int, op2 :: Int -> a, op3 :: Int} + | B2 { op2 :: Int -> a, op4 :: Int -> Int } + + +f1 :: Int -> Burble Int +f1 n = B1 { op1 = \x->x+n, op2 = \x -> x, op3 = n } + +f2 :: Burble a -> Int -> Int +f2 r@(B1 {op1, op2}) n = op1 (op2 n) + op3 r + +f3 :: Burble a -> Burble a +f3 x@(B1 {op3}) = x {op3 = op3+1} + +main = print (f2 (f3 (f1 3)) 4) diff --git a/ghc/tests/codeGen/cg040.stdout b/ghc/tests/codeGen/cg040.stdout new file mode 100644 index 0000000..b4de394 --- /dev/null +++ b/ghc/tests/codeGen/cg040.stdout @@ -0,0 +1 @@ +11 diff --git a/ghc/tests/codeGen/cg041.hs b/ghc/tests/codeGen/cg041.hs new file mode 100644 index 0000000..09ae099 --- /dev/null +++ b/ghc/tests/codeGen/cg041.hs @@ -0,0 +1,22 @@ +{- +Date: Thu, 15 May 1997 14:20:29 +0100 (BST) +From: Alex Ferguson +The following erroneous fragment erroneously compiles. + +And then promptly falls over in the assembler, of all places. +-} + +data Token + = TokNewline + | TokLiteral + | TokCount + | TokCheck + | TokIs + | TokDeref + | TokFind + | TokLiteral -- Duplicated! + | TokThe + + deriving Show + +main = print TokCount diff --git a/ghc/tests/codeGen/cg042.hs b/ghc/tests/codeGen/cg042.hs new file mode 100644 index 0000000..cbb4489 --- /dev/null +++ b/ghc/tests/codeGen/cg042.hs @@ -0,0 +1,49 @@ +--!!! mutable Double array test (ncg test) +-- +module Main ( main ) where + +import PrelBase --ghc1.3 +import GlaExts +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: + freezeDoubleArray arr# + ) + + fill_in :: MutableByteArray s Int -> Int# -> Int# -> ST s () + + fill_in arr_in# first# last# + = if (first# ># last#) + then returnST () + else writeDoubleArray arr_in# (I# first#) ((fromInt (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#) diff --git a/ghc/tests/codeGen/cg042.stdout b/ghc/tests/codeGen/cg042.stdout new file mode 100644 index 0000000..e69de29 diff --git a/ghc/tests/codeGen/cg043.hs b/ghc/tests/codeGen/cg043.hs new file mode 100644 index 0000000..7e06095 --- /dev/null +++ b/ghc/tests/codeGen/cg043.hs @@ -0,0 +1,21 @@ +--!!! Tickled a bug in core2stg +--!!! (CoreSyn.Coerce constructors were not peeled off +--!!! when converting CoreSyn.App) + +module Main where +import GlaExts + + +getData :: String -> PrimIO () +getData filename = case leng filename of {0 -> return ()} +leng :: String -> Int +leng [] = 0 --case ls of {[] -> 0 ; (_:xs) -> 1 + leng xs } +leng ls = leng ls + +f [] [] = [] +f xs ys = f xs ys + +main = + primIOToIO ( + (return ()) >>= \ _ -> + case f [] [] of { [] -> getData [] })