Commit 993cfba3 authored by Ian Lynagh's avatar Ian Lynagh
Browse files

Remove the tcrun007 test

It was testing the old Generics extension, which has now been
removed.
parent a0799f19
......@@ -21,7 +21,6 @@ def f(opts):
setTestOpts(f)
test('tcrun006', normal, compile_and_run, [''])
test('tcrun007', normal, compile_and_run, [''])
test('tcrun008', normal, compile_and_run, [''])
test('tcrun009', normal, compile_and_run, [''])
test('tcrun010', normal, compile_and_run, [''])
......
{-# LANGUAGE Generics, TypeOperators #-}
-- !!! Test generics
module Main where
import GHC.Base
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)
[0,3,0,6,1,1,1]
(MkT 3 (MkT 6 Nil Nil) Nil,[])
2
5
5
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment