SICP問題4.3

2010/03/17 evalでlookup-variable-valueのトコが間違ってたので修正

元の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))))

データ主導流のeval

;; テーブルに含まれているかのチェック
(define (in-eval-package? exp)
  (get 'eval (operator exp)))
(define (eval exp env)
  (cond ((self-evaluating? exp) exp)
        ((variable? exp) (lookup-variable-value exp env))
        ((in-eval-package? exp) ((get 'eval (operator exp)) (operands exp) env))
        ((application? exp)
         (apply (eval (operator exp) env)
                (list-of-values (operands exp) env)))
        (else
         (error "Unknown expression type -- EVAL" exp))))
; パッケージの導入。教科書で定義された手続きを取り込む
(define (install-eval-package)
  ;; 条件式
  (define (eval-if exp env)
    (if (true? (eval (if-predicate exp) env))
        (eval (if-consequent exp) env)
        (eval (if-alternative exp) env)))
  ;; 並び
  (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)
                         env)
    'ok)
  ;; 変数の定義
  (define (eval-definition exp env)
    (define-variable! (definition-variable exp)
                      (eval (definition-value exp) env)
                      env)
    'ok)
  ;; クォート式は(quote <text-of-quotation>)の形である('aも(quote a)に見える)
  (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))

  ;; 代入は(set! <var> <value>)の形である
  (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 (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
  ;; lambda式は記号lambdaで始まるリストである
  (define (lambda? exp) (tagged-list? exp 'lambda))
  (define (lambda-parameters exp) (cadr exp))
  (define (lambda-body exp) (cddr exp))
  ;; 上のdefienition-valueが使うlambda式の構成子
  (define (make-lambda parameters body)
    (cons 'lambda (cons parameters body)))
  ;; 条件はifで始まり、述語と帰結部(場合により)代替部を持つ。
  ;; 式に代替部がなければ、代替部としてfalseを置く。
  (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? (cdddr exp)))
        (cadddr exp)
        #f))
  ;; cond式をif式に変換するcnod->ifに使うif式の構成子
  (define (make-if predicate consequent alternative)
    (list 'if predicate consequent alternative))
  ;; begin式は式の並びを単一の式に包み込む。
  ;; begin式から実際の並びが取れるように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))
  ;; (cond->ifが使う)構成子sequence->exp
  (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))
  ;; 導出された式。
  ;; 特殊形式のあるものは直接実装するのでなはなく、
  ;; 他の特殊形式を使った式の形で定義できる。
  ;; その一例がcondで、if式の入れ子として実装できる。
  ;; condの評価をこのように実装すると評価プロセスに明確に規定しなければならない
  ;; 特殊形式の数が減るので評価器が単純になる
  ;; cond式の要素を取り出す構文手続きとcond式をif式に変換する手続き
  ;; cond->ifを用意する。場合分けはcondで始まり、述語と行動の節のリストを持つ。
  ;; 述語が記号elseの時、節はelse節である。
  (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-actinos clause) (cdr clause))
  (define (cond->if exp)
    (expand-clauses (cond-clauses exp)))
  (define (expand-clauses clauses)
    (if (null? clauses)
        #f ; else節なし
        (let ((first (car clauses))
              (rest (cdr clauses)))
          (if (cond-else-clause? first)
              (if (null? rest)
                  (sequence->exp (cond-actions first))
                  (error "ELSEclause isn't last -- COND->IF" clauses))
              (make-if (cond-predicate first)
                       (sequence->exp (cond-actions first))
                       (expand-clauses rest))))))
  ;; 構文変換として実装するようにした(condのような)式を導出された式
  ;; (derived expressions)という。letもまた導出された式である

  ;; 以下振り分け用テーブルへの登録
  (put 'eval 'quote text-of-quotation)
  (put 'eval 'assignment eval-assignment)
  (put 'eval 'define eval-definition)
  (put 'eval 'if eval-if)
  (put 'eval 'lambda 
       (lambda (exp env)
         (make-procedure (lambda-parameters exp)
                         (lambda-body exp)
                         env)))
  (put 'eval 'begin
       (lambda (exp eval)
         (eval-sequence (begin-actions exp) env)))
  (put 'eval 'cond
       (lambda (exp eval)
         (eval (cond-if exp) env)))
  'done)
(install-eval-package)


;; 以下は教科書の定義から変更なし
;; 手続きの引数
(define (list-of-values exps env)
  (if (no-operands? exps)
      '()
      (cons (eval (first-operand exps) env)
            (list-of-values (rest-operands exps) env))))

;; 式の表現
;; 自己評価式は数と文字列だけである
(define (self-evaluating? exp)
  (cond ((number? exp) #t)
        ((string? exp) #t)
        (else #f)))

;; 変数は記号で表現する
(define (variable? exp) (symbol? exp))

; 手続き作用。上の式の形のいずれでもない任意の合成式。
;; 式のcarが演算子,cdrが被演算子のリスト
(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))


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

問題2.73のデータ主導微分プログラムでnumber?, variable? がデータ主導の振り分けに吸収できなかったのと同様に、self-evaluating?, variable?, application? 手続きをデータ振り分けに吸収できなかった。