repos / machines.hs.git

commit

6f905d4

parent

7ae50ab

author

Evgenii Akentev

date

2024-09-07 22:05:41 +0400 +04

Add Virtual CLS and SECD machines

1@@ -23,6 +23,8 @@ library
2                       Virtual.Krivine,
3                       Virtual.CAM,
4                       Virtual.VEC,
5+                      Virtual.CLS,
6+                      Virtual.SECD,
7     build-depends:    base ^>=4.18.2.1
8     hs-source-dirs:   src
9     default-language: Haskell2010

 1@@ -0,0 +1,46 @@
 2+{-# language LambdaCase #-}
 3+
 4+module Virtual.CLS where
 5+
 6+-- From Interpreter to Compiler and
 7+-- Virtual Machine: A Functional Derivation
 8+-- https://pdfs.semanticscholar.org/08f9/c12239dd720cb28a1039db9ce706cc7ee3b2.pdf
 9+
10+data Term = Var Int | Lam Term | App Term Term
11+data Inst = Access Int | ILam [Inst] | Ap | Push
12+  deriving (Show)
13+type Env = [Val]
14+data Val = Closure [Inst] Env 
15+  deriving (Show)
16+
17+compile :: Term -> [Inst]
18+compile = \case
19+  (Var n) -> [Access n]
20+  (Lam t) -> [ILam $ compile t]
21+  (App t0 t1) -> Push : compile t0 ++ compile t1 ++ [Ap]
22+
23+
24+step :: [Inst] -> [Env] -> [Val] -> Val
25+step (Access 0 : c) ((v : _) : l) s = step c l (v : s) 
26+step (Access n : c) ((_ : e) : l) s = step (Access (n - 1) : c) (e : l) s
27+step (ILam c : c') (e : l) s = step c' l (Closure c e : s)
28+step (Ap : c) l (v : (Closure c' e) : s) = step (c' ++ c) ((v : e) : l) s
29+step (Push : c) (e : l) s = step c (e : e : l) s
30+step [] _ (v : _) = v
31+
32+eval :: Term -> Val
33+eval t = step  (compile t) [[]] []
34+
35+-- (\ 0 0) (\ 0)
36+t1 :: Term
37+t1 = App (Lam (App (Var 0) (Var 0))) (Lam (Var 0))
38+
39+ex1 :: Val
40+ex1 = eval t1
41+
42+--((λ 0) (λ 0)) (λ 0)
43+t2 :: Term
44+t2 = App (App (Lam $ Var 0) (Lam $ Var 0)) (Lam $ Var 0)
45+
46+ex2 :: Val
47+ex2 = eval t2

 1@@ -0,0 +1,46 @@
 2+{-# language LambdaCase #-}
 3+
 4+module Virtual.SECD where
 5+
 6+-- From Interpreter to Compiler and
 7+-- Virtual Machine: A Functional Derivation
 8+-- https://pdfs.semanticscholar.org/08f9/c12239dd720cb28a1039db9ce706cc7ee3b2.pdf
 9+
10+data Term = Var String | Lam String Term | App Term Term
11+data Inst = Access String | Close String [Inst] | Call
12+  deriving (Show)
13+type Env = [(String, Val)]
14+data Val = Closure String [Inst] Env 
15+  deriving (Show)
16+
17+compile :: Term -> [Inst]
18+compile = \case
19+  (Var x) -> [Access x]
20+  (Lam x t) -> [Close x $ compile t]
21+  (App t0 t1) -> compile t1 ++ compile t0 ++ [Call]
22+
23+
24+step :: [Inst] -> Env -> [Val] -> Val
25+step (Access x : c) e s = case lookup x e of
26+  Just v -> step c e (v:s)
27+  Nothing -> error "Var not in scope"
28+step (Close x c' : c) e s = step c e (Closure x c' e : s)
29+step (Call : c) e (Closure x c' e' : v : s) = step (c' ++ c) ((x, v):e') s
30+step [] e (v:_) = v
31+
32+eval :: Term -> Val
33+eval t = step (compile t) [] []
34+
35+-- (\ 0 0) (\ 0)
36+t1 :: Term
37+t1 = App (Lam "x" (App (Var "x") (Var "x"))) (Lam "x" (Var "x"))
38+
39+ex1 :: Val
40+ex1 = eval t1
41+
42+--((λ 0) (λ 0)) (λ 0)
43+t2 :: Term
44+t2 = App (App (Lam "x" $ Var "x") (Lam "x" $ Var "x")) (Lam "x" $ Var "x")
45+
46+ex2 :: Val
47+ex2 = eval t2