From: Evgenii Akentev <hi@ak3n.com>
Date: Thu, 5 Sep 2024 06:41:54 +0000 (+0400)
Subject: Add SE and EC
X-Git-Url: https://git.ak3n.com/?a=commitdiff_plain;h=fd5db40c4d035706b23a929a64fe7e208abbce17;p=machines.hs.git

Add SE and EC
---

diff --git a/machines.cabal b/machines.cabal
index 8456e17..aa34dc1 100644
--- a/machines.cabal
+++ b/machines.cabal
@@ -14,7 +14,7 @@ library
     import:           warnings
     exposed-modules:  Krivine,
                       CEK,
-                      SECD, SEC
+                      SECD, SEC, SE, EC
     build-depends:    base ^>=4.18.2.1
     hs-source-dirs:   src
     default-language: Haskell2010
diff --git a/src/EC.hs b/src/EC.hs
new file mode 100644
index 0000000..d353fa5
--- /dev/null
+++ b/src/EC.hs
@@ -0,0 +1,52 @@
+module EC where
+
+-- https://www.brics.dk/RS/03/33/BRICS-RS-03-33.pdf
+
+data Term = Appl Term Term | Var String | Abst String Term | Lit Int
+  deriving (Show)
+
+data Val = Num Int | Succ | Closure Term String Env
+  deriving (Show)
+
+type Env = [(String, Val)]
+
+data Stackable = SEnv Env 
+               | STerm Term
+               | SVal Val
+
+type C = [Stackable]
+
+initEnv :: Env
+initEnv = [("succ", Succ)]
+
+runC :: (Val, Env, C) -> Val
+runC (v, e, []) = v
+runC (v, e, (SEnv e'):c) = runC (v, e', c)
+runC (v1, e, (STerm t0):c) = runT (t0, e, (SVal v1):c)
+runC (v0, e, (SVal v1):c) = runA (v0, v1, e, c)
+
+runT :: (Term, Env, C) -> Val
+runT (Lit n, e, c) = runC (Num n, e, c)
+runT (Var x, e, c) = case lookup x e of
+  Just v -> runC (v, e, c)
+  Nothing -> error "var is not in scope"
+runT (Abst x t, e, c) = runC (Closure t x e, e, c)
+runT (Appl t0 t1, e, c) = runT (t1, e, (STerm t0):c)
+
+runA :: (Val, Val, Env, C) -> Val 
+runA (Succ, Num n, e, c) = runC (Num $ n + 1, e, c)
+runA (Closure t x e', v, e, c) = runT (t, (x, v):e', (SEnv e):c)
+
+-- (\ 0 0) (\ 0)
+t1 :: Term
+t1 = Appl (Abst "x" (Appl (Var "x") (Var "x"))) (Abst "x" (Appl (Var "succ") (Lit 1)))
+
+ex1 :: Val
+ex1 = runT (t1, initEnv, [])
+
+--((λ 0) (λ 0)) (λ 0)
+t2 :: Term
+t2 = Appl (Appl (Abst "x" $ Var "x") (Abst "x" $ Var "x")) (Abst "x" $ Var "x")
+
+ex2 :: Val
+ex2 = runT (t2, initEnv, [])
diff --git a/src/SE.hs b/src/SE.hs
new file mode 100644
index 0000000..e4c8f7e
--- /dev/null
+++ b/src/SE.hs
@@ -0,0 +1,55 @@
+module SE where
+
+-- https://www.brics.dk/RS/03/33/BRICS-RS-03-33.pdf
+
+data Term = Appl Term Term | Var String | Abst String Term | Lit Int
+  deriving (Show)
+
+data Val = Num Int | Succ | Closure Term String Env
+  deriving (Show)
+
+data Directive = DTerm Term | DApply
+
+type Stack = [Val]
+type Env = [(String, Val)]
+type Control = Stack -> Env -> Stack
+
+initEnv :: Env
+initEnv = [("succ", Succ)]
+
+eval :: (Term, Stack, Env) -> (Stack, Env)
+eval (Lit n, s, e) = ((Num n):s, e)
+eval (Var x, s, e) = case lookup x e of
+  Just v -> (v:s, e)
+  Nothing -> error "var not in scope"
+eval (Abst x t, s, e) = ((Closure t x e):s, e)
+eval (Appl t0 t1, s, e) =
+  let
+    (s', e') = eval (t1, s, e)
+    (s'', e'') = eval (t0, s', e')
+  in apply (s'', e'')
+
+apply :: (Stack, Env) -> (Stack, Env)
+apply (Succ : (Num n):s, e) = ((Num $ n + 1):s, e)
+apply ((Closure t x e'):v':s, e) =
+  let ([v], _) = eval (t, [], (x, v'):e') 
+  in (v:s, e)
+
+evaluate :: Term -> Val
+evaluate t =
+  let ([v], _) = eval (t, [], initEnv) 
+  in v
+
+-- (\ 0 0) (\ 0)
+t1 :: Term
+t1 = Appl (Abst "x" (Appl (Var "x") (Var "x"))) (Abst "x" (Appl (Var "succ") (Lit 1)))
+
+ex1 :: Val
+ex1 = evaluate t1
+
+--((λ 0) (λ 0)) (λ 0)
+t2 :: Term
+t2 = Appl (Appl (Abst "x" $ Var "x") (Abst "x" $ Var "x")) (Abst "x" $ Var "x")
+
+ex2 :: Val
+ex2 = evaluate t2