整理收集了 Graham Hutton (http://www.cs.nott.ac.uk/~pszgmh/)
几个简单浅显的虚拟机。
stack machine https://github.com/pa-ba/calc-comp
data Expr = Val Int | Add Expr Expr
-- Interpeter
eval :: Expr -> Int
eval (Val n) = n
eval (Add x y) = eval x + eval y
data Code = HALT | PUSH Int Code | ADD Code
deriving Show
--- Compiler
comp :: Expr -> Code
comp e = comp' e HALT
comp' :: Expr -> Code -> Code
comp' (Val n) c = PUSH n c
comp' (Add x y) c = comp' x (comp' y (ADD c))
--- Stack virtual machine
type Stack = [Int]
exec :: Code -> Stack -> Stack
exec HALT s = s
exec (PUSH n c) s = exec c (n:s)
exec (ADD c) (m:n:s) = exec c ((n+m) : s)
exec (comp (Add (Add (Val 2) (Val 3)) (Val 4)))
reg machine https://github.com/pa-ba/reg-machine
这里可以理解 Mem 为寄存器池。通过提供存取函数模拟。
data Expr = Val Int | Add Expr Expr
deriving Show
data Code = LOAD Int Code | STORE Reg Code | ADD Reg Code | HALT
deriving Show
compile :: Expr -> Code
compile e = comp e first HALT
comp :: Expr -> Reg -> Code -> Code
comp (Val n) r c = LOAD n c
comp (Add x y) r c = comp x r (STORE r (comp y (next r) (ADD r c)))
type Mem = Reg -> Int
type Reg = Int
type Conf = (Acc,Mem)
type Acc = Int
empty :: Mem
empty = \n -> 0
set :: Reg -> Int -> Mem -> Mem
set r n m = \r' -> if r == r' then n else get r' m
get :: Reg -> Mem -> Int
get r m = m r
first :: Reg
first = 0
next :: Reg -> Reg
next r = r+1
exec :: Code -> Conf -> Conf
exec (LOAD n c) (a,m) = exec c (n,m)
exec (STORE r c) (a,m) = exec c (a, set r a m)
exec (ADD r c) (a,m) = exec c (get r m + a, m)
exec HALT (a,m) = (a,m)
fst $ exec (compile nine) (0,empty)
http://www.cs.nott.ac.uk/~pszgmh/123.pdf 中抽象机实在太不直观，也无法感知这样的写法到底优雅在哪里。概念不是很直白。但是感觉很有技巧。
文章本来是 eval' ，但被我改成 comp_eval。
整个执行过程，给人的感觉是一边 compile 一边 execute。
data Expr = Val Int | Add Expr Expr
data Cont = HALT | EVAL Expr Cont | ADD Int Cont
eval :: Expr -> Int
eval e = comp_eval e HALT
comp_eval :: Expr -> Cont -> Int
comp_eval (Val n) c = exec c n
comp_eval (Add x y) c = comp_eval x (EVAL y c)
-- 先 compile x , 再把 y 放到后面执行
-- EVAL 隐含 add 的信息
exec :: Cont -> Int -> Int
exec HALT n = n
exec (ADD n c) m = exec c (n+m)
exec (EVAL y c) n = comp_eval y (ADD n c)
其中执行过程，并不比普通的解释器过程来的简单。
之所以说没看懂，是因为其推导过程非常复杂，而且不直观。
总感觉左右两边的 Add 和 Eval 互相隐含，但直白的想出来挺难的。
文中原话
eval′ and exec are mutually recursive, which corresponds to the machine having two modes of operation, depending on whether it is currently being driven by the structure of the expression or the control stack
两种 model 毕竟不是一种。 这个上面的 栈虚拟机和寄存器虚拟机概念反而更一致一些。都是执行翻译完的指令。
关于 mutually recursive , 这个链接
http://okmij.org/ftp/Computation/fixed-point-combinators.html#Poly-variadic
里面的用了 Y-combinator
fix_poly:: [[a]->a] -> [a]
fix_poly fl = fix (\self -> map ($ self) fl)
where fix f = f (fix f)
test1 = (map iseven [0..5], map isodd [0..5])
where
[iseven, isodd] = fix_poly [fe,fo]
fe [e,o] n = n == 0 || o (n-1)
fo [e,o] n = n /= 0 && e (n-1)
通俗的解释如下。
even :: Int -> Bool
even 0 = True
even n = odd (n - 1)
odd :: Int -> Bool
odd 0 = False
odd n = even (n - 1)
even 和 odd 函数类型是一样的。 但抽象机的 comp_eval 和 exec 的类型不一样。
受到此 even 和 odd 的函数类型是一样的启发。
我觉得上面的抽象机也是可以变得类型一样。最终尝试得到了下面的东西。
和论文里面本质是一样的（只不过函数类型变的一样了）
comp_eval3 :: Expr -> Cont -> Int
comp_eval3 (Val n) c = exec3 (Val n) c
comp_eval3 (Add x y) c = comp_eval3 x (EVAL y c)
exec3 :: Expr -> Cont -> Int
exec3 (Val f) HALT = f
exec3 (Val f) (ADD n c) = exec3 (Val (f+n)) c
exec3 (Val f) (EVAL y c) = comp_eval3 y (ADD f c)
eval3 :: Expr -> Int
eval3 e = comp_eval3 e HALT
为什么是 eval3 其实中间还有一个丑陋的推导版本。（最后发现第三个参数就是第一个参数的一种形变）
eval2 :: Expr -> Int
eval2 e = comp_eval2 e HALT 0
comp_eval2 :: Expr -> Cont -> Int -> Int
comp_eval2 (Val n) c m = exec2 (Val (n+m)) c n
comp_eval2 (Add x y) c m = comp_eval2 x (EVAL y c) m
-- 先 compile x , 再把 y 放到后面执行
-- EVAL 隐含 add 的信息
exec2 :: Expr -> Cont -> Int -> Int
exec2 (Val f) HALT n = n
exec2 (Val f) (ADD n c) m = exec2 (Val (f+m+n)) c (n+m)
exec2 (Val f) (EVAL y c) n = comp_eval2 y (ADD n c) (f)