幾乎抄襲了DrRacket中的SICP解釋器代碼，但得到了錯誤

Question

我正在學習翻譯很長時間，在閱讀SICP chap 4.1〜4.2之後，我試着將這些代碼複製到planet neil/sicp模式下的DrRacket中。我仔細閱讀了這些代碼，但仍然無法使代碼正確運行。

我的副本中

，我做了一些改變：

• eval功能已重命名爲ewal（因爲我想，以避免潛在的方案評估我的代碼）
• apply功能已重命名爲epply（除了apply-in-underlying-scheme函數）;
• 重新安排代碼結構以便我更好地理解
• 使用#f和#t作爲我的底層實現。
• 我也禁用了驅動程序循環，因爲我發現driver-loop從不輸出輸入值。

代碼未能正確評估複合過程，但可以處理自我評估，定義和其他特殊形式。我雙重檢查的評估過程中，發現如果我改變一個點（我在我的代碼打上(*)），使該行

((compound-procedure? procedure) (eval-sequence (procedure-body procedure) 

修改

((compound-procedure? procedure) (ewal (procedure-body procedure) 

解釋終於可以再評估化合物程序。我不知道爲什麼，但我認爲我的觀點是正確的。但SICP不會錯。我的第二個問題是如何使driver-loop正確輸出評估值。

解釋器也包含在gist中，因爲它太長了。

#lang planet neil/sicp 

;; plot: 
;; 1. env operation 
;; 2. eval function 
;; 3. test and eval for each special form and combination eval 
;; 4. REPL 
;; 5: test 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
;;; environment 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 


(define the-empty-environment '()) 


(define (first-frame env) (car env)) 
(define (enclosing-environment env)(cdr env)) 

;;;;;;;;;;;;;;;;;;;;;;;;;; 
;; env operation 
;;;;;;;;;;;;;;;;;;;;;;;;;; 

(define (extend-environment vars vals base-env) 
    (if (= (length vars) (length vals)) 
     (cons (make-frame vars vals) base-env) 
     (if (< (length vars) (length vals)) 
      (error "Too many args supplied" vars vals) 
      (error "Too few args supplied" vars vals)))) 


(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)) 


(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 -- SET!" var) 
     (let ((frame (first-frame env))) 
     (scan (frame-variables frame) 
       (frame-values frame))))) 
    (env-loop env)) 


(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)))) 


;;;;;;;;;;;;;;;;;;;;;;;;;; 
;; frame operation 
;;;;;;;;;;;;;;;;;;;;;;;;;; 
(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)))) 



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
;;; eval 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 

(define (ewal 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)     (ewal (cond->if exp) env)) 
     ((application? exp)   (epply (ewal (operator exp) env) 
              (list-of-values (operands exp) env))) 
     (else      (error "Unknown type -- EWAL" exp)))) 



