ghc/tests/stranal/should_compile/sim.hs

   1 module Test where
   2 data Boolean = FF | TT
   3 data Pair a b = MkPair a b
   4 data LList alpha = Nill | Conss alpha (LList alpha)
   5 data Nat = Zero | Succ Nat
   6 data Tree x = Leaf x | Node (Tree x) (Tree x)
   7 data A a = MkA a (A a)
   8 {-
   9 id :: a -> a
  10 id x = x
  11
  12 idb :: Boolean -> Boolean
  13 idb b = b
  14
  15 swap :: Pair a b -> Pair b a
  16 swap t = case t of
  17            MkPair x y -> MkPair y x
  18
  19 bang :: A (A a) -> Boolean
  20 bang x = case x of
  21            MkA y ys -> TT
  22
  23 neg :: Boolean -> Boolean
  24 neg b = case b of
  25          FF -> TT
  26          TT -> FF
  27
  28 null :: LList x -> Boolean
  29 null l = case l of
  30            Nill -> TT
  31            _ -> FF
  32
  33 loop :: Boolean -> a
  34 loop b = loop b
  35 -}
  36 idl ::  LList a -> LList a
  37 idl xs  = case xs of
  38            Conss y ys -> Conss y (idl ys)
  39            _ -> Nill
  40 {-
  41 idn :: Nat -> Nat
  42 idn n = case n of
  43           Zero -> Zero
  44           Succ m -> Succ (idn m)
  45
  46 add :: Nat -> Nat -> Nat
  47 add a b = case a of
  48             Zero -> b
  49             Succ c -> Succ (add c b)
  50
  51 length :: LList a -> Nat
  52 length xs = case xs of
  53               Nill -> Zero
  54               Conss y ys  -> Succ(length ys)
  55
  56 before :: LList Nat -> LList Nat
  57 before xs = case xs of
  58               Nill -> Nill
  59               Conss y ys -> case y of
  60                              Zero -> Nill
  61                              Succ n -> Conss y (before ys)
  62
  63 reverse :: LList a -> LList a
  64 reverse rs = case rs of
  65                Nill -> Nill
  66                Conss y ys -> append (reverse ys) (Conss y Nill)
  67
  68 f :: Nat -> Nat
  69 f n = case n of
  70         Zero -> Zero
  71         Succ m -> Succ (g m)
  72
  73 g :: Nat -> Nat
  74 g n = case n of
  75        Zero -> Zero
  76        Succ m -> Succ (f m)
  77
  78 append :: LList a -> LList a -> LList a
  79 append  xs ys  = case xs of
  80                   Nill -> ys
  81                   Conss z zs  -> Conss z (append zs ys)
  82
  83 flatten :: Tree alpha -> LList alpha
  84 flatten t = case t of
  85               Leaf x   -> Conss x Nill
  86               Node l r -> append (flatten l) (flatten r)
  87
  88 sum :: Tree Nat -> Nat
  89 sum t = case t of
  90           Leaf t   -> t
  91           Node l r -> add (sum l) (sum r)
  92
  93 suml :: LList Nat -> Nat
  94 suml Nill = Zero
  95 suml (Conss n ns) = add n (suml ns)
  96
  97 map :: (a -> b) -> LList a -> LList b
  98 map f xs = case xs of
  99              Nill -> Nill
 100              Conss y ys -> Conss (f y) (map f ys)
 101 -}
 102
 103