[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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
index 0000000..4d2f06d
--- /dev/null
+++ b/ghc/tests/codeGen/cg013.hs
@@ -0,0 +1,78 @@
+{-
+From: Kevin Hammond <kh>
+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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
index 0000000..e69de29

diff --git a/ghc/tests/codeGen/cg017.hs b/ghc/tests/codeGen/cg017.hs
new file mode 100644 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
index 0000000..b709a78
--- /dev/null
+++ b/ghc/tests/codeGen/cg033.hs
@@ -0,0 +1,77 @@
+--!! worker/wrapper turns ( \ <absent> -> 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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 (file)
index 0000000..3713268
--- /dev/null
+++ b/ghc/tests/codeGen/cg036.stdout
@@ -0,0 +1 @@
+<<function>>

diff --git a/ghc/tests/codeGen/cg037.hs b/ghc/tests/codeGen/cg037.hs
new file mode 100644 (file)
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 (file)
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 (file)
index 0000000..ffbc697
--- /dev/null
+++ b/ghc/tests/codeGen/cg038.hs
@@ -0,0 +1,12 @@
+{-
+From: Rajiv Mirani <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 (file)
index 0000000..e69de29

diff --git a/ghc/tests/codeGen/cg039.hs b/ghc/tests/codeGen/cg039.hs
new file mode 100644 (file)
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 (file)
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 (file)
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 (file)
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 (file)
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 <abf@cs.ucc.ie>
+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 (file)
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 (file)
index 0000000..e69de29

diff --git a/ghc/tests/codeGen/cg043.hs b/ghc/tests/codeGen/cg043.hs
new file mode 100644 (file)
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 [] })