;;;;;;;;;;;;;;;;;;;;;;;;;; 
;; self-eval test and eval 
;;;;;;;;;;;;;;;;;;;;;;;;;; 
(define (self-evaluating? exp) 
    (cond ((number? exp) #t) 
     ((string? exp) #t) 
     (else #f))) 

;;;;;;;;;;;;;;;;;;;;;;;;;; 
;; variable test an eval 
;;;;;;;;;;;;;;;;;;;;;;;;;; 
(define (variable? exp) (symbol? exp)) 
;; (lookup-variable-value exp env) see below 

;;;;;;;;;;;;;;;;;;;;;;;;;; 
;; quote test and eval 
;;;;;;;;;;;;;;;;;;;;;;;;;; 
(define (quoted? exp) 
    (tagged-list? exp 'quote)) 

(define (text-of-quotation exp) (cadr exp)) 

(define (tagged-list? exp tag) 
    (if (pair? exp) 
     (eq? (car exp) tag) 
     #f)) 

;;;;;;;;;;;;;;;;;;;;;;;;;; 
;; assignment test and eval 
;;;;;;;;;;;;;;;;;;;;;;;;;; 
(define (assignment? exp) 
    (tagged-list? exp 'set!)) 

(define (assignment-variable exp) (cadr exp)) 
(define (assignment-value exp) (caddr exp)) 

(define (eval-assignment exp env) 
    (set-variable-value! (assignment-variable exp) 
         (ewal (assignment-value exp) env) 
         env) 
    'ok) 

;;;;;;;;;;;;;;;;;;;;;;;;;; 
;; definition test and eval 
;;;;;;;;;;;;;;;;;;;;;;;;;; 
(define (definition? exp) 
    (tagged-list? exp 'define)) 

(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) ;;formal parameters 
        (cddr exp)))) ;;body 

(define (make-lambda parameters body) 
    (cons 'lambda (cons parameters body))) 

(define (eval-definition exp env) 
    (define-variable! (definition-variable exp) 
        (ewal (definition-value exp) env) 
        env) 
    'ok) 

;;;;;;;;;;;;;;;;;;;;;;;;;; 
;; lambda test and eval 
;;;;;;;;;;;;;;;;;;;;;;;;;; 
(define (lambda? exp) (tagged-list? exp 'lambda)) 

(define (lambda-parameters exp) (cadr exp)) 

(define (lambda-body exp) (caddr exp)) 

(define (make-procedure parameters body env) 
    (list 'procedure parameters body env)) 

;;;;;;;;;;;;;;;;;;;;;;;;;; 
;; if test and eval 
;;;;;;;;;;;;;;;;;;;;;;;;;; 

(define (if? exp) (tagged-list? exp 'if)) 

(define (if-predicate exp) (cadr exp)) 
(define (if-consequent exp) (caddr exp)) 
(define (if-alternative exp) 
    (if (not (null? (cadddr exp))) 
     (cadddr exp) 
     'false)) 

(define (eval-if exp env) 
    (if (true? (ewal (if-predicate exp) env)) 
     (ewal (if-consequent exp) env) 
     (ewal (if-alternative exp) env))) 

;;;;;;;;;;;;;;;;;;;;;;;;;; 
;; begin test and eval 
;;;;;;;;;;;;;;;;;;;;;;;;;; 

(define (begin? exp) (tagged-list? exp 'begin)) 
(define (begin-actions exp) (cdr exp)) 
(define (last-exp? seq) (null? (cdr seq))) 
(define (first-exp seq) (car seq)) 
(define (rest-exps seq) (cdr seq)) 


(define (eval-sequence exps env) 
    (cond ((last-exp? exps) (ewal (first-exp exps) env)) 
     (else (ewal (first-exp exps) env) 
       (eval-sequence (rest-exps exps) env)))) 

;;;;;;;;;;;;;;;;;;;;;;;;;; 
;; application test and eval 
;;;;;;;;;;;;;;;;;;;;;;;;;; 


(define (application? exp) (pair? exp)) 


(define (operator exp) (car exp)) 
(define (operands exp) (cdr exp)) 


(define (no-operands? ops) (null? ops)) 
(define (first-operand ops) (car ops)) 
(define (rest-operands ops) (cdr ops)) 


(define (list-of-values exps env) 
    (if (no-operands? exps) 
     '() 
     (cons (ewal (first-operand exps) env) 
      (list-of-values (rest-operands exps) env)))) 

(define (epply procedure arguments) 
    (cond ((primitive-procedure? procedure) (apply-primitive-procedure procedure arguments)) 
     ((compound-procedure? procedure) (ewal (procedure-body procedure)  ;; (*) 
                 (extend-environment (procedure-parameters procedure) 
                      arguments 
                      (procedure-environment procedure)))) 
     (else        (error "Unkown procedure type -- EPPLY" procedure)))) 


(define (primitive-procedure? proc) 
    (tagged-list? proc 'primitive)) 

(define (primitive-implementation proc) (cadr proc)) 


(define (compound-procedure? p) (tagged-list? p 'procedure)) 


(define (procedure-parameters p) (cadr p)) 
(define (procedure-body p) (caddr p)) 
(define (procedure-environment p) (cadddr p)) 

(define (apply-primitive-procedure proc args) 
    (apply-in-underlying-scheme (primitive-implementation proc) args)) 

(define apply-in-underlying-scheme apply) 

;;;;;;;;;;;;;;;;;;;;;;;;;; 
;; cond test and eval 
;;;;;;;;;;;;;;;;;;;;;;;;;; 

(define (cond? exp) (tagged-list? exp 'cond)) 

(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->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)))))) 

(define (make-if predicate consequent alternative) 
    (list 'if predicate consequent alternative)) 

(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)) 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
;; env setup 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
(define (setup-environment) 
    (let ((initial-env 
     (extend-environment (primitive-procedure-names) 
          (primitive-procedure-objects) 
          the-empty-environment))) 
    (define-variable! '#t #t initial-env) 
    (define-variable! '#f #f initial-env) 
    initial-env)) 

(define primitive-procedures 
    (list(list 'car car) 
     (list 'cdr cdr) 
     (list 'null? null?) 
     (list 'cons cons) 
     (list '+ +) 
     (list '- -) 
     (list '* *) 
     (list '/ /) 
     (list '= =))) 

(define (true? x) 
    (not (eq? x false))) 

(define (false? x) 
    (eq? x false)) 

(define (primitive-procedure-names) 
    (map car primitive-procedures)) 

(define (primitive-procedure-objects) 
    (map (lambda (proc) (list 'primitive (cadr proc))) 
     primitive-procedures)) 


(define the-global-environment (setup-environment)) 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
;; REPL 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 

(define input-prompt "M-Eval input:") 
(define output-prompt "M-Eval value:") 

(define (driver-loop) 
    (prompt-for-input input-prompt) 
    (let ((input (read))) 
    (let ((output (ewal input the-global-environment))) 
     (announce-output output-prompt) 
     (user-print output))) 
    (driver-loop)) 

(define (prompt-for-input string) 
    (newline) 
    (newline) 
    (display string) 
    (newline)) 

(define (announce-output string) 
    (newline) 
    (display string) 
    (newline)) 

(define (user-print object) 
    (if (compound-procedure? object) 
    (display (list 'compound-procedure 
        (procedure-parameters object) 
        (procedure-body object) 
        '<procedure-env>)))) 



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
;;; test 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 


(define env0 the-global-environment) 

(ewal '(define (p1 x) (+ x 1)) env0) 
(ewal '(p1 4) env0) 
(ewal '(define (append x y) 
     (if (null? x) 
      y 
      (cons (car x) 
        (append (cdr x) y)))) env0) 
(ewal '(define (factorial n) 
     (if (= 1 n) 
      1 
      (* n (factorial (- n 1))))) env0) 

(ewal '(factorial 5) env0) 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
;; init main loop 
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 

;;(driver-loop) 
;; this is commented since I found it run incorrectly 

更新：

@Will內斯說：

有關eval-sequence，你procedure-body函數不正確。它 應該是cddr，而不是caddr，以匹配eval序列的期望。

我想我的procedure-body def是正確的。考慮我解釋這EXP：

((lambda (n) 
      (if (= 1 n) 
       1 
       0)) 
     5) 

這是一個應用程序，操作員可以通過EVAL評估

(ewal (operator '((lambda (n) 
      (if (= 1 n) 
       1 
       0)) 
     5)) env0) 

所以運營商的值是一個列表（關閉）是這樣的：

(procedure (n) (if (= 1 n) 1 0) #new-env) 

如果我的程序體是關閉的caddr，那麼主體將是(if (= 1 n) 1 0)。

，但如果我改變procedure-body爲(cddr p)，procedure-body會變得像：((if (= 1 n) 1 0) #new-env)

這意味着#new-env將是我的程序身體的一部分。無論如何，這不是不正確的，因爲程序主體不應該包含閉包的環境。

但的確，這個解釋器無法處理一個函數，它的主體由一系列表達式組成。在這種情況下，我不知道如何從閉包中提取正文（exp列表）。

Answer 1

關於eval-sequence，您的procedure-body功能不正確。它應該是cddr，而不是caddr，以匹配eval-sequence的預期。

關於driver-loop，它使用user-print來顯示輸出，但user-print是不完整的。它只顯示覆合過程的值，而不是其他值。

Answer 2

在我的解釋器中，案例lambda無法評估其主體由表達式列表組成的函數，因此lambda-body定義爲(caddr exp)。我應該修改：

(define (lambda-body exp) (cddr exp)) 

，並在我的epply功能，病情compound-procedure應該EVAL-序列過程主體的，因爲現在的程序身體是表達式的列表，而不是表達。