5 import Control.Applicative
9 :: BM a b = { to :: a -> b, fro :: b -> a}
13 class eval m where eval :: (m a) -> Maybe a
14 class print m where print :: (m a) [String] -> [String]
15 class flat m where flat :: (m a) -> DSL a
17 = E.e: Lit (BM e a) a & toString e
18 | E.e: Plus (BM e a) (DSL e) (DSL e) & + e
19 | E.m: Ext (m a) & eval, print, flat m
24 instance eval DSL where
25 eval (Lit _ a) = Just a
26 eval (Plus bm x y) = bm.to <$> ((+) <$> eval x <*> eval y)
29 instance print DSL where
30 print (Lit bm a) c = [toString (bm.fro a):c]
31 print (Plus _ x y) c = print x ["+":print y c]
32 print (Ext m) c = print m c
34 instance flat DSL where
35 flat (Ext m) = Ext (flat m)
38 :: Div a = E.e: Div (BM e a) (DSL e) (DSL e) & /, zero, == e
40 (/.) x y = Ext (Div bm x y)
42 instance eval Div where
43 eval (Div bm x y) = bm.to <$> (eval x >>= \x->eval y >>= \y->
44 if (y == zero) Nothing (Just (x/y)))
46 instance print Div where
47 print (Div bm x y) c = print x ["/":print y c]
49 instance flat Div where
52 :: In a b = In infix 0 a b
53 :: Var a = E.b: Var ((DSL b) -> In (DSL b) (DSL a))
55 instance eval Var where
57 let (init In body) = def init
60 instance print Var where
62 let (init In body) = def init
63 in ["let _ = ":print init [" in ":print body c]]
65 instance flat Var where
67 let (init In body) = def init
70 Start = printEval (var \x=lit 41 In x +. lit 1)
72 printEval :: (DSL a) -> (Maybe a, [String])
73 printEval e = (eval e, print e [])