-- Toy lambda-calculus interpreter from John Hughes's arrows paper (s5) import Maybe(fromJust) import Arrow type Id = String data Val a = Num Int | Bl Bool | Fun (a (Val a) (Val a)) data Exp = Var Id | Add Exp Exp | If Exp Exp Exp | Lam Id Exp | App Exp Exp eval :: (ArrowChoice a, ArrowApply a) => Exp -> a [(Id, Val a)] (Val a) eval (Var s) = proc env -> returnA -< fromJust (lookup s env) eval (Add e1 e2) = proc env -> do ~(Num u) <- eval e1 -< env ~(Num v) <- eval e2 -< env returnA -< Num (u + v) eval (If e1 e2 e3) = proc env -> do ~(Bl b) <- eval e1 -< env if b then eval e2 -< env else eval e3 -< env eval (Lam x e) = proc env -> returnA -< Fun (proc v -> eval e -< (x,v):env) eval (App e1 e2) = proc env -> do ~(Fun f) <- eval e1 -< env v <- eval e2 -< env f -< v -- some tests i = Lam "x" (Var "x") k = Lam "x" (Lam "y" (Var "x")) double = Lam "x" (Add (Var "x") (Var "x")) t = n where Num n = eval (If (Var "b") (App (App k (App double (Var "x"))) (Var "x")) (Add (Var "x") (Add (Var "x") (Var "x")))) [("b", Bl True), ("x", Num 5)]