SICP元迴圈求值器
關於環境的表示和操作
將環境表示為一個框架的表,一個環境的外圍環境就是這個表的cdr,空環境則直接用空表表示
(define (enclosing-environment env) (cdr env))
(define (first-frame env) (car env))
(define the-empty-environment '())
;每個框架都是一對錶形成的序對:一個是這一框架中的所有變數的表,還是就是它們的約束值的表
(define (make-frame variables values)
(cons variables values))
(define (frame-variables frame) (car frame))
(define (frame-values frame) (cdr frame))
(define (add-binding-to-frame! var val frame)
(set-car! frame (cons var (car frame)))
(set-cdr! frame (cons val (cdr frame))))
建立初始環境,在其中建立起基本過程的名字與一個唯一物件的關聯。
(define (setup-environment)
(let ((initial-env
(extend-environment (primitive-procedure-names)
(primitive-procedure-objects)
the-empty-environment)))
(define-variable! 'true true initial-env)
(define-variable! 'false false initial-env)
initial-env))
(define the-global-environment (setup-environment ))
;定義基本過程的名字和相應的實現過程
(define primitive-procedures
(list (list 'car car)
(list 'cdr cdr)
(list 'cons cons)
(list 'null? null?)
;;其他基本過程
))
(define (primitive-procedure-names)
(map car primitive-procedures))
(define (primitive-procedure-objects)
(map (lambda (proc) (list 'primitive (cadr proc)))
primitive-procedures))
eval對錶達式進行分類,依此引導自己的求值工作。eval的構造就像是一個針對被求值表示式的語法型別的分情況分析。針對每類表示式有一個謂詞完成相應的檢測,有一套抽象方法去選擇表示式裡的各個部分。
(define (eval exp env) ;引數是一個表示式和一個環境
(cond ((self-evaluating? exp) exp)
((variable? exp) (lookup-variable-value exp env))
((quoted? exp) (text-of-quotation exp))
((assignment? exp) (eval-assignment exp env))
((definition? exp) (eval-definition exp env))
((if? exp) (eval-if exp env)
((lambda? exp)
(make-procedure (lambda-parameters exp)
(lambda-body exp)
env))
((begin? exp)
(eval-sequence (begin-actions exp) env))
((cond? exp) (eval (cond->if exp) env))
((application? exp)
(apply (eval (operator exp) env)
(list-of-values (operands exp) env)))
(else
(error "Unknown expression type -- EVAL" exp))))
謂詞檢測,把除了false物件之外的所有東西就接受為真
(define (true? x)
(not (eq? x false)))
(define (false? x)
(eq? x false))
過程tagged-list?確定一個表的開始是不是某個給定符號
(define (tagged-list? exp tag)
(if (pair? exp)
(eq? (car exp) tag)
false))
對於自求值表示式,例如各種數,eval直接返回這個表示式本身。
(define (self-evaluating? exp)
(cond ((number? exp) true)
((string? exp) true)
(else false)))
對於變數,eval必須在環境中查詢變數,找出它們的值。
(define (variable? exp)
(symbol? exp))
;返回exp在環境env裡的約束值
(define (lookup-variable-value var env)
(define (env-loop env)
(define (scan vars vals)
(cond ((null? vars)
(env-loop (enclosing-environment env)))
((eq? var (car vars))
(car vals))
(else (scan (cdr vars) (cdr vals)))))
(if (eq? env the-empty-environment)
(error "Unbound variable" var)
(let ((frame (first-frame env)
(scan (frame-variables frame)
(frame-values frame)))))
(env-loop env))
對於加引號的表示式,eval返回被引的表示式。
;;求值器看到的引號表示式是以quote開頭的表,即使這種表示式在輸入時用的是一個引號
(define (quoted? exp)
(tagged-list? exp 'quote))
(define (text-of-quotation exp) (cadr exp))
對於變數的賦值(或者定義),就需要遞迴地呼叫eval去計算出需要關聯於這個物件的新值。而後修改環境,以改變(或者建立)相應變數的約束。
;賦值
(define (assignment-variable exp) (cadr exp))
(define (assignment-value exp) (caddr exp))
(define (assignment? exp)
(tagged-list? exp 'set!))
(define (eval-assignment exp env)
(set-variable-value! (assignment-variable exp)
(assignment-value exp)
env)
'ok)
;修改變數var在環境env裡的約束,使得該變數現在約束到值value
(define (set-variable-value! var val env)
(define (env-loop env)
(define (scan vars vals)
(cond ((null? vars)
(env-loop (enclosing-environment env)))
((eq? var (car vars))
(set-car! vals val))
(else (scan (cdr vars) (cdr vals)))))
(if (eq? env the-empty-environment)
(error "Unbound variable" var)
(let ((frame (first-frame env)
(scan (frame-variables frame)
(frame-values frame)))))
(env-loop env))
;定義
(define (definition-variable exp)
(if (symbol? (cadr exp)
(cadr exp) ;若為變數定義,則獲取變數名
(caadr exp) ;若為過程定義,則獲取過程名
(define (definition-value exp)
(if (symbol? (cadr exp)
(caddr exp)
(make-lambda (cdadr exp)
(cddr exp))))
(define (make-lambda parameters body)
(cons 'lambda (cons parameters body)))
(define (definition? exp)
(tagged-list? exp 'define))
(define (eval-definiton exp env)
(define-variable! (definition-variable exp)
(eval (definition-value exp) env)
env))
;在環境env的第一個框架里加入一個新約束,關聯起變數var和值value
(define (define-variable! var val env)
(let (frame (first-frame env))
(define (scan vars vals)
(cond ((null? vars)
(add-binding-to-frame! var val frame))
((eq? var (car vars))
(set-car! vals val))
(else (scan (cdr vars) (cdr vals)))))
(scan (frame-variables frame)
(frame-values frame))))
一個if表示式要求對其中各部分的特殊處理方式,在謂詞為真時求值其推論部分,否則求值其替代部分。
(define (if-predicate exp) (cadr exp))
(define (if-consequent exp) (caddr exp))
(define (if-alternative exp)
(if (not (null? (cdddr exp)))
(cadddr exp)
'false))
(define (if? exp)
(tagged-list? exp 'if))
(define (eval-if exp env)
(if (true? (eval (if-predicate exp) env))
(eval (if-consequent exp) env)
(eval (if-alternative exp) env)))
一個lambda必須轉換成一個可以應用的程序,方式就是將這個lambda表示式所描述的引數表和體與相應的求值環境包裝起來。
(define (lambda-parameters exp) (cadr exp))
(define (lambda-body exp) (cddr exp))
(define (lambda? exp)
(tagged-list? exp 'lambda))
(define (make-procedure parameters body env)
(list 'procedure parameters body env))
一個begin表示式要求求值其中的一系列表示式,按照它們出現的順序。
(define (begin-actions exp) (cdr exp))
(define (last-exp? exp) (null? (cdr seq)))
(define (first-exp seq) (car seq))
(define (rest-exps seq) (cdr seq))
(define (begin? exp)
(tagged-list? exp 'begin))
(define (eval-sequence exps env)
(cond ((last-exp? exps) (eval (first-exp exps) env))
(else (eval (first-exp exps) env)
(eval-sequence (rest-exps exps) env))))
分情況分析(cond)將被變換為一組巢狀的if表示式,而後求值。
(define (cond-clauses exp) (cdr exp))
(define (cond-else-clause? clause)
(eq? (cond-predicate clause) 'else))
(define (cond-predicate clause) (car clause))
(define (cond-actions clause) (cdr clause))
(define (cond? exp)
(tagged-list? exp 'cond))
(define (cond->if exp)
(expand-clauses (cond-clauses exp)))
(define (expand-clauses clauses)
(if (null? clauses)
'false
(let ((first (car clauses))
(rest (cdr clauses)))
(if (cond-else-clause? first)
(if (null? rest)
(sequence->exp (cond-actions first))
(error "ELSE clause isn't last --COND->IF" clauses))
(make-if (cond-predicate first)
(sequence->exp (cond-actions first))
(expand-clauses rest))))))
;;將cond表示式變換為if表示式
(define (make-if predicate consequent alternative)
(list 'if predicate consequent alternative))
;;把一個序列變換為一個表示式,如果需要的話就加上begin作為開頭
(define (sequence->exp seq)
(cond ((null? seq) seq)
((last-exp? seq) (first-exp seq))
(else (make-begin seq))))
(define (make-begin seq)
(cons 'begin seq))
對於一個過程應用,eval必須遞迴地求值組合式的運算子部分和運算物件部分。而後將這樣得到的過程和引數送給apply,由它去處理實際的過程應用。
apply在求值複合過程的體時需要建立相應的環境,這個環境的構造方式就是擴充該過程所攜帶的基本環境,並加入一個框架,其中將過程的各個形式引數約束於過程呼叫的實際引數。
(define (operator exp) (car exp))
(define (operands exp) (cdr exp))
(define (no-operands? ops) (null? ops))
(define (first-operand ops) (car ops))
(define (rest-operand ops) (cdr ops))
(define (application? exp) (pair? exp))
(define (list-of-values exps env)
(if (no-operands? exps)
'()
(cons (eval (first-operand exps) env)
(list-of-values (rest-operands exps) env))))
;;兩個引數,一個是過程,一個是該過程應該去應用的實際引數的表
(define (apply procedure arguments)
(cond ((primitive-procedure? procedure)
;應用基本過程
(apply-primitive-procedure procedure arguments))
((compound-procedure? procedure)
;應用複合過程的方式是順序地求值組成該過程體的那些表示式
(eval-sequence
(procedure-body procedure)
(extend-environment
(procedure-parameters procedure)
arguments
(procedure-environment procedure))))
(else
(error
"Unknown procedure type -- APPLY" procedure))))
;檢查procedure是否為一個基本過程
(define (primitive-procedure? procedure)
(tagged-list? procedure 'primitive))
;將給定過程應用於arguments裡的引數值,並返回這一應用的結果
(define (apply-primitive-procedure procedure arguments)
(apply-in-underlying-scheme
(primitive-implementation procedure) arguments))
(define (primitive-implementation procedure)
(cadr procedure))
(define (compound-procedure? procedure)
(tagged-list? procedure 'procedure))
(define (procedure-parameters procedure)
(cadr procedure))
(define (procedure-body procedure)
(caddr procedure))
(define (procedure-environment procedure)
(cadddr procedure))
;返回一個新環境,包含一個新的框架,其中的所有位於表vars裡的符號約束到約束到表vals裡對應的元素,而其外圍環境是env
(define (extend-environment vars vals env)
(if (= (length vars) (length vals))
(cons (make-frame vars vals)
env)
(if (< (length vars) (length vals))
(error "Too many arguments supplied" vars vals)
(error "Too few arguments supplied" vars vals))))
關於apply-in-underlying-scheme過程:由於此處實現的是簡易Scheme元迴圈求值器,所以我們應用的是基本過程的apply定義,由於和求值器中的apply重名,所以將apply-in-underlying-scheme作為基本過程apply的一個引用。