問題4.4-4.6

続きです。

4.4

orとandを導入します。eval本体には次のように入れます。

...
((and? exp) (eval-and (and-body exp) env))
((or? exp) (eval-or (or-body exp) env))
...

andとorの抽象化は次のようにします。

(define (and? exp) (tagged-list? exp 'and))
(define (and-body exp) (cdr exp))
(define (first-exp seq) (car seq))
(define (rest-exps seq) (cdr seq))
(define (last-exp? seq) (null? (cdr seq)))
(define (eval-and seq env)
  (let ((exp-val (eval (first-exp seq) env)))
    (cond ((eq? false exp-val) false)
          ((last-exp? seq) exp-val)
          (else (eval-and (rest-exps seq) env)))))

(define (or? exp) (tagged-list? exp 'or))
(define (first-exp seq) (car seq))
(define (rest-exps seq) (cdr seq))
(define (last-exp? seq) (null? (cdr seq)))
(define (or-body exp) (cdr exp))
(define (eval-or seq env)
  (let ((exp-val (eval (first-exp seq) env)))
    (cond ((eq? true exp-val) true)
          ((last-exp? seq) exp-val)
          (else (eval-or (rest-exps seq) env)))))

例のごとく動かせないので、ほんとに合ってるかどうかは分かりません。

次に導出された式として、andとorを実装します。まずand。

(define (and? exp) (tagged-list? exp 'and))
(define (and-body exp) (cdr exp))
(define (first-exp seq) (car seq))
(define (rest-exps seq) (cdr seq))
(define (last-exp? seq) (null? (cdr seq)))
(define (and->if exp)
  (and-expand-clauses (and-body exp)))
(define (and-expand-clauses clauses)
  (if (null? clauses)
      'true
      (let ((first (first-exp clauses))
            (rest (rest-exps clauses)))
        (if (last-exp? clauses)
            first
            (make-if (list 'eq? 'false first)
                     'false
                     (and-expand-clauses rest))))))
(define (eval-and exp env) (eval (and->if exp) env))

次にor。orはandの名前をandとor、falseとtrueを反転させるだけでいい。

(define (or? exp) (tagged-list? exp 'or))
(define (or-body exp) (cdr exp))
(define (first-exp seq) (car seq))
(define (rest-exps seq) (cdr seq))
(define (last-exp? seq) (null? (cdr seq)))
(define (or->if exp)
  (or-expand-clauses (or-body exp)))
(define (or-expand-clauses clauses)
  (if (null? clauses)
      'false
      (let ((first (first-exp clauses))
            (rest (rest-exps clauses)))
        (if (last-exp? clauses)
            first
            (make-if (list 'eq? 'true first)
                     'true
                     (or-expand-clauses rest))))))
(define (eval-or exp env) (eval (or->if exp) env))

4.5

動かせないとつまらないので、動けるところまで実装しました。やっぱり動かすと楽しい。
condのもう一つの構文を実装するらしいです。こんな構文あるの知らなかった。

まず、こういうのを追加して、

(define (cond-normal-clause? clause) (= 2 (length clause)))
(define (cond-=>-character? clause) (eq? (cadr clause) '=>))

cond-actionsを次のように変更して、

(define (cond-actions clause)
  (if (cond-normal-clause? clause)
      (cdr clause)
      (cddr clause)))

expand-clausesを変更する。

(define (expand-clauses clauses)
  (if (null? clauses)
      'false
      (let ((first (car clauses))
            (rest (cdr clauses)))
        (if (cond-normal-clause? first)
            (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)))
            (if (cond-=>-character? first)
                (if (cond-else-clause? first)
                    (if (null? rest)
                        (list (sequence->exp (cond-actions first)) true)
                        (error "ELSE clause isn't last -- COND->IF" clauses))
                    (let ((predicate (cond-predicate first)))
                      (make-if predicate
                               (list (sequence->exp (cond-actions first)) predicate)
                               (expand-clauses rest))))
                (error "syntax error -- COND"))))))

すると、次のようにちゃんと評価してくれる。

;;; M-Eval input:
(define x 3)
;;; M-Eval value:
ok

;;; M-Eval input:
(cond ((= x 4) 4)
      (x => (lambda (y) (* y y y)))
      (else 88))
;;; M-Eval value:
27

これはどういう時に便利なのか、よく分からないです。そのうち使いたくなるような場面に遭遇するのかな。

4.6

letを実装します。(let ((var val) ...) )は((lambda (var ...) ) val ...)の糖衣構文であるので、導出された式として表現することができます。

(define (let? exp) (tagged-list? exp 'let))
(define (let-clauses exp) (cadr exp))
(define (let-body exp) (cddr exp))
(define (let-clause-var clause) (car clause))
(define (let-clause-exp clause) (cadr clause))
(define (let->combination exp)
  (define (let-exp-expand clauses)
    (if (null? clauses)
        '()
        (cons (let-clause-exp (car clauses))
              (let-exp-expand (cdr clauses)))))
  (cons (make-lambda (map let-clause-var (let-clauses exp))
                     (let-body exp))
        (let-exp-expand (let-clauses exp))))

let->combinationでlambdaに変換しています。eval本体に、

...
((let? exp) (eval (let->combination exp) env))
...

というのを追加します。すると、

;;; M-Eval input:
(let ((x 3) (y 4) (z 5))
  (+ x y z))
;;; M-Eval value:
12

;;; M-Eval input:
(let ((x 80) (y 12) (z 8))
  (+ x y z))
;;; M-Eval value:
100

ちゃんと評価してくれます。楽しい。

今日はここまで。