From: charlie Date: Sun, 13 Dec 2015 20:46:30 +0000 (+0100) Subject: gadt shit X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=HEAD;p=ap2015.git gadt shit --- diff --git a/a12/charlie/skeleton12_gadt.icl b/a12/charlie/skeleton12_gadt.icl new file mode 100644 index 0000000..58da675 --- /dev/null +++ b/a12/charlie/skeleton12_gadt.icl @@ -0,0 +1,36 @@ +module skeleton12 + +import StdEnv +import StdMaybe + +:: BM a b = {t :: a -> b, f :: b -> a} +bm :: BM a a +bm = {f=id, t=id} +:: Expr a + = Lit (BM a Int) Int + | Add (BM a Int) (Expr a) (Expr a) + | Mul (BM a Int) (Expr a) (Expr a) + | Read + | Write (BM a a) (Expr a) + | XOR (BM a a) (Expr a) (Expr a) + | Not (BM a a) (Expr a) + | E.b: Eq (BM b a) (Expr b) (Expr b) & == b + | Throw + | Try (BM a a) (BM a a) + +class show a where + show :: (a t) [String] -> [String] | toString t + +instance show Expr where + show (Lit bm x) xs = [toString x:xs] + show (Add bm x y) xs = show x ["+":show y xs] + show (Mul bm x y) xs = show x ["*":show y xs] + show Read xs = ["read":xs] + show (Write bm x) xs = ["write":show x xs] + show (XOR bm x y) xs = show x ["XOR":show y xs] + show (Not bm x) xs = show x xs + show (Eq bm x y) xs = show x ["==":show y xs] + show Throw xs = ["throw":xs] + show (Try x y) xs = ["try":show x ["catch":show y xs]] + +Start = 1