repos / machines.hs.git

commit

fd5db40

parent

796991e

author

Evgenii Akentev

date

2024-09-05 10:41:54 +0400 +04

Add SE and EC

1@@ -14,7 +14,7 @@ library
2     import:           warnings
3     exposed-modules:  Krivine,
4                       CEK,
5-                      SECD, SEC
6+                      SECD, SEC, SE, EC
7     build-depends:    base ^>=4.18.2.1
8     hs-source-dirs:   src
9     default-language: Haskell2010

 1@@ -0,0 +1,52 @@
 2+module EC where
 3+
 4+-- https://www.brics.dk/RS/03/33/BRICS-RS-03-33.pdf
 5+
 6+data Term = Appl Term Term | Var String | Abst String Term | Lit Int
 7+  deriving (Show)
 8+
 9+data Val = Num Int | Succ | Closure Term String Env
10+  deriving (Show)
11+
12+type Env = [(String, Val)]
13+
14+data Stackable = SEnv Env 
15+               | STerm Term
16+               | SVal Val
17+
18+type C = [Stackable]
19+
20+initEnv :: Env
21+initEnv = [("succ", Succ)]
22+
23+runC :: (Val, Env, C) -> Val
24+runC (v, e, []) = v
25+runC (v, e, (SEnv e'):c) = runC (v, e', c)
26+runC (v1, e, (STerm t0):c) = runT (t0, e, (SVal v1):c)
27+runC (v0, e, (SVal v1):c) = runA (v0, v1, e, c)
28+
29+runT :: (Term, Env, C) -> Val
30+runT (Lit n, e, c) = runC (Num n, e, c)
31+runT (Var x, e, c) = case lookup x e of
32+  Just v -> runC (v, e, c)
33+  Nothing -> error "var is not in scope"
34+runT (Abst x t, e, c) = runC (Closure t x e, e, c)
35+runT (Appl t0 t1, e, c) = runT (t1, e, (STerm t0):c)
36+
37+runA :: (Val, Val, Env, C) -> Val 
38+runA (Succ, Num n, e, c) = runC (Num $ n + 1, e, c)
39+runA (Closure t x e', v, e, c) = runT (t, (x, v):e', (SEnv e):c)
40+
41+-- (\ 0 0) (\ 0)
42+t1 :: Term
43+t1 = Appl (Abst "x" (Appl (Var "x") (Var "x"))) (Abst "x" (Appl (Var "succ") (Lit 1)))
44+
45+ex1 :: Val
46+ex1 = runT (t1, initEnv, [])
47+
48+--((λ 0) (λ 0)) (λ 0)
49+t2 :: Term
50+t2 = Appl (Appl (Abst "x" $ Var "x") (Abst "x" $ Var "x")) (Abst "x" $ Var "x")
51+
52+ex2 :: Val
53+ex2 = runT (t2, initEnv, [])

 1@@ -0,0 +1,55 @@
 2+module SE where
 3+
 4+-- https://www.brics.dk/RS/03/33/BRICS-RS-03-33.pdf
 5+
 6+data Term = Appl Term Term | Var String | Abst String Term | Lit Int
 7+  deriving (Show)
 8+
 9+data Val = Num Int | Succ | Closure Term String Env
10+  deriving (Show)
11+
12+data Directive = DTerm Term | DApply
13+
14+type Stack = [Val]
15+type Env = [(String, Val)]
16+type Control = Stack -> Env -> Stack
17+
18+initEnv :: Env
19+initEnv = [("succ", Succ)]
20+
21+eval :: (Term, Stack, Env) -> (Stack, Env)
22+eval (Lit n, s, e) = ((Num n):s, e)
23+eval (Var x, s, e) = case lookup x e of
24+  Just v -> (v:s, e)
25+  Nothing -> error "var not in scope"
26+eval (Abst x t, s, e) = ((Closure t x e):s, e)
27+eval (Appl t0 t1, s, e) =
28+  let
29+    (s', e') = eval (t1, s, e)
30+    (s'', e'') = eval (t0, s', e')
31+  in apply (s'', e'')
32+
33+apply :: (Stack, Env) -> (Stack, Env)
34+apply (Succ : (Num n):s, e) = ((Num $ n + 1):s, e)
35+apply ((Closure t x e'):v':s, e) =
36+  let ([v], _) = eval (t, [], (x, v'):e') 
37+  in (v:s, e)
38+
39+evaluate :: Term -> Val
40+evaluate t =
41+  let ([v], _) = eval (t, [], initEnv) 
42+  in v
43+
44+-- (\ 0 0) (\ 0)
45+t1 :: Term
46+t1 = Appl (Abst "x" (Appl (Var "x") (Var "x"))) (Abst "x" (Appl (Var "succ") (Lit 1)))
47+
48+ex1 :: Val
49+ex1 = evaluate t1
50+
51+--((λ 0) (λ 0)) (λ 0)
52+t2 :: Term
53+t2 = Appl (Appl (Abst "x" $ Var "x") (Abst "x" $ Var "x")) (Abst "x" $ Var "x")
54+
55+ex2 :: Val
56+ex2 = evaluate t2