なつたん

exercise 4.5
またassocとか俺様処理系で動かない手続きを使っている。もう少し教育的配慮が欲しかったりする。そのままif文で置き換えるとよさげ。(test => recipient)を(if test (recipient test))とするとtestが2回評価される。letで一回代入しないと。letの実装は次の問題だからそちらから先に解く。

exercise 4.6.

こんな変換が必要
(let-o ((a 5) (b 10))
　(cons a b))
((lambda (a b) (cons a b)) 5 10)

letは例によって俺様letのlet-oに置き換え
(let->combination '(let-o ((a 5) (b 10))　(cons a b)))
が
gosh> ((lambda (a b) (cons a b)) 5 10)
を返すことを確認。

(define the-grobal-environment (setup-environment))
(eval-o '(define consr
　　　　　 (lambda (x y)
　　　　　　 (let-o ((a x) (b y))
　　　　　　　 (cons b a)))) the-grobal-environment)
(eval-o '(consr 1 2) the-grobal-environment)
引数が逆になるconsrを、let-oを使って定義
gosh> (2 . 1)
ちゃんと、(2 . 1)返したぜ。そろそろcar, cdr, cons, null?以外にもprimitiveが欲しい。

(define (let? exp) (tagged-list? exp 'let-o))
(define (let-vlist exp) (car (cdr exp)))
(define (let-body exp) (cdr (cdr exp)))
(define (let-make-arg vlist)
　(map car vlist))
(define (let-make-parameter vlist)
　(map cadr vlist))
(define (let-make-combination lambda-expression parameters)
　(cons lambda-expression parameters))

(define (let->combination exp)
　(let ((vlist (let-vlist exp)))
　　(let-make-combination
　　 (make-lambda (let-make-arg vlist) (let-body exp))
　　 (let-make-parameter vlist))))
あんまり綺麗にかけないけど、これで動いた。

～～～～～～～～～～～～～～～～～～～～～～～～～～

続いて、exercise 4.5に戻ろう
(test => recipient)
は
(let ((result test))　(if result (recipient result))

に変換すればよい。if文が上手くネストして、letの重複問題をクリアーできてる。

(define (cond-extend? first)
　(eq? (car (cdr first)) '=>))
(define (cond-extend-test first)
　(car first))
(define (cond-extend-reci first)
　(car (cdr (cdr first))))
(define (cond-extend-make-let test)
　(cons (list 'result test) '()))
(define (cond-extend-make-reci recipient)
　(list recipient 'result))

(define (cond-make-extend first rest)
　(let ((test (cond-extend-test first))
　　　　(recipient (cond-extend-reci first)))
　　(list 'let-o
　　　　　(cond-extend-make-let test)
　　　　　(make-if 'result
　　　　　　　　　 (cond-extend-make-reci recipient)
　　　　　　　　　 (expand-clauses rest)))))
(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 caluse isn't last nyo - COND-IF" clauses))
　　　　　　(if (cond-extend? first)
　　　　　　　　(cond-make-extend first rest)
　　　　　　　　(make-if (cond-predicate first)
　　　　　　　　　　　　 (sequence->exp (cond-actions first))
　　　　　　　　　　　　 (expand-clauses rest)))))))

試行錯誤してgdgdだけど、これで動いた。

　
(cond->if '(cond ((assoc 'b '((a 1) (b 2))) => cadr)
　　　(else false)))

gosh> (let-o ((result (assoc 'b '((a 1) (b 2))))) (if result (cadr result) false))
おお、良い感じ

goshで(cond ((null? 'a) => car) ((cdr '((a b) (c d))) => car) (else　'false))を評価して、(c d)が返るのを確認した後、

(eval-o '(cond ((null? 'a) => car) ((cdr '((a b) (c d))) => car) (else　'false)) the-grobal-environment)
とやって、(c d)が返ることを確認。

ソースはここ