blob: c686b32546286b6de82ee38b32e6cdc3fcc5d211 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
|
{-# LANGUAGE Arrows #-}
-- Toy lambda-calculus interpreter from John Hughes's arrows paper (s5)
module Main(main) where
import Data.Maybe(fromJust)
import Control.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"))
-- if b then k (double x) x else x + x + x
text_exp = If (Var "b")
(App (App k (App double (Var "x"))) (Var "x"))
(Add (Var "x") (Add (Var "x") (Var "x")))
unNum (Num n) = n
main = do
print (unNum (eval text_exp [("b", Bl True), ("x", Num 5)]))
print (unNum (eval text_exp [("b", Bl False), ("x", Num 5)]))
|
