c686b32546286b6de82ee38b32e6cdc3fcc5d211
1 {-# LANGUAGE Arrows #-}
3 -- Toy lambda-calculus interpreter from John Hughes's arrows paper (s5)
5 module Main(main) where
7 import Data.Maybe(fromJust)
8 import Control.Arrow
10 type Id = String
11 data Val a = Num Int | Bl Bool | Fun (a (Val a) (Val a))
12 data Exp = Var Id | Add Exp Exp | If Exp Exp Exp | Lam Id Exp | App Exp Exp
14 eval :: (ArrowChoice a, ArrowApply a) => Exp -> a [(Id, Val a)] (Val a)
15 eval (Var s) = proc env ->
16 returnA -< fromJust (lookup s env)
17 eval (Add e1 e2) = proc env -> do
18 ~(Num u) <- eval e1 -< env
19 ~(Num v) <- eval e2 -< env
20 returnA -< Num (u + v)
21 eval (If e1 e2 e3) = proc env -> do
22 ~(Bl b) <- eval e1 -< env
23 if b then eval e2 -< env
24 else eval e3 -< env
25 eval (Lam x e) = proc env ->
26 returnA -< Fun (proc v -> eval e -< (x,v):env)
27 eval (App e1 e2) = proc env -> do
28 ~(Fun f) <- eval e1 -< env
29 v <- eval e2 -< env
30 f -<< v
32 -- some tests
34 i = Lam "x" (Var "x")
35 k = Lam "x" (Lam "y" (Var "x"))
36 double = Lam "x" (Add (Var "x") (Var "x"))
38 -- if b then k (double x) x else x + x + x
40 text_exp = If (Var "b")
41 (App (App k (App double (Var "x"))) (Var "x"))