8.1 这节的目标
解释一下以下语句 :D
box : ('a -> (boxof 'a))
unbox : ((boxof 'a) -> 'a)
set-box! : ((boxof 'a) 'a -> void)
We must return from the interpreter some
record of the mutations made when
evaluating its argument expression
为啥不用environment去记录box值得变化
The environment already serves an important purpose: it holds deferred substitutions. In that respect, it already has a precise semantics—given by substitution—and we must be careful to not alter that.
If we were to allow the extended environment escape from one branch of addition and be used in the other, for instance, consider the impact on the equivalent of the following program:
(+ (let ([b (box 0)])
1)
b)
It should be evident that this program has an error: b in the right branch of the addition
is unbound (the scope of the b in the left branch ends with the closing of the let—if
this is not evident, desugar the above expression to use functions). But the extended
environment at the end of interpreting the let clearly has b bound in it.
简单的结论就是，这样做不是environment的初衷，会带来很多意想不到的问题。environment是为了实现延迟替换而出现的。更像是记录了某一时刻一个名为xxx的东西的值是啥。但这个xxx是symbol，不是一个box。这是概念的不同。不知道说的对不对啊。。。好怂。
One of them, the environment, continues to be responsible for maintaining lexical scope. But the environment can not directly map identifiers to their value,because the value might change. Instead, something else needs to be responsible for maintaining the dynamic state of mutated boxes. This latter data structure is called the store.
我的理解：store就是堆
Here’s an important distinction. When we evaluate a term, we usually use the same
environment for all its sub-terms in accordance with the scoping rules of the language.
The environment thus flows in a recursive-descent pattern. In contrast, the store is
threaded: rather than using the same store in all branches, we take the store from one
branch and pass it on to the next, and take the result and send it back out. This pattern
is called store-passing style.
字字珠玑，懒得复制粘贴了。
截至8.1的解释器
#lang plai-typed
(define-type-alias Location number)
(define-type Binding
[bind (name : symbol) (val : Location)])
(define-type-alias Env (listof Binding))
(define mt-env empty)
(define extend-env cons)
(define-type Storage
[cell (location : Location) (val : Value)])
(define-type-alias Store (listof Storage))
(define mt-store empty)
(define override-store cons)
(define-type Value
[numV (n : number)]
[closV (arg : symbol) (body : ExprC) (env : Env)]
[boxV (l : Location)])
(define-type ExprC
[numC (n : number)]
[idC (s : symbol)]
[appC (fun : ExprC) (arg : ExprC)]
[plusC (l : ExprC) (r : ExprC)]
[multC (l : ExprC) (r : ExprC)]
[lamC (arg : symbol) (body : ExprC)]
[boxC (arg : ExprC)]
[unboxC (arg : ExprC)]
[setboxC (b : ExprC) (v : ExprC)]
[seqC (b1 : ExprC) (b2 : ExprC)])
(define new-loc
(let ([n (box 0)])
(lambda ()
(begin
(set-box! n (add1 (unbox n)))
(unbox n)))))
(define (lookup [for : symbol] [env : Env]) : Location
(cond
[(empty? env) (error 'lookup "Symbol not found in env")]
[(cons? env) (cond
[(equal? for (bind-name (first env))) (bind-val (first env))]
[else (lookup for (rest env))])]))
(define (fetch [loc : Location] [sto : Store]) : Value
(cond
[(empty? sto) (error 'fetch "Location not found in Store")]
[(cons? sto) (cond
[(equal? loc (cell-location (first sto))) (cell-val (first sto))]
[else (fetch loc (rest sto))])]))
(define-type Result
[v*s (v : Value) (s : Store)])
(define (interp [expr : ExprC] [env : Env] [sto : Store]) : Result
(type-case ExprC expr
[numC (n) (v*s (numV n) sto)]
[idC (n) (v*s (fetch (lookup n env) sto) sto)]
[appC (f a)
(type-case Result (interp f env sto)
[v*s (v-f s-f)
(type-case Result (interp a env s-f)
[v*s (v-a s-a)
(let ([where (new-loc)])
(interp (closV-body v-f)
(extend-env (bind (closV-arg v-f)
where)
(closV-env v-f))
(override-store (cell where v-a) s-a)))])])]
[plusC (l r) (type-case Result (interp l env sto)
[v*s (v-l s-l)
(type-case Result (interp r env s-l)
[v*s (v-r s-r)
(v*s (num+ v-l v-r) s-r)])])]
[multC (l r) (type-case Result (interp r env sto)
[v*s (v-l s-l)
(type-case Result (interp r env s-l)
[v*s (v-r s-r)
(v*s (num* v-l v-r) s-r)])])]
[lamC (a b) (v*s (closV a b env) sto)]
[boxC (a) (type-case Result (interp a env sto)
[v*s (v-a s-a)
(let ([where (new-loc)])
(v*s (boxV where)
(override-store (cell where v-a)
s-a)))])]
[unboxC (a) (type-case Result (interp a env sto)
[v*s (v-a s-a)
(v*s (fetch (boxV-l v-a) s-a) s-a)])]
[setboxC (b v) (type-case Result (interp b env sto)
[v*s (v-b s-b)
(type-case Result (interp v env s-b)
[v*s (v-v s-v)
(v*s v-v
(override-store (cell (boxV-l v-b)
v-v)
s-v))])])]
[seqC (b1 b2) (type-case Result (interp b1 env sto)
[v*s (v-b1 s-b1)
(interp b2 env s-b1)])]))
(define (num+ [l : Value] [r : Value]) : Value
(cond
[(and (numV? l) (numV? r))
(numV (+ (numV-n l) (numV-n r)))]
[else
(error 'num+ "one argument was not a number")]))
(define (num* [l : Value] [r : Value]) : Value
(cond
[(and (numV? l) (numV? r))
(numV (* (numV-n l) (numV-n r)))]
[else
(error 'num+ "one argument was not a number")]))
8.2变量
First, our choice of terms. We’ve insisted on using the word “identifier” before because we wanted to reserve “variable” for what we’re about to study.
Henceforth, we will use variable when we mean an identifier whose value can change within its scope, and identifier when this cannot happen.
#lang plai-typed
(define-type-alias Location number)
(define-type Binding
[bind (name : symbol) (val : Location)])
(define-type-alias Env (listof Binding))
(define mt-env empty)
(define extend-env cons)
(define-type Storage
[cell (location : Location) (val : Value)])
(define-type-alias Store (listof Storage))
(define mt-store empty)
(define override-store cons)
(define-type Value
[numV (n : number)]
[closV (arg : symbol) (body : ExprC) (env : Env)])
(define-type ExprC
[numC (n : number)]
[varC (s : symbol)]
[appC (fun : ExprC) (arg : ExprC)]
[plusC (l : ExprC) (r : ExprC)]
[multC (l : ExprC) (r : ExprC)]
[lamC (arg : symbol) (body : ExprC)]
[setC (var : symbol) (arg : ExprC)]
[seqC (b1 : ExprC) (b2 : ExprC)])
(define new-loc
(let ([n (box 0)])
(lambda ()
(begin
(set-box! n (add1 (unbox n)))
(unbox n)))))
(define (lookup [for : symbol] [env : Env]) : Location
(cond
[(empty? env) (error 'lookup "Symbol not found in env")]
[(cons? env) (cond
[(equal? for (bind-name (first env))) (bind-val (first env))]
[else (lookup for (rest env))])]))
(define (fetch [loc : Location] [sto : Store]) : Value
(cond
[(empty? sto) (error 'fetch "Location not found in Store")]
[(cons? sto) (cond
[(equal? loc (cell-location (first sto))) (cell-val (first sto))]
[else (fetch loc (rest sto))])]))
(define-type Result
[v*s (v : Value) (s : Store)])
(define (interp [expr : ExprC] [env : Env] [sto : Store]) : Result
(type-case ExprC expr
[numC (n) (v*s (numV n) sto)]
[varC (n) (v*s (fetch (lookup n env) sto) sto)]
[appC (f a)
(type-case Result (interp f env sto)
[v*s (v-f s-f)
(type-case Result (interp a env s-f)
[v*s (v-a s-a)
(let ([where (new-loc)])
(interp (closV-body v-f)
(extend-env (bind (closV-arg v-f)
where)
(closV-env v-f))
(override-store (cell where v-a) s-a)))])])]
[plusC (l r) (type-case Result (interp l env sto)
[v*s (v-l s-l)
(type-case Result (interp r env s-l)
[v*s (v-r s-r)
(v*s (num+ v-l v-r) s-r)])])]
[multC (l r) (type-case Result (interp r env sto)
[v*s (v-l s-l)
(type-case Result (interp r env s-l)
[v*s (v-r s-r)
(v*s (num* v-l v-r) s-r)])])]
[lamC (a b) (v*s (closV a b env) sto)]
[setC (var val) (type-case Result (interp val env sto)
[v*s (v-val s-val)
(let ([where (lookup var env)])
(v*s v-val
(override-store (cell where v-val)
s-val)))])]
[seqC (b1 b2) (type-case Result (interp b1 env sto)
[v*s (v-b1 s-b1)
(interp b2 env s-b1)])]))
(define (num+ [l : Value] [r : Value]) : Value
(cond
[(and (numV? l) (numV? r))
(numV (+ (numV-n l) (numV-n r)))]
[else
(error 'num+ "one argument was not a number")]))
(define (num* [l : Value] [r : Value]) : Value
(cond
[(and (numV? l) (numV? r))
(numV (* (numV-n l) (numV-n r)))]
[else
(error 'num+ "one argument was not a number")]))
(define (driver [expr : ExprC]) : Result
(interp expr mt-env mt-store))
(driver (appC (lamC 'x (seqC (setC 'x (numC 3)) (varC 'x))) (numC 4)))