1. 程式人生 > >SICP元迴圈求值器

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的一個引用。