問題4.7-4.10
続きです。
4.7
let*は先行する全ての束縛が見える環境で束縛されるので、
(let* ((var1 val1) (var2 val2) ... (varn valn)) <body>)
のような場合、letを使って
(let ((var1 val1)) (let ((var2 val2)) ... (let ((varn valn)) <body>)...))
のような等価なletにできる。let*を実装していきます。
まず、letの構成子があると便利なので作ります。
(define (make-let clauses . body) (cons 'let (cons clauses body)))
let*をletによって導出された式にします。
(define (let*? exp) (tagged-list? exp 'let*)) (define (let*-clauses exp) (cadr exp)) (define (let*-body exp) (cddr exp)) (define (let*->nested-lets exp) (define (let*-expaund clauses) (if (null? clauses) (sequence->exp (let*-body exp)) (make-let (list (car clauses)) (let*-expaund (cdr clauses))))) (let*-expaund (let*-clauses exp)))
導出された式をevalに渡します。つまりevalに次の行を追加するだけで十分です。
... ((let*? exp) (eval (let*->nested-lets exp) env)) ...
実際に動かすと、
;;; M-Eval input: (let* ((x 3) (y (+ x 2)) (z (+ x y 5))) (* x z)) ;;; M-Eval value: 39
と正しく評価してくれます。
4.8
名前付きletを実装します。
どうしようかなーと考えたんですが、次のようにするのが素直で簡単だと思ってやってみたけど後で誤答だと気づきました。
まず、次のようなletがあったとすると、
(let f ((var1 val1) ... (varn valn)) <body>)
これは次と等価、なような気がします(実際は違います)。
(begin (define (f var1 ... varn) <body>) (f val1 ... valn))
もとの処理系に戻って次のような場合を考えてみます。
> (define (fib n) (+ 1 2) (let fib-iter ((a 1) (b 0) (count n)) (if (= count 0) b (fib-iter (+ a b) a (- count 1)))))
この時処理系は何も言ってきませんが、これをさっき等価だと言った式に変換してみると、
> (define (fib n) (+ 1 2) (begin (define (fib-iter a b count) (if (= count 0) b (fib-iter (+ a b) a (- count 1)))) (fib-iter 1 0 n))) define: not allowed in an expression context in: (define (fib-iter a b count) (if (= count 0) b (fib-iter (+ a b) a (- count 1))))
エラーがでます。defineは、その文のスコープで先頭でなければならないからです。
よって、名前付きletを等価な式に変換するには次のようにしなければなりません。
> (define (fib n) (+ 1 2) ((lambda () (define (fib-iter a b count) (if (= count 0) b (fib-iter (+ a b) a (- count 1)))) (fib-iter 1 0 n))))
lambdaでラップすることで新しいフレームが作られるので、エラーが出なくなります。つまり、
((lambda () (define (f var1 ... varn) <body>) (f val1 ... valn)))
に変換すると等価なものを得ることができます。ということで、これを元に実装していきます。
letをいじる前に、defineの構成子があるとすっきりしそうなので作っておきます。
(define (make-func-definition var parameters body) (cons 'define (cons (cons var parameters) body)))
次に、以前作ったletにnamed-let?とlet-nameを追加し、let-clausesとlet-bodyを名前付きletである場合とそうでない場合で分岐するようにします。
(define (named-let? exp) (symbol? (cadr exp))) (define (let-name exp) (cadr exp)) (define (let-clauses exp) (if (named-let? exp) (caddr exp) (cadr exp))) (define (let-body exp) (if (named-let? exp) (cdddr exp) (cddr exp)))
本体であるlet->combinationを、以前のものに名前付きletの場合を追加して、
(define (let->combination exp) (define (let-exp-expand clauses) (if (null? clauses) '() (cons (let-clause-exp (car clauses)) (let-exp-expand (cdr clauses))))) (if (not (named-let? exp)) (cons (make-lambda (map let-clause-var (let-clauses exp)) (let-body exp)) (let-exp-expand (let-clauses exp))) (list (make-lambda '() (list (make-func-definition (let-name exp) (map let-clause-var (let-clauses exp)) (let-body exp)) (cons (let-name exp) (let-exp-expand (let-clauses exp))))))))
とします。
;;; M-Eval input: (define (fib n) (let fib-iter ((a 1) (b 0) (count n)) (if (= count 0) b (fib-iter (+ a b) a (- count 1))))) ;;; M-Eval value: ok ;;; M-Eval input: (fib 0) ;;; M-Eval value: 0 ;;; M-Eval input: (fib 1) ;;; M-Eval value: 1 ;;; M-Eval input: (fib 2) ;;; M-Eval value: 1 ;;; M-Eval input: (fib 5) ;;; M-Eval value: 5 ;;; M-Eval input: (fib 10) ;;; M-Eval value: 55 ;;; M-Eval input: (fib 50) ;;; M-Eval value: 12586269025
ということで、ちゃんとfibonacci数列のn項を返してくれています。
4.9
do
doってなんでしょう。ググってみたらFortranにあるみたいですね。
面倒なのでdo whileはなしとして、今回のdoの構文は、
(do <variable> (<min> <max> [<step>]) <body>)
のようにしたいと思います。意味は、
どうやらSchemeにもdoがあるらしく、それはこれとは若干違うdoのようなのですが、今回はせっかくなのでFortranの方を採用します。
で、次にdoと等価な導出式を求めたいと思います。doはを繰り返す必要があるので、
なので名前付きletを使って次のように変換してみます。
(let func ((<variable> <min>) (return false)) (if (> <variable> <max>) return (func (+ <variable> <step>) (begin <body>))))
ちょっと気持ち悪いかもしれない。まあでもとりあえずやってみます。
まず名前付きlet構成子を作ります。
(define (make-named-let name clauses . body) (cons 'let (cons name (cons clauses body))))
doを抽象化します。
(define (do? exp) (tagged-list? exp 'do)) (define (do-variable exp) (cadr exp)) (define (do-values exp) (caddr exp)) (define (have-step? values) (= (length values) 3)) (define (do-min values) (car values)) (define (do-max values) (cadr values)) (define (do-step values) (caddr values)) (define (do-body exp) (cdddr exp))
doをletに変換します。
(define (do->let exp) (define (do-expand values step) (make-named-let 'func (list (list (do-variable exp) (do-min values)) (list 'return 'false)) (make-if (list '> (do-variable exp) (do-max values)) 'return (list 'func (list '+ (do-variable exp) step) (make-begin (do-body exp)))))) (let ((values (do-values exp))) (if (have-step? values) (do-expand values (do-step values)) (do-expand values 1))))
evalのcond節に次を追加します。
... ((do? exp) (eval (do->let exp) env)) ...
ちゃんと動くか確かめます。
;;; M-Eval input: (define x 0) ;;; M-Eval value: ok ;;; M-Eval input: (do i (1 10) (set! x (+ x i)) x) ;;; M-Eval value: 55
ということで、ちゃんと動きます。
while
whileは単純に次のように設計してみます。
(while <predicate> <body>)
等価な導出式は、
(let func ((return false)) (if <predicate> (func (begin <body>)) return))
doと大体同じなのでコードだけ。
(define (while? exp) (tagged-list? exp 'while)) (define (while-predicate exp) (cadr exp)) (define (while-body exp) (cddr exp)) (define (while->let exp) (make-named-let 'func (list (list 'return 'false)) (make-if (while-predicate exp) (list 'func (make-begin (while-body exp))) 'return)))
evalには、
... ((while? exp) (eval (while->let exp) env)) ...
を追加。実行すると、
;;; M-Eval input: (define x 0) ;;; M-Eval value: ok ;;; M-Eval input: (while (< x 10) (set! x (+ x 1)) x) ;;; M-Eval value: 10
for
次のような構文にします。
(for ((var1 val1) ... (varn valn)) <predicate> <update> <body>)
等価な導出式は、
(let func ((var1 val1) ... (varn valn) (return false)) (if <predicate> (let ((eval-body (begin <body>))) <update> (func val1 ... valn eval-body)) return))
ちょっと気持ち悪い。実装は次のとおり。
(define (for? exp) (tagged-list? exp 'for)) (define (for-clauses exp) (cadr exp)) (define (for-predicate exp) (caddr exp)) (define (for-update exp) (cadddr exp)) (define (for-body exp) (cddddr exp)) (define (for->let exp) (make-named-let 'func (append (for-clauses exp) (list (list 'return 'false))) (make-if (for-predicate exp) (make-let (list (list 'eval-body (make-begin (for-body exp)))) (for-update exp) (cons 'func (append (map car (for-clauses exp)) (list 'eval-body)))) 'return)))
evalのcond節に次を追加。
... ((for? exp) (eval (for->let exp) env)) ...
実行。
;;; M-Eval input: (for ((i 0)) (< i 10) (set! i (+ i 1)) (display i) (newline)) 1 2 3 4 5 6 7 8 9 ;;; M-Eval value: #<void>
やっぱり最後の評価値を返す仕様は蛇足だったかなー。
until
untilも知らない。なるほど、whileの逆のようなものですね。というか上で書いたwhileをちょっと変えるだけでできますね。ということで省略します。
結構面倒くさい問題でした。
4.10
これはやりません。とても時間がかかりそうなので。
今日はここまで。
