exercise 4.1~4.4
4章開始。
gaucheだとうまく実行出来ないので、mzschemeに変えてみた。なんだか悔しい・・・。
ちなみにgaucheだと
;;; M-Eval input: (+ 1 1) gosh: "error": invalid application: ((primitive #<subr +>) 1 1)
とエラー・・・。promitiveなprocedureを呼ぶと揉めるみたい。
むー。
まぁそんなこんなで演習スタート
ex4.1
;;right-to-left (define (list-of-values exps env) (if (no-operands? exps) '() (let ((rest (list-of-values (rest-operands exps) env))) (cons (eval (first-operand exps) env) rest)))) ;;left-to-right (define (list-of-values exps env) (if (no-operands? exps) '() (let ((first (eval (first-operand exps) env))) (cons first (list-of-values (rest-operands exps) env)))))
まぁさして問題はないはず。
ex4.2
a. 例だと define をふつうの関数と認識しちゃうのでダメだろ
b
(define (call? exp) (tagged-list? exp 'call)) (define (call-operater exp) (cadr exp)) (define (call-operands exp) (cddr exp)) (define (eval exp env) (cond ((self-evaluating? exp) exp) ((variable? exp) (lookup-variable-value exp env)) ((call? exp) (apply (eval (call-operater exp) env) (list-of-values (call-operands exp) env))) ((quoted? exp) (text-of-quotation exp)) ((assignment? exp) (eval-assignment exp env)) ((definition? exp) (eval-definition exp env)) ((if? exp) (eval-if exp env)) ((lambda? exp) (make-procedure (lambda-parameters exp) (lambda-body exp) env)) ((begin? exp) (eval-sequence (begin-actions exp) env)) ((cond? exp) (eval (cond->if exp) env)) ;; ((application? exp) ;; (apply (eval (operator exp) env) ;; (list-of-values (operands exp) env))) (else (error "Unknown expression type -- EVAL" exp))))
でおkでしょう。
ex4.3
むー。色々解法がありそう。
自分の例は、
(load "~/src/scheme/putget.scm") (define (eval exp env) (cond ((self-evaluating? exp) exp) ((variable? exp) (lookup-variable-value exp env)) ((get 'eval (car exp)) ((get 'eval (car exp)) exp env)) ((application? exp) (apply (eval (operator exp) env) (list-of-values (operands exp) env))) (else (error "Unknown expression type -- EVAL" exp)))) (put 'eval 'quote (lambda (exp env) (text-of-quotation exp))) (put 'eval 'set! (lambda (exp env) (eval-assignment exp env))) (put 'eval 'define (lambda (exp env) (eval-definition exp env))) (put 'eval 'if (lambda (exp env) (eval-if exp env))) (put 'eval 'lambda (lambda (exp env) (make-procedure (lambda-parameters exp) (lambda-body exp) env))) (put 'eval 'begin (lambda (exp env) (eval-sequence (begin-actions exp) env))) (put 'eval 'cond (lambda (exp env) (eval (cond->if exp) env)))
ってな感じ。以下の回答もこれ使ってます。
ちなみにputget.scmってのは名前のとおりch3.3.3にあるputとgetのコードをまとめたファイル。
ex4.4
先にletが欲しい・・・
あとclausesと名づけたのは変な気がする・・・
special form
(put 'eval 'and (lambda (exp env) (eval-and (and-clauses exp) env))) (define (and-clauses exp) (cdr exp)) (define (eval-and clauses env) (if (null? clauses) #t (let ((result (eval (car clauses) env))) (if result (if (null? (cdr clauses)) result (eval-and (cdr clauses) env)) 'false)))) (put 'eval 'or (lambda (exp env) (eval-or (or-clauses exp) env))) (define (or-clauses exp) (cdr exp)) (define (eval-or clauses env) (if (null? clauses) #f (let ((result (eval (car clauses) env))) (if result result (eval-or (cdr clauses) env)))))
derived expression
;;4.3のやつ (put 'eval 'or (lambda (exp env) (eval (or->combination exp) env))) (put 'eval 'and (lambda (exp env) (eval (and->combination exp) env))) ;;derived expressions (define (or->combination exp) (expand-or-clauses (cdr exp))) (define (expand-or-clauses clauses) (if (null? clauses) 'false (let ((first (car clauses)) (rest (cdr clauses))) (list (make-lambda '(x) (list (make-if 'x 'x (expand-or-clauses rest)))) first)))) (define (and->combination exp) (expand-and-clauses (cdr exp))) (define (expand-and-clauses clauses) (cond ((null? clauses) 'true) ((null? (cdr clauses)) (car clauses)) (else (make-if (car clauses) (expand-and-clauses (cdr clauses)) 'false))))
ちなみにderived expressionの方は
> (and->combination '(and 1 2 3)) (if 1 (if 2 3 false) false) > (or->combination '(or 1 2)) ((lambda (x) (if x x ((lambda (x) (if x x false)) 2))) 1)
という結果。
orのほうでlambdaつかってるのはletが無かったからw
使わないとtrueの式が二回評価されるので、副作用とか考えるとletで一回縛っておいた方がいい気がしてこうなった。
・・・長くなったのでページ分けます
