問題4.1-4.3

sicp

4章、超言語的抽象です。面倒くさそうです。
あと最近CTMCP(コンピュータプログラミングの概念・技法・モデル)を買いました。
すげー高かったです。お金なくなりました。
でもまたOn Lispが欲しくなってます。まずSICP終わらせろよ、って感じですが。

4.1

;left->right
(define (list-of-values exps env)
  (if (no-operands? exps)
      '()
      (let ((eval-result (eval (first-operand exps) env)))
        (cons eval-result
              (list-of-values (rest-operands exps) env)))))
;right->left
(define (list-of-values exps env)
  (if (no-operands? exps)
      '()
      (let ((eval-result (list-of-values (rest-operands exps) env)))
        (cons (eval (first-operand exps) env)
              eval-result))))

問題文の捉え方で話が変わってくるように思います。
実は始めに上のコードを書いた後、これもletの評価順序に依存しているように思いました。
がその後、(let ((x y)) )は((lambda (x) ) y)の糖衣構文なので、基盤Schemeが左から、もしくは右からのどちらの評価順序を持っているにせよ、作用的順序の評価の下ではより先にyが評価されるはずだと考えました。
しかし正規順序の評価の下では話が変わってきます。この場合、基盤Schemeが仮に右から左への評価順序を持っていて、さらに正規順序の評価をするならば、上のコードは問題に正しく答えてはいません。

問題4.1では基盤Lispの評価の順と無関係に左から右、右から左へ被演算子を評価するlist-of-valuesを書けと言っています。だから、この評価の順という文を単に評価の方向のみに依存しないととるか、基盤Lispが採用している全ての暗黙の評価順序に依存しないととるかで話が違ってきます。

とかいろいろ考えたんですが、そもそも正規順序の評価の下で評価の方向を任意に定めるってできるんですかね。最終的にこれ以上展開できないまで展開されたあと評価されるんだから構造的にできないんじゃないだろうか。
いや、頑張ればできるのかも。難しいです。とりあえず今回は評価順序の向きに依存しない、というレベルまでで止めときます。

4.2

a.

defineもset!も手続き作用の形をしているので、cond節の分岐で本来definition?やassignment?の場所に分岐しなきゃいけないような式をapplication?の部分で処理しちゃうようになります。
当然まずいです。
((define x 3)ってやるとどうなるんでしょうか。defineを自己評価式としてエラーになるのかな。)

b.

抽象化されているので、application?、operator、operandsを次のように変更し、evalのcond節の順序を変えるだけでいい。

(define (application? exp) (tagged-list? exp 'call))
(define (operator exp) (cadr exp))
(define (operands exp) (cddr exp))

4.3

データ主導流を思い出すところから始めました。
eval本体。apply-genericを参考に作ります。

(define (eval exp env)
  (cond ((self-evaluating? exp) exp)
        ((variable? exp) (lookup-variable-value exp env))
        (else
         (let ((tag (car exp)))
           (let ((proc (get tag 'eval)))
             (if proc
                 (proc exp env)
                 (if (application? exp)
                     (apply (eval (operator exp) env)
                            (list-of-values (operands exp) env))
                     (error "Unknown expression type -- EVAL" exp))))))))

次にパッケージ。

(define (install-eval-package)
  (define (quoted? exp) (tagged-list? exp 'quote))
  (define (text-of-quotation exp) (cadr exp))
  (define (eval-quote exp env) (text-of-quotation exp))

  (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)
                         (eval (assignment-value exp) env)
                         env))

  (define (difinition? 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) (cddr exp))))
  (define (eval-definition exp env)
    (define-variable! (definition-variable exp)
      (eval (definition-value exp) env)
      env))

  (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)
        'false))
  (define (make-if predicate consequent alternative)
    (list 'if predicate consequent alternative))
  (define (eval-if exp env)
    (if (true? (eval (if-predicate exp) env))
        (eval (if-consequent exp) env)
        (eval (if-alternative exp) env)))

  (define (lambda? exp) (tagged-list? exp 'lambda))
  (define (lambda-parameters exp) (cadr exp))
  (define (lambda-body exp) (cddr exp))
  (define (make-lambda parameters body)
    (cons 'lambda (cons parameters body)))
  (define (eval-lambda exp env)
    (make-procedure (lambda-parameters exp)
                    (lambda-body exp)
                    env))

  (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 (sequence->exp seq)
    (cond ((null? seq) seq)
          ((last-exp? seq) (first-exp seq))
          (else (make-begin seq))))
  (define (make-begin seq) (cons 'begin seq))
  
  (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-begin exp env)
    (eval-sequence (begin-actions exp) env))

  (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 (eval-cond exp env) (eval (cond->if exp) env))
  
  (put 'quote 'eval eval-quote)
  (put 'assignment 'eval eval-assignment)
  (put 'definition 'eval eval-definition)
  (put 'if 'eval eval-if)
  (put 'lambda 'eval eval-lambda)
  (put 'begin 'eval eval-begin)
  (put 'cond 'eval eval-cond))

表は省略。まだ動かせないので、これがちゃんと動くかどうかは多分に不安ですが、考え方としてはまあ合ってると思います。たぶん。

今日はここまで。