这里有两个按需调用的口译员；一个在 Haskell 中，一个在 Scheme 中。两者的关键是您可以在没有参数（thunk）的过程中暂停评估。无论您的宿主语言是按需调用 (Haskell) 还是按值调用 (Scheme, ML)，lambda 形式都被视为值，因此在应用 thunk 之前不会评估 lambda 下的任何内容。
因此，当将解释函数应用于参数时，您只需将参数的未评估句法表示包装在新的 thunk 中。然后，当您遇到一个变量时，您会在环境中查找它并立即评估 thunk，从而为您提供参数的值
仅仅达到这一点会使您的解释器变得懒惰，因为在使用参数之前不会实际评估它们；这是一个按名称调用的解释器。但是，正如您所指出的，一种高效的惰性语言只会对这些参数进行一次评估；这种语言是按需调用的。为了获得这种效率，您需要更新环境以包含一个仅包含参数值而不是整个参数表达式的 thunk。
这里的第一个解释器是在 Haskell 中，与您粘贴的 ML 代码非常相似。当然，Haskell 中的挑战在于 1) 由于 Haskell 内置的惰性，不能轻易实现惰性，以及 2) 将副作用处理到代码中。 Haskell 的IORefs 用于允许更新环境。
module Interp where
import Data.IORef
data Expr = ExprBool Bool
| ExprInt Integer
| ExprVar String
| ExprZeroP Expr
| ExprSub1 Expr
| ExprMult Expr Expr
| ExprIf Expr Expr Expr
| ExprLam String Expr
| ExprApp Expr Expr
deriving (Show)
data Val = ValBool Bool
| ValInt Integer
| ValClos ((() -> IO Val) -> IO Val)
instance Show Val where
show (ValBool b) = show b
show (ValInt n) = show n
show (ValClos c) = "Closure"
data Envr = EnvrEmpty
| EnvrExt String (IORef (() -> IO Val)) Envr
applyEnv :: Envr -> String -> IO (IORef (() -> IO Val))
applyEnv EnvrEmpty y = error $ "unbound variable " ++ y
applyEnv (EnvrExt x v env) y =
if x == y
then return v
else applyEnv env y
eval :: Expr -> Envr -> IO Val
eval exp env = case exp of
(ExprBool b) -> return $ ValBool b
(ExprInt n) -> return $ ValInt n
(ExprVar y) -> do
thRef <- applyEnv env y
th <- readIORef thRef
v <- th ()
writeIORef thRef (\() -> return v)
return v
(ExprZeroP e) -> do
(ValInt n) <- eval e env
return $ ValBool (n == 0)
(ExprSub1 e) -> do
(ValInt n) <- eval e env
return $ ValInt (n - 1)
(ExprMult e1 e2) -> do
(ValInt n1) <- eval e1 env
(ValInt n2) <- eval e2 env
return $ ValInt (n1 * n2)
(ExprIf te ce ae) -> do
(ValBool t) <- eval te env
if t then eval ce env else eval ae env
(ExprLam x body) ->
return $ ValClos (\a -> do
a' <- newIORef a
eval body (EnvrExt x a' env))
(ExprApp rator rand) -> do
(ValClos c) <- eval rator env
c (\() -> eval rand env)
-- "poor man's Y" factorial definition
fact = ExprApp f f
where f = (ExprLam "f" (ExprLam "n" (ExprIf (ExprZeroP (ExprVar "n"))
(ExprInt 1)
(ExprMult (ExprVar "n")
(ExprApp (ExprApp (ExprVar "f")
(ExprVar "f"))
(ExprSub1 (ExprVar "n")))))))
-- test factorial 5 = 120
testFact5 = eval (ExprApp fact (ExprInt 5)) EnvrEmpty
-- Omega, the delightful infinite loop
omega = ExprApp (ExprLam "x" (ExprApp (ExprVar "x") (ExprVar "x")))
(ExprLam "x" (ExprApp (ExprVar "x") (ExprVar "x")))
-- show that ((\y -> 5) omega) does not diverge, because the
-- interpreter is lazy
testOmega = eval (ExprApp (ExprLam "y" (ExprInt 5)) omega) EnvrEmpty
第二个解释器在 Scheme 中，唯一真正的样板是 Oleg 的模式匹配宏。我发现在 Scheme 版本中更容易看出懒惰的来源。 box 函数允许更新环境； Chez Scheme 包含它们，但我包含了应该适用于其他人的定义。
(define box
(lambda (x)
(cons x '())))
(define unbox
(lambda (b)
(car b)))
(define set-box!
(lambda (b v)
(set-car! b v)))
;; Oleg Kiselyov's linear pattern matcher
(define-syntax pmatch
(syntax-rules (else guard)
((_ (rator rand ...) cs ...)
(let ((v (rator rand ...)))
(pmatch v cs ...)))
((_ v) (errorf 'pmatch "failed: ~s" v))
((_ v (else e0 e ...)) (begin e0 e ...))
((_ v (pat (guard g ...) e0 e ...) cs ...)
(let ((fk (lambda () (pmatch v cs ...))))
(ppat v pat (if (and g ...) (begin e0 e ...) (fk)) (fk))))
((_ v (pat e0 e ...) cs ...)
(let ((fk (lambda () (pmatch v cs ...))))
(ppat v pat (begin e0 e ...) (fk))))))
(define-syntax ppat
(syntax-rules (uscore quote unquote)
((_ v uscore kt kf)
; _ can't be listed in literals list in R6RS Scheme
(and (identifier? #'uscore) (free-identifier=? #'uscore #'_))
kt)
((_ v () kt kf) (if (null? v) kt kf))
((_ v (quote lit) kt kf) (if (equal? v (quote lit)) kt kf))
((_ v (unquote var) kt kf) (let ((var v)) kt))
((_ v (x . y) kt kf)
(if (pair? v)
(let ((vx (car v)) (vy (cdr v)))
(ppat vx x (ppat vy y kt kf) kf))
kf))
((_ v lit kt kf) (if (equal? v (quote lit)) kt kf))))
(define empty-env
(lambda ()
`(empty-env)))
(define extend-env
(lambda (x v env)
`(extend-env ,x ,v ,env)))
(define apply-env
(lambda (env y)
(pmatch env
[(extend-env ,x ,v ,env)
(if (eq? x y)
v
(apply-env env y))])))
(define value-of
(lambda (exp env)
(pmatch exp
[,b (guard (boolean? b)) b]
[,n (guard (integer? n)) n]
[,y (guard (symbol? y))
(let* ([box (apply-env env y)]
[th (unbox box)]
[v (th)])
(begin (set-box! box (lambda () v)) v))]
[(zero? ,e) (zero? (value-of e env))]
[(sub1 ,e) (sub1 (value-of e env))]
[(* ,e1 ,e2) (* (value-of e1 env) (value-of e2 env))]
[(if ,t ,c ,a) (if (value-of t env)
(value-of c env)
(value-of a env))]
[(lambda (,x) ,body)
(lambda (a) (value-of body (extend-env x a env)))]
[(,rator ,rand) ((value-of rator env)
(box (lambda () (value-of rand env))))])))
;; "poor man's Y" factorial definition
(define fact
(let ([f '(lambda (f)
(lambda (n)
(if (zero? n)
1
(* n ((f f) (sub1 n))))))])
`(,f ,f)))
;; test factorial 5 = 120
(define testFact5
(lambda ()
(value-of `(,fact 5) (empty-env))))
;; Omega, the delightful infinite loop
(define omega
'((lambda (x) (x x)) (lambda (x) (x x))))
;; show that ((lambda (y) 5) omega) does not diverge, because the interpreter
;; is lazy
(define testOmega
(lambda ()
(value-of `((lambda (y) 5) ,omega) (empty-env))))