ghc/tests/stranal/should_compile/sim.lhs

   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