拷貝到 DrRacket 裏面， 語言選擇：由源代碼來確定語言（左下角選擇） 直接點擊運行即可。
#lang racket
(require sicp)
(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)] ; if表達式， 遞規
[(lambda? exp) (make-procedure (lambda-parameters exp) ; lambda，轉換成一個可應用的過程
(lambda-body exp)
env)]
[(begin? exp) (eval-sequence (begin-actions exp) env)] ; begin， 求值一系列表達式，按照出現的順序
[(cond? exp) (eval (cond->if exp) env)] ; cond 轉換成 if 繼續求值
[(application? exp) (my_apply (eval (operator exp) env) ; 組合式, 求值運算符部分、運算對象部分，再調用 my-apply將參數傳遞給過程
(list-of-values (operands exp) env))]
[else
(error "Unknown expression type -- EVAL" exp)])) ; 符則返回錯誤
;; 定義新的 apply
(define (my_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)]))
;; 生成實際參數列表 : 以組合式的運算對象數參數，求值各個運算對象，返回這些值的表
;; **** 這裏可以使用 map 來求值，下面這樣寫，是爲了表明，可以不用高階過程來完成這件事兒
(define (list-of-values exps env)
(if (no-operands? exps) ; 沒有運算對象？返回空表
'()
(cons (eval (first-operand exps) env) ; 求值第一個運算對象
(list-of-values (rest-operands exps) env)))) ;; 遞規則求值其它運算運對象
;; 條件 在給定環境中求值謂詞部分，如果爲真則求值推論部分，否則求值替代部分
(define (eval-if exp env)
(if (true?
(eval (if-predicate exp) env)) ;; 求值謂詞部分
(eval (if-consequent exp) env) ;; 爲真 求值推論部分
(eval (if-alternative exp) env))) ;; 求值替代部分
;; 序列, 用於 my-apply 、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)]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 賦值和定義
;; 變量賦值
(define (eval-assignment exp env)
(set-variable-value! (assignment-variable exp) ; 找到變量
(eval (assignment-value exp) env) ; 使用 eval找出需要賦的值，
env)
'ok)
;; 變量定義
(define (eval-definition exp env)
(define-variable! (definition-variable exp) ; 找到表達式中的 變量符號
(eval (definition-value exp) env) ; 求值變量的值
env) ;
'ok)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 4.1.2 表達式的表示
;; 自求值表達式式只有數字和字符串
(define (self-evaluating? exp)
(cond [(number? exp) true] ;; 數字
[(string? exp) true] ;; 字符串
[else false]))
;; 變量用符號表示
(define (variable? exp) (symbol? exp))
;; 引號表達式
(define (quoted? exp)
(tagged-list? exp 'quote)) ;; 如果第一個符號是 'quote
;; 引號表達式的 表達式部分 (text-of-quotation "(quote a)" ) => "a"
(define (text-of-quotation exp) (cadr exp))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 確定某個表的開始否是不是某個給定的符號
(define (tagged-list? exp tag)
(if (pair? exp)
(eq? (car exp) tag)
false))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 賦值 (set! <var> <value>)
(define (assignment? exp)
(tagged-list? exp 'set!))
;; 取得 變量
(define (assignment-variable exp) (cadr exp))
;; 取得 值
(define (assignment-value exp) (caddr exp))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
#|
定義的形式：
(define <var> <value>)
或者
(define (<var> <parameter1> ... <parametern>)
<body>) =>
語法糖:
(define <var>
(lambda (<parameter1> ... <parametern>)
<body>))
|#
;; 定義？
(define (definition? exp)
(tagged-list? exp 'define)) ;; 以 define 開頭
;; 取得 <var>
(define (definition-variable exp)
(if (symbol? (cadr exp)) ;; 取第二個符號
(cadr exp)
(caadr exp)))
;; 取得 <value>
(define (definition-value exp)
(if (symbol? (cadr exp)) ;; 如果列表的第二項是符號
(caddr exp) ;; 直接取第三項
;;; 否則是叻外一種形式的定義， (define (<var> <parameter1> ... <parametern>) <body>)
;;; 構造成 lambda 表達式 返回
(make-lambda (cdadr exp) ;; 參數 formal parameters : (<parameter1> ... <parametern>)
(cddr exp)))) ;; body : (<body>)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; lambda
(define (lambda? exp) (tagged-list? exp 'lambda))
(define (lambda-parameters exp) (cadr exp))
(define (lambda-body exp) (cddr exp))
(define (make-lambda paramenters body)
(cons 'lambda (cons paramenters body)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 條件 if
(define (if? exp) (tagged-list? exp 'if))
;; 取得謂詞部分
(define (if-predicate exp) (cadr exp))
;; 取得 then
(define (if-consequent exp) (caddr exp))
;; 取得 else
(define (if-alternative exp)
(if (not (null? (cdddr exp)))
(cadddr exp)
'false))
;; 構造 if 表達式
(define (make-if predicate consequent alternative)
(list 'if predicate consequent alternative))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; begin
(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))
;; 序列轉換爲 表達式，如果需要的話，就在在前面加上 begin
(define (sequence->exp seq)
(cond [(null? seq) seq] ;; 空的序列，直接返回
[(last-exp? seq) (first-exp seq)] ;; 最後一個序列，則直接取第一個
[else (make-begin seq)])) ;; 否則 構造 爲 (begin <seq>)
;; 構造 begin
(define (make-begin seq) (cons 'begin seq))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 過程： 不符合上述各種表達式類型的任意複合類型
;; car爲 運算符, cdr爲運算對象的表
;; 過程?
(define (application? exp) (pair? exp))
;; 取得運算符
(define (operator exp) (car exp)) ;; 之前這裏之成 (cdr exp) 所以操作符號
;; 取得 運算對象 表
(define (operands exp) (cdr exp))
;; 沒有運算對象？
(define (no-operands? ops) (null? ops))
;; 第一個運算對象
(define (first-operand ops) (car ops))
;; 第二...N個運算對象的表
(define (rest-operands ops) (cdr ops))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 派生表達式
;; cond 可以表示爲 if的嵌套
#|
(cond [(> x 0) x]
[(= x 0) (display 'zero) 0]
[else (- x)])
=>
(if (> x 0)
x
(if (= x 0)
(begin (display 'zero)
0)
(- x))
|#
; cond
(define (cond? exp) (tagged-list? exp 'cond))
;; 條件：動作 表
(define (cond-clauses exp) (cdr exp))
;; 取得 else 部分
(define (cond-else-clause? clause)
(eq? (cond-predicate clause) 'else))
; 取得謂詞部分
(define (cond-predicate clause) (car clause))
; 取得動作部分 表
(define (cond-actions clause) (cdr clause))
; cond->if 將 cond 歸約爲 if
(define (cond->if exp)
(expand-clauses (cond-clauses exp)))
; 展開 條件：動作 表 爲 if 的嵌套
(define (expand-clauses clauses)
(if (null? clauses)
'false ;; 空的，直接返回fasle
(let ([first (car clauses)] ;; 取得第一個
(rest (cdr clauses))) ;; 取得剩餘的
(if (cond-else-clause? first) ;; 判是否是 else條件
(if (null? rest) ;; 如果 科餘的爲空
(sequence->exp (cond-actions first)) ;; 轉化爲 表達式
(error "ELSE clause isn't last -- COND->IF"
clauses))
;; 不是 else 子句部分 轉化爲 if 表達式
(make-if (cond-predicate first)
(sequence->exp (cond-actions first))
(expand-clauses rest))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 4.1.3 求值器的數據結構
;; 謂詞檢測
(define (true? x)
(not (eq? x false)))
(define (false? x)
(eq? x false))
;;;; 爲了能處理基本過程，我們假定己經有了以下過程
;; (apply-primitive-procedure <proc> <args>) : 將給定過程應用於 <args>裏的參數，並返回應用的結果
;; (primitive-procedure? <proc>) : 檢測 <proc>是否是一個過程
;; 複合過程由 形式參數， 過程體，環境 通過構造函數做出來
(define (make-procedure parameters body env)
(list 'procedure parameters body env))
;; 是否以 procedure開頭
(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))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 對環境的操作, 一個環境就是一個框架的序列, 每個框架都是一個約束的表格
;; 其中的約束關聯起一些變量和與之對應的值
#|
1. 返回 <var>在 <env>裏面的約束值，如果沒有發出一個錯誤信號
(lookup-variable-value <var> <env>) :
2. 返回一個新環境，這個環境裏包含一個新現框架，其中的所有位於表<variables>裏的符號約束到<values>
裏對應的元素上, 其外圍環境中 <base-env>
(extend-environment <variables> <values> <base-env>)
;; 定義變量
(define-variable! <var> <value> <env>)
;; 設置變量的值
(set-variable-value! <var> <value> <env>)
|#
;; 環境表示爲 一個框架的表,一個環境的外圍環境就是這個表的cdr
(define (enclosing-environment env) (cdr env))
;; 第一個環境
(define (first-frame env) (car env))
;; 空環境用 '() 表示
(define the-empty-environment '())
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 環境裏的每個框架都是一對錶形成的序對：一個是 這一框架中所有變量的表，還有就是約束值的表
#|
(car '(a b c)
'(1 2 3)) => a=1, b=2, c=3
|#
;; 創建frame 由 表variables 和 表values cons
(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 (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 arguments supplied" vars vals)
(error "Too few arguments 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))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 基本過程
#|
基本過程對象的具體表示朝着不重要，只要 apply 能夠識別它們，並通過過程primitive-procedure?
和 apply-primitive-procedure 去應用它們。
我們選擇的方式是， 是將基本過程都表示爲以符號primitive開頭的表,在其中包含着Lisp系統裏實現現這一基本過
程的那個過程
|#
;; 是否是基礎過程？
(define (primitive-procedure? proc)
(tagged-list? proc 'primitive))
;; ????????????????????
(define (primitive-implementation proc) (cadr proc))
;; setup-environment 將從一個表裏取得基本過程的名字和相應的實現過程
(define primitive-procedures
(list (list 'car car)
(list 'cdr cdr)
(list 'cons cons)
(list 'null? null?)
;;; 其他基本過程
(list '+ +)
(list '- -)
(list '* *)
(list '/ /)
))
;; 獲取基本過程的名稱表
(define (primitive-procedure-names)
(map car
primitive-procedures))
;; 獲取基本過程的對象表
(define (primitive-procedure-objects)
(map (lambda (proc) (list 'primitive (cadr proc)))
primitive-procedures))
;; 爲了應用一個基本過程， 只需要簡單的利同基礎Lisp系統，將相應的實現過程應用於實際參數
(define (apply-primitive-procedure proc args)
;(apply-in-underlying-scheme ;; 這裏假設 (define apply-in-underlying-scheme apply)
(apply
(primitive-implementation proc) args))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 提供一個驅動循環, 模擬lisp 的repl
;; 輸入提示符
(define input-prompt ";;; M-Eval input:")
;; 輸出提示符
(define output-prompt ";;; M-Eval output:")
;; 驅動循環
(define (driver-loop)
(prompt-for-input input-prompt)
(let ([input (read)])
(let ([output (eval 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 'commpound-procedure
(procedure-parameters object)
(procedure-body object)
'<procedure-env>))
(display object)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 4.1.4 作爲程序運行這個求值器
(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))
;; 全局的環境, 環境中包含 'true 'false
(define the-global-environment (setup-environment))
(driver-loop)