[project @ 2000-10-05 16:18:03 by simonpj]

Add test for generics

diff --git a/ghc/tests/typecheck/should_run/tcrun007.hs b/ghc/tests/typecheck/should_run/tcrun007.hs
new file mode 100644 (file)
index 0000000..d575afd
--- /dev/null
+++ b/ghc/tests/typecheck/should_run/tcrun007.hs
@@ -0,0 +1,62 @@
+{-# OPTIONS -fglasgow-exts -fgenerics #-}
+
+-- !!! Test generics
+module Main where
+
+import PrelBase                -- In a real program it would be 'import Generics'
+                       -- but Generics is in package lang, so importing
+                       -- PrelBase reduces dependencies
+
+class Bin a where
+  toBin   :: a -> [Int]
+  fromBin :: [Int] -> (a, [Int])
+
+  toBin {| Unit |}    Unit     = []
+  toBin {| a :+: b |} (Inl x)   = 0 : toBin x
+  toBin {| a :+: b |} (Inr y)   = 1 : toBin y
+  toBin {| a :*: b |} (x :*: y) = toBin x ++ toBin y
+
+
+  fromBin {| Unit |}    bs      = (Unit, bs)
+  fromBin {| a :+: b |} (0:bs)  = (Inl x, bs') where (x,bs') = fromBin bs
+  fromBin {| a :+: b |} (1:bs)  = (Inr y, bs') where (y,bs') = fromBin bs
+  fromBin {| a :*: b |} bs     = (x :*: y, bs'') where (x,bs' ) = fromBin bs
+                                                       (y,bs'') = fromBin bs'
+
+
+class Tag a where
+  nCons :: a -> Int
+  nCons {| Unit |}    _ = 1
+  nCons {| a :*: b |} _ = 1
+  nCons {| a :+: b |} _ = nCons (bot::a) + nCons (bot::b)
+
+  tag :: a -> Int
+  tag {| Unit |}    _      = 1
+  tag {| a :*: b |} _      = 1   
+  tag {| a :+: b |} (Inl x) = tag x
+  tag {| a :+: b |} (Inr y) = nCons (bot::a) + tag y
+  
+bot = bot
+
+instance (Bin a, Bin b) => Bin (a,b)
+instance Bin a => Bin [a]
+instance Bin a => Bin (T a)
+
+instance Bin Int where
+  toBin x = [x]
+  fromBin (x:xs) = (x,xs)
+
+data T a = MkT a (T a) (T a) | Nil deriving Show
+
+instance Tag Colour 
+data Colour = Red | Blue | Green | Purple | White
+
+t :: T Int
+t = MkT 3 (MkT 6 Nil Nil) Nil
+
+main = print (toBin t) >>
+       print ((fromBin (toBin t))::(T Int,[Int])) >>
+       print (tag Blue) >>
+       print (tag White) >>
+       print (nCons Red)
+

diff --git a/ghc/tests/typecheck/should_run/tcrun007.stdout b/ghc/tests/typecheck/should_run/tcrun007.stdout
new file mode 100644 (file)
index 0000000..3b451bf
--- /dev/null
+++ b/ghc/tests/typecheck/should_run/tcrun007.stdout
@@ -0,0 +1,5 @@
+[0,3,0,6,1,1,1]
+(MkT 3 (MkT 6 Nil Nil) Nil,[])
+2
+5
+5