ghc/compiler/tests/typecheck/should_succeed/tc042.hs

   1 --!!! a file mailed us by Ryzard Kubiak. This provides a good test of the code
   2 --!!! handling type signatures and recursive data types.
   3
   4 module ShouldSucceed where
   5
   6 data Boolean = FF | TT
   7 data Pair a b = Mkpair a b
   8 data List alpha = Nil | Cons alpha (List alpha)
   9 data Nat = Zero | Succ Nat
  10 data Tree t = Leaf t | Node (Tree t) (Tree t)
  11
  12 idb :: Boolean -> Boolean
  13 idb x = x
  14
  15
  16 swap :: Pair a b -> Pair b a
  17 swap t = case t of
  18            Mkpair x y -> Mkpair y x
  19
  20 neg :: Boolean -> Boolean
  21 neg b = case b of
  22           FF -> TT
  23           TT -> FF
  24
  25 nUll :: List alpha -> Boolean
  26 nUll l = case l of
  27            Nil -> TT
  28            Cons y ys  -> FF
  29
  30 idl ::  List a -> List a
  31 idl xs  = case xs of
  32            Nil -> Nil
  33            Cons y ys -> Cons y (idl ys)
  34
  35 add :: Nat -> Nat -> Nat
  36 add a b = case a of
  37             Zero -> b
  38             Succ c -> Succ (add c b)
  39
  40 app :: List alpha -> List alpha -> List alpha
  41 app  xs zs  = case xs of
  42                   Nil -> zs
  43                   Cons y ys  -> Cons y (app ys zs)
  44
  45 lEngth :: List a -> Nat
  46 lEngth xs = case xs of
  47               Nil -> Zero
  48               Cons y ys  -> Succ(lEngth ys)
  49
  50 before :: List Nat -> List Nat
  51 before xs = case xs of
  52               Nil -> Nil
  53               Cons y ys -> case y of
  54                               Zero -> Nil
  55                               Succ n -> Cons y (before ys)
  56
  57 rEverse :: List alpha -> List alpha
  58 rEverse rs = case rs of
  59                Nil -> Nil
  60                Cons y ys -> app (rEverse ys) (Cons y Nil)
  61
  62
  63 flatten :: Tree alpha -> List alpha
  64 flatten t = case t of
  65               Leaf x   -> Cons x Nil
  66               Node l r -> app (flatten l) (flatten r)
  67
  68 sUm :: Tree Nat -> Nat
  69 sUm t = case t of
  70           Leaf t   -> t
  71           Node l r -> add (sUm l) (sUm r)
  72
  73