問題4.17-4.21

ちょっと丁寧にやりすぎかな。さくさく進めよう。

4.17

環境図は省略だけど、変換した方に余分なフレームが作られるのはletがlambdaを使う糖衣構文だから。
違いを生じないのは、letのbodyでいかなる新しい変数も定義されないので、一つ上のフレームと同じ束縛関係をもつフレームでの処理になるから。
この余計なフレームを構成せずに、内部定義の同時有効範囲規則を実装するには、例えば、

(lambda <vars>
  (define u <e1>)
  (define v <e2>)
  <e3>)

を、letを使わない等価な式

(lambda <vars>
  (define u '*unassigned*)
  (define v '*unassigned*)
  (set! u <e1>)
  (set! v <e2>)
  <e3>)

みたいに変換すればいい。要求されてないけど実装してみる。

(define (transfer-inner-defines body)
  (define vars (map definition-variable (filter definition? body)))
  (define vals (map definition-value (filter definition? body)))
  (define (set-var-and-rest-body vars vals body)
    (if (null? vars)
        body
        (cons (make-assignment (car vars) (car vals))
              (set-var-and-rest-body (cdr vars) (cdr vals) body))))
  (define (rec body)  
    (if (not (definition? (car body)))
        (set-var-and-rest-body vars vals body)
        (cons (make-definition (definition-variable (car body))
                               ''*unassigned*)
              (rec (cdr body)))))
  (rec body))

make-definitionは構成子。

(define (make-definition var val)
  (list 'define var val))

transfer-inner-definesをmake-procedureに組み込む。

(define (make-procedure parameters body env)
  (list 'procedure parameters (transfer-inner-defines body) env))

実行。

;;; M-Eval input:
(let ((a 1))
  (define (f x)
    (define b (+ a x))
    (define a 5)
    (+ a b))
  (f 10))
unbound -- LOOKUP-VARIABLE-VALUE : a

内部定義の同時有効範囲規則を満たしています。

4.18

わざわざsolveなんて持ち出してくるんだから動かないんだろうな。
とりあえずu,v,,を置き換えてみる。

(lambda <vars>
  (let ((y '*unassigned*)
        (dy '*unassigned*))
    (let ((a (integral (delay dy) y0 dt))
          (b (stream-map f y)))
      (set! y a)
      (set! dy b))
    <e3>))

上からみていって、y,dyに'*unassigned*が入り、aに(integral (delay dy) y0 dt)が入る。dyはまだ'*unassigned*だけど、delayしてあるから大丈夫。bに(stream-map f y)を入れようとして、yが'*unassigned*だからここでエラーになりますね。
letでaを設定したあとyにaをset!して、次にまたletでbを...みたいにしたらうまくいくと思います。たぶん。最初の実装の方はちゃんと動きます。

4.19

Evaを支持したいですね。一番自然な解釈だと思います。
ところで、もしEvaを支持するならこういう場合はどうなんだろう。

(let ((a 1))
  (define (f x)
    (define b (+ a x))
    (define a 5)
    (define a 100))
  (f 10))

同じ変数に同じスコープで定義を二回書くのは、同時実行で考えるならエラーになって欲しいです。実際ぼくの使っている処理系はトップレベル以外での同一スコープ内で同一変数への2回以上の定義を行おうとするとエラーをはくようです。

> (define (f x)
    (define a 5)
    (define a 28898)
    a)
internal definition: duplicate binding name in: a
> (define a 3)
> (define a 5)
> a
5

で、Evaの解釈を実装するならどんな方法があるか。
とりあえず思いついたのは、あんまりスマートじゃないですが、まず問題4.16のように変数を全て掃き出したあと、set!の式群が来ますが、ここを全ての変数が'*unassigned*でなくなるまで繰り返す、という方法です。愚直。
ただし評価途中で'*unassigned*であるような変数が含まれていた場合は、その式全体の評価結果を'*unassigned*とするように設計します。
そんな風に実装しようと思って色々いじってみたのですが、結構難しくてコードがぐちゃぐちゃになっていってなかなかできないので諦めます。(そもそもこれが要件を満たすかどうか分からないけど)
他の方法をググってみました。delayを使って作れるみたいです。
Scheme:内部defineの評価順序

4.20

a.

p231と同じ構成にします。その前に、以前letの構成子を

(define (make-let clauses . body) (cons 'let (cons clauses body)))
(define (make-named-let name clauses . body) (cons 'let (cons name (cons clauses body))))

このように可変長引数をとるように作りましたが、これ逆に非常に使い辛いので、

(define (make-let clauses body) (cons 'let (cons clauses body)))
(define (make-named-let name clauses body) (cons 'let (cons name (cons clauses body))))

これに訂正しておきます。前置き終わり。
letrecを作ります。

(define (letrec? exp) (tagged-list? exp 'letrec))
(define (letrec-clauses exp) (cadr exp))
(define (letrec-body exp) (cddr exp))
(define (letrec->let exp)
  (define (add-assignment-to-body vars vals)
    (if (null? vars)
        (letrec-body exp)
        (cons (make-assignment (car vars) (car vals))
              (add-assignment-to-body (cdr vars) (cdr vals)))))
  (let ((vars (map car (letrec-clauses exp)))
        (vals (map cadr (letrec-clauses exp))))
    (make-let (map (lambda (x) (list (car x) ''*unassigned*))
                   (letrec-clauses exp))
              (add-assignment-to-body vars vals))))

> (letrec->let
   '(letrec ((u 3)
             (v 5)
             (w 889))
      (+ u v w)))
(let ((u '*unassigned*) (v '*unassigned*) (w '*unassigned*)) (set! u 3) (set! v 5) (set! w 889) (+ u v w))

evalには

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

をcond節に追加。実行。

;;; M-Eval input:
(define (f x)
  (letrec ((even? (lambda (n)
                    (if (= n 0) true (odd? (- n 1)))))
           (odd?  (lambda (n)
                    (if (= n 0) false (even? (- n 1))))))
    (even? x)))
;;; M-Eval value:
ok

;;; M-Eval input:
(f 327)
;;; M-Eval value:
#f

;;; M-Eval input:
(f 8932)
;;; M-Eval value:
#t

おけー。

b.

うーん、letは(let ) == (let ((v_1 l_1) ... (v_n l_n)) )として、iが{1,2,...,n}に属するとしたとき、の中においてv_iは未束縛変数であるので、letrecのようにはできないと思う。つまり再帰手続きを定義することはできない。
環境ダイアグラムは省略。

4.21

a.

きもい。

> ((lambda (n)
     ((lambda (fact)
        (fact fact n))
      (lambda (ft k)
        (if (= k 1)
            1
            (* k (ft ft (- k 1)))))))
   10)
3628800

fibonacci数の計算。適当に第34項を計算してみる。(ただし0項からスタートとする)

> ((lambda (n)
     ((lambda (fibonacci)
        (fibonacci fibonacci n))
      (lambda (f k)
        (cond ((= k 0) 0)
              ((= k 1) 1)
              (else (+ (f f (- k 1)) (f f (- k 2))))))))
   34)
5702887

でたけどくそおそいので反復プロセスで書く。

> ((lambda (n)
     ((lambda (a b)
        ((lambda (fibonacci)
           (fibonacci fibonacci a b n))
         (lambda (f c d k)
           (if (= k 0)
               c
               (f f d (+ c d) (- k 1)))))) 0 1))
   34)
5702887
> ((lambda (n)
     ((lambda (a b)
        ((lambda (fibonacci)
           (fibonacci fibonacci a b n))
         (lambda (f c d k)
           (if (= k 0)
               c
               (f f d (+ c d) (- k 1)))))) 0 1))
   353)
26494272942318589069480525788592273303839335703403521573912286394960106973

あれ、なんかだんだんきもちよくなってきた。

b.

> (define (f x)
    ((lambda (even? odd?)
       (even? even? odd? x))
     (lambda (ev? od? n)
       (if (= n 0) true (od? ev? od? (- n 1))))
     (lambda (ev? od? n)
       (if (= n 0) false (ev? ev? od? (- n 1))))))
> (f 1)
#f
> (f 2)
#t
> (f 3)
#f
> (f 4)
#t
> (f 2554)
#t
> (f 21311)
#f

うん、楽しい。

今日はここまで。久しぶりにたくさんできた。