a12/charlie/skeleton12_gadt.icl

   1 module skeleton12
   2
   3 import StdEnv
   4 import StdMaybe
   5
   6 :: BM a b = {t :: a -> b, f :: b -> a}
   7 bm :: BM a a
   8 bm = {f=id, t=id}
   9 :: Expr a
  10         = Lit (BM a Int) Int
  11         | Add (BM a Int) (Expr a) (Expr a)
  12         | Mul (BM a Int) (Expr a) (Expr a)
  13         | Read
  14         | Write (BM a a) (Expr a)
  15         | XOR (BM a a) (Expr a) (Expr a)
  16         | Not (BM a a) (Expr a)
  17         | E.b: Eq (BM b a) (Expr b) (Expr b) & == b
  18         | Throw
  19         | Try (BM a a) (BM a a)
  20
  21 class show a where
  22         show :: (a t) [String] -> [String] | toString t
  23
  24 instance show Expr where
  25         show (Lit bm x) xs = [toString x:xs]
  26         show (Add bm x y) xs = show x ["+":show y xs]
  27         show (Mul bm x y) xs = show x ["*":show y xs]
  28         show Read xs = ["read":xs]
  29         show (Write bm x) xs = ["write":show x xs]
  30         show (XOR bm x y) xs = show x ["XOR":show y xs]
  31         show (Not bm x) xs = show x xs
  32         show (Eq bm x y) xs = show x ["==":show y xs]
  33         show Throw xs = ["throw":xs]
  34         show (Try x y) xs = ["try":show x ["catch":show y xs]]
  35
  36 Start = 1