[project @ 1997-07-26 22:48:58 by sof]

ghc/tests/typecheck/should_compile/tc035.hs

+module ShouldSucceed where
+
+type AnnExpr a = (a,Expr a)
+
+data Expr a = Var [Char]
+              | App (AnnExpr a) (AnnExpr a)
+
+g (a,(Var name)) = [name]
+g (a,(App e1 e2)) = (g e1) ++ (g e2)

ghc/tests/typecheck/should_compile/tc036.hs

+module ShouldSucceed where
+
+class (Eq a) => A a where
+ op1 :: a -> a

ghc/tests/typecheck/should_compile/tc037.hi

+interface ShouldSucceed where {
+class Eq' a where {
+    deq :: a -> a -> Bool
+    };
+instance (Eq' a) => Eq' [a] {-# FROMMODULE ShouldSucceed #-}
+}

ghc/tests/typecheck/should_compile/tc037.hs

+module ShouldSucceed where
+
+class Eq' a where
+  deq :: a -> a -> Bool
+
+instance (Eq' a) => Eq' [a] where
+ deq []     [] = True
+ deq (x:xs) (y:ys) = if (x `deq` y) then (deq xs ys) else False
+ deq other1 other2 = False

ghc/tests/typecheck/should_compile/tc038.hs

+module ShouldSucceed where
+
+f (x:xs) = if (x == (fromInteger 2)) then xs else []

ghc/tests/typecheck/should_compile/tc039.hs

+module ShouldSucc where
+
+class (Eq a) => A a where
+ op1 :: a -> a

ghc/tests/typecheck/should_compile/tc040.hi

+interface ShouldSucceed where {
+import PreludeCore(Eq)
+f  ::  Eq a => a -> [a]
+}

ghc/tests/typecheck/should_compile/tc040.hs

+module ShouldSucceed where
+
+--!!! tests the deduction of contexts.
+
+f :: (Eq a) => a -> [a]
+
+f x = g x
+      where
+      g y = if (y == x) then [] else [y]

ghc/tests/typecheck/should_compile/tc041.hs

+--!!! a very simple test of class and instance declarations
+
+module ShouldSucceed where
+
+class H a where
+ op1 :: a -> a -> a
+
+instance H Bool where
+ op1 x y = y
+
+f :: Bool -> Int -> Bool
+f x y = op1 x x

ghc/tests/typecheck/should_compile/tc042.hs

+--!!! a file mailed us by Ryzard Kubiak. This provides a good test of the code
+--!!! handling type signatures and recursive data types.
+
+module ShouldSucceed where
+
+data Boolean = FF | TT
+data Pair a b = Mkpair a b
+data List alpha = Nil | Cons alpha (List alpha)
+data Nat = Zero | Succ Nat
+data Tree t = Leaf t | Node (Tree t) (Tree t) 
+
+idb :: Boolean -> Boolean
+idb x = x      
+
+
+swap :: Pair a b -> Pair b a
+swap t = case t of 
+           Mkpair x y -> Mkpair y x 
+
+neg :: Boolean -> Boolean
+neg b = case b of 
+          FF -> TT 
+          TT -> FF 
+
+nUll :: List alpha -> Boolean
+nUll l = case l of 
+           Nil -> TT
+           Cons y ys  -> FF 
+
+idl ::  List a -> List a
+idl xs  = case xs of
+           Nil -> Nil 
+           Cons y ys -> Cons y (idl ys)
+     
+add :: Nat -> Nat -> Nat
+add a b = case a of 
+            Zero -> b 
+            Succ c -> Succ (add c b) 
+
+app :: List alpha -> List alpha -> List alpha
+app  xs zs  = case xs of
+                  Nil -> zs 
+                  Cons y ys  -> Cons y (app ys zs) 
+                 
+lEngth :: List a -> Nat
+lEngth xs = case xs of 
+              Nil -> Zero  
+              Cons y ys  -> Succ(lEngth ys) 
+
+before :: List Nat -> List Nat
+before xs = case xs of
+              Nil -> Nil
+              Cons y ys -> case y of 
+                              Zero -> Nil
+                              Succ n -> Cons y (before ys)       
+
+rEverse :: List alpha -> List alpha
+rEverse rs = case rs of
+               Nil -> Nil
+               Cons y ys -> app (rEverse ys) (Cons y Nil) 
+             
+
+flatten :: Tree alpha -> List alpha
+flatten t = case t of
+              Leaf x   -> Cons x Nil 
+              Node l r -> app (flatten l) (flatten r)
+         
+sUm :: Tree Nat -> Nat
+sUm t = case t of
+          Leaf t   -> t
+          Node l r -> add (sUm l) (sUm r) 
+
+

ghc/tests/typecheck/should_compile/tc043.hs

+module ShouldSucceed where
+
+--!!! another simple test of class and instance code.
+
+class A a where
+ op1 :: a
+
+instance A Int where
+ op1 = 2
+
+f x = op1
+
+class B b where
+ op2 :: b -> Int
+
+instance (B a) => B [a] where
+ op2 [] = 0
+ op2 (x:xs) = 1 + op2 xs

ghc/tests/typecheck/should_compile/tc044.hs

+-- once produced a bug, here as regression test
+
+module P where
+
+f _ | otherwise = ()
+

ghc/tests/typecheck/should_compile/tc045.hs

+module H where
+
+class C a where
+ op1 :: a -> a
+
+class (C a) => B a where
+ op2 :: a -> a -> a
+
+instance (B a) => B [a] where
+ op2 xs ys = xs
+
+instance C [a] where
+ op1 xs = xs
+
+{- This was passed by the prototype, but failed hard in the new
+typechecker with the message
+
+Fail:No match in theta_class
+-}

ghc/tests/typecheck/should_compile/tc046.hs

+module H where
+
+class C a where
+ op1 :: a -> a
+
+class (C a) => B a where
+ op2 :: a -> a -> a
+
+{- Failed hard in new tc with "No match in theta_class" -}

ghc/tests/typecheck/should_compile/tc047.hs

+module ShouldSucceed where
+
+type OL a =  [a]
+
+-- produces the interface:
+-- data OL a = MkOL [a] deriving ()
+-- ranOAL :: (OL (a, a)) -> [a]
+-- this interface was produced by BOTH hbc and nhc
+
+-- the following bogus type sig. was accepted by BOTH hbc and nhc
+f x = ranOAL where -- ranOAL :: OL (a,v) -> [a]
+--ranOAL :: OL (a,v) -> [v], the right sig.
+		   ranOAL ( xs) = mp sd xs
+
+
+mp f [] = []
+mp f (x:xs) = (f x) : mp f xs
+
+sd (f,s) = s
+
+
+
+

ghc/tests/typecheck/should_compile/tc048.hs

+module ShouldSucceed where
+
+data OL a = MkOL [a]
+data FG a b = MkFG (OL (a,b))
+data AFE n a b = MkAFE (OL (n,(FG a b)))
+
+--ranOAL :: OL (a,v) -> [a]
+ranOAL :: OL (a,v) -> [v]
+ranOAL (MkOL xs) = mAp sNd xs
+
+mAp f [] = []
+mAp f (x:xs) = (f x) : mAp f xs
+
+sNd (f,s) = s
+
+ranAFE :: AFE n a b -> [FG a b]  -- ?
+ranAFE (MkAFE nfs) = ranOAL nfs
+
+
+
+

ghc/tests/typecheck/should_compile/tc049.hs

+module ShouldSucceed where
+
+fib n = if n <= 2 then n else fib (n-1) + fib (n-2)
+
+----------------------------------------
+
+mem x [] = False
+mem x (y:ys) = (x == y) `oR` mem x ys
+
+a `oR` b = if a then True else b
+
+----------------------------------------
+
+mem1 x [] = False
+mem1 x (y:ys) = (x == y) `oR1` mem2 x ys
+
+a `oR1` b = if a then True else b
+
+mem2 x [] = False
+mem2 x (y:ys) = (x == y) `oR` mem1 x ys
+
+---------------------------------------
+
+mem3 x [] = False
+mem3 x (y:ys) = if [x] == [y] then mem4 x ys else False
+
+mem4 y (x:xs) = mem3 y xs
+
+---------------------------------------
+
+main1 = [[(1,True)]] == [[(2,False)]]
+
+---------------------------------------
+
+main2 = "Hello" == "Goodbye"
+
+---------------------------------------
+
+main3 = [[1],[2]] == [[3]]

ghc/tests/typecheck/should_compile/tc050.hs

+module ShouldSucceed where
+
+class Foo a where
+ o_and :: a -> a -> a
+
+
+instance Foo Bool where
+ o_and False x = False
+ o_and x False = False
+ o_and True True = True
+
+
+instance Foo Int where
+ o_and x 0 = 0
+ o_and 0 x = 0
+ o_and 1 1 = 1
+
+
+f x y = o_and x False
+
+g x y = o_and x 1
+
+

ghc/tests/typecheck/should_compile/tc051.hs

+module ShouldSucceed where
+
+class Eq' a where
+ doubleeq :: a -> a -> Bool
+
+class (Eq' a) => Ord' a where
+ lt :: a -> a -> Bool
+
+instance Eq' Int where
+ doubleeq x y = True
+
+instance (Eq' a) => Eq' [a] where
+ doubleeq x y = True
+
+instance Ord' Int where
+ lt x y = True
+
+{-
+class (Ord a) => Ix a where
+ range :: (a,a) -> [a]
+
+instance Ix Int where
+ range (x,y) = [x,y]
+-}
+
+
+
+
+
+

ghc/tests/typecheck/should_compile/tc052.hs

+module ShouldSucceed where
+
+type A a = B a
+
+type B c = C
+
+type C = Int
+