appendix/lst/expr_gadt.icl

   1 module expr_gadt
   2 import StdEnv
   3
   4 :: BM a b = { ab :: a -> b, ba  :: b -> a }
   5 bm :: BM a a
   6 bm = {ab=id, ba=id}
   7
   8 :: Expr a
   9         = E.e: Lit (BM a e) e                    & toString e
  10         | E.e: Add (BM a e) (Expr e) (Expr e)    & + e
  11         | E.e: Eq  (BM a Bool) (Expr e) (Expr e) & == e
  12 lit e = Lit bm e
  13 add l r = Add bm l r
  14 eq l r = Eq bm l r
  15
  16 eval :: (Expr a) -> a
  17 eval (Lit bm e)   = bm.ba e
  18 eval (Add bm l r) = bm.ba (eval l + eval r)
  19 eval (Eq  bm l r) = bm.ba (eval l == eval r)
  20
  21 print :: (Expr a) -> String
  22 print (Lit _ e)   = toString e
  23 print (Add _ l r) = print l +++ "+" +++ print r
  24 print (Eq  _ l r) = print l +++ "==" +++ print r
  25
  26 Start = 42