SICP 読み (154) 4.1.2 式の表現

4.1.2 節の練習問題に戻る。

練習問題

4.4 から着手。ダウトが沢山あるはず。まず、eval への盛り込み。

(define (eval exp env)
  (cond ((self-evaluating? exp) exp)
	((variable? exp) (lookup-variable-value 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))
	((and? exp) (eval-and exp env))
	((or? exp) (eval-or exp env)))
	((lambda? exp)
	 (make-procedure (lambda-parameters exp)
			 (lambda-body exp)
			 env))
	((begin? exp)
	 (eval-sequence (begin-action exp) env))
	((cond? exp)
	 (eval (cond->if exp) env))
	((let? exp) (eval (let->combination exp) env))
	((application? exp)
	 (apply (eval (operator exp) env)
		(list-of-values (operands exp) env)))
	(else
	 (error "Unknown expression type -- EVAL" exp))))

よく見りゃ not も無いんですよねぇ。別途検討してみよう。あと、以下も追加。

(define (and? exp)
  (tagged-list? exp 'and))
(define (or? exp)
  (tagged-list? exp 'of))

(define (eval-and exp env)
  (define (eval-and-iter predicates env)
    (let ((ret (eval (car predicates) env)))
      (if (false? ret)
	  false
	  (if (null? (cdr predicates))
	      ret
	      (eval-and-iter (cdr predicates) env)))))
  (if (null? (cdr exp))
      true
      (eval-and-iter (cdr exp) env)))

(define (eval-or exp env)
  (define (eval-or-iter predicates env)
    (let ((ret (eval (car predicates) env)))
      (if (true? ret)
	  ret
	  (if (null? (cdr predicates))
	      false
	      (eval-or-iter (cdr predicates) env)))))
  (if (null? (cdr exp))
      false
      (eval-or-iter (cdr exp) env)))

で試験ですね。まず and から。

  ("4.4"
   ("and"
    (let ((genv the-global-environment))
      (assert-true (eval '(and) genv))
      )
    )
   )

試験は NG。上記の eval な手続きの中で true だの false だのを使っている。適当に #t だの #f だのに書き換え。ちなみに中の処理系では true やら false が使えるはずなんだよねぇ。
and の残りは以下。

   ("and"
    (let ((genv the-global-environment))
      (assert-true (eval '(and) genv))
      (assert-false (eval '(and true false 3) genv))
      (assert-equal 3 (eval '(and 1 2 3) genv))
      (assert-equal '(1 2) (eval '(and '() '(1) '(1 2)) genv))
      )
    )

次は or です。とりあえず以下の試験を通してみたら NG。

   ("or"
    (let ((genv the-global-environment))
      (assert-false (eval '(or) genv))
      )
    )

なんて怒られているか、というと

-- (test case) 4.4: .E
Error occurred in or
*** ERROR: Unbound variable or

って or? の定義が (以下略
試験は以下。

   ("or"
    (let ((genv the-global-environment))
      (assert-false (eval '(or) genv))
      (assert-false (eval '(or false false false) genv))
      (assert-true (eval '(or false false false true) genv))
      (assert-equal '() (eval '(or '() '(1) '(1 2)) genv))
      (assert-equal '(1) (eval '(or false '(1) '(1 2)) genv))
      (assert-equal '(1 2) (eval '(or false false '(1 2)) genv))
      )
    )

導出された式として評価

一応書いてみよう。and だったら

(and (= x 1) (= y 2) (= z 3))

が

(let ((x1 (= x 1)))
  (if (not x1)
      false
      (let ((x2 (= y 2)))
	(if (not x2)
	    false
	    (let ((x3 (= z 3)))
	      (if (not x3)
		  false
		  x3))))))

になれば良い、と。これ、結構ムズイな。でとりあえず再帰で。しかも同じコトやってて微妙。

(define (and->let exp)
  (define (and->let-iter seq)
    (cond ((null? (cdr seq))
	   (list 'let (list (list 'tmp (car seq)))
		 (list 'if '(not tmp) 'false 'tmp)))
	  (else
	   (list 'let (list (list 'tmp (car seq)))
		  (list 'if '(not tmp) 'false (and->let-iter (cdr seq)))))))
  (and->let-iter (cdr exp)))

gauche に評価させたら以下。

(let ((tmp (= x 1))) 
  (if #0=(not tmp) 
      false 
      (let ((tmp (= y 2))) 
	(if #0# 
	    false 
	    (let ((tmp (= z 3))) 
	      (if (not tmp) 
		  false 
		  tmp))))))

ちなみに guile では以下。

(let ((tmp (= x 1))) 
  (if (not tmp) 
      false 
      (let ((tmp (= y 2))) 
	(if (not tmp) 
	    false 
	    (let ((tmp (= z 3))) 
	      (if (not tmp) 
		  false 
		  tmp))))))

導出はできてるんですが ...
これは手続きでナニした方が良さげだな。こんな感じ??

(define (and->let exp)
  (define (make-let exp1 exp2)
    (list 'let (list (list 'tmp exp1))
	  (list 'if '(not tmp) 'false exp2)))
  (define (and->let-iter seq)
    (cond ((null? (cdr seq)) (make-let (car seq) 'tmp))
	  (else
	   (make-let (car seq) (and->let-iter (cdr seq))))))
  (and->let-iter (cdr exp)))

(let ((tmp (= x 1))) 
  (if (not tmp) 
      false 
      (let ((tmp (= y 2))) 
	(if (not tmp) 
	    false 
	    (let ((tmp (= z 3))) 
	      (if (not tmp) 
		  false 
		  tmp))))))

ちなみに条件ゼロだった場合の処理は略 (を

not

もう少し頑張ってみようかな。こうなるんでしょうか。

(define (not? exp)
  (tagged-list? exp 'not))
(define (eval-not exp env)
  (if (false? (eval exp env))
      true
      false))

うーん。以下の試験を作ったらループ。

      (assert-true (eval '(not false) genv))

他にも不具合あり。以下のように修正。

(define (eval-not exp env)
  (if (false? (eval (cadr exp) env))
      #t
      #f))

cadr とか微妙。以下の試験にパスしています。

  ("not"
   ("first"
    (let ((genv the-global-environment))
      (assert-true (eval '(not false) genv))
      (assert-false (eval '(not true) genv))
      (assert-false (eval '(not 3) genv))
      (assert-false (eval '(not (list 3)) genv))
      (assert-false (eval '(not '()) genv))
      (assert-false (eval '(not (list)) genv))
      (assert-false (eval '(not 'nil) genv))
      )
    )
   )

明日はどんな一日になるのやら。