SICP 読み (153) 4.1.4 評価器をプログラムとして走らせる

昨晩までのナニ

なんか直前エントリは錯乱状態と言っても過言ではないなぁ。前の晩にエキサイトしすぎて熱発、とか??
とりあえず昨晩作った試験を以下に。

  ("eval"
   ("self-evaluating"
    (assert-equal 1 (eval 1 the-global-environment))
    (assert-equal "a" (eval "a" the-global-environment))
    )

   ("variable"
    (assert-equal #t (eval 'true the-global-environment))
    )

   ("quoted"
    (assert-equal 'a (eval '(quote a) the-global-environment))
    )

   ("define & assignment"
    (let ((new-env (extend-environment '(x) '(1) the-global-environment)))
      (eval '(define y 2) new-env)
      (assert-equal 1 (eval 'x new-env))
      (assert-equal 2 (eval 'y new-env))
      (eval '(set! y 3) new-env)
      (assert-equal 3 (eval 'y new-env))
      )
    )

   ("app"
    (let ((l '(null? '())))
      (assert-true (application? l))

      (assert-equal 'primitive (car (eval (operator l) 
					  the-global-environment)))
      (assert-true (primitive-procedure? (eval (operator l)
					       the-global-environment)))

      (assert-true (apply (eval (operator l) the-global-environment)
			  (list-of-values (operands l) 
					  the-global-environment)))
      (assert-true (apply-primitive-procedure
		    (eval (operator l) the-global-environment)
		    (list-of-values (operands l) the-global-environment)))

      (assert-true (eval l the-global-environment))
      )
    )

   ("if"
    (let ((new-env (extend-environment '(x y) 
				       '(1 ()) 
				       the-global-environment)))
      (let ((l '(null? y)))
	(assert-true (eval l new-env))
	)
      (let ((l '(if (null? y) x y)))
	(assert-equal 1 (eval l new-env))
	)
      (let ((l '(if (null? x) x y)))
	(assert-equal '() (eval l new-env))
	)
      )
    )
   )

まだ単発ものを一通りやっとく必要あり。

lambda

ええと、lambda は手続きを戻すんだよな。ちょっと誤解していた。lambda が eval されて手続きになった後に apply に渡されるんだと思ってしまった。以下、NG だった試験の一部です。

      (let ((exp (eval l the-global-environment))
	    (genv the-global-environment))
	(assert-equal '(1) (apply (eval (operator exp) genv)
				  (list-of-values (operands exp) genv)))
	)

試験は以下。

   ("lambda"
    (let ((l '(lambda (x) (cons x '()))))
      (assert-equal 'procedure (car (eval l the-global-environment)))
      (assert-true (compound-procedure? (eval l the-global-environment)))
      (assert-equal '(x) (procedure-parameters (eval l 
						     the-global-environment)))
      (assert-equal '((cons x '())) 
		    (procedure-body (eval l the-global-environment)))
      (assert-equal the-global-environment
		    (procedure-environment (eval l
						 the-global-environment)))
      (assert-true (application? (eval l the-global-environment)))

      (let ((exp '((lambda (x) (cons x '())) 1))
	    (genv the-global-environment))
	(assert-equal '(1) (apply (eval (operator exp) genv)
				  (list-of-values (operands exp) genv)))
	(assert-equal '(1) (eval exp genv))
	)
      )
    )

次は begin か。

begin

gosh> (begin 1 2 3)
3
gosh>

なソレを。

   ("begin"
    (let ((l '(begin 1 2 3)))
      (assert-equal 3 (eval l the-global-environment))
      )
    )

とりあえずこれだけで。

cond

このあたり、練習問題なソレも含みつつ、なんですが簡易版のみをとりあえず試験。そろそろ基本手続きを加えないと微妙かも。

   ("cond"
    (let ((new-env (extend-environment '(x) '(())
				       the-global-environment)))
      (let ((l '(cond ((null? x) 1)
		      (else 2))))
	(assert-equal 1 (eval l new-env))
	(eval '(set! x 1) new-env)
	(assert-equal 1 (eval 'x new-env))
	(assert-equal 2 (eval l new-env))
	)
      )
    )
   )

しんどいのもあるんでしょうが、微妙だなぁ。

let

基本的なソレはもう少しか。

    (let ((l '(let ((a 1) (b 2)) (cons a (cons b '())))))
      (assert-equal '(1 2) (eval l the-global-environment))
      )

パス。ところが、以下の試験が NG。

    (let ((l '(let ff ((result '()) (lst '(1 2 3)))
		(cond ((null? lst) result)
		      (else
		       (ff (cons (car lst) result) (cdr lst)))))))
      (assert-equal '(3 2 1) (eval l the-global-environment))
      )

何故だ、と言いつつ以下の assert を追加して上記 assert はコメントアウト。

      (assert-equal 'lambda (let->combination l))

変換したら先頭は begin だしそれ以前に先頭持ってきてないし。でもお蔭でどんなリストが出てきてるかが判明。バグってるし。以下、見づらいので改行。

-- (test case) eval: .........F
 expected:<lambda>
  but was:<(begin 
             (define ff 
	       (lambda (result lst) 
		 (cond ((null? lst) result) 
		       (else (ff (cons (car lst) result) (cdr lst))))))
             (ff ('() '(1 2 3))))> in let

試験したんじゃねぇのかよ、と小一時間小言を (って誰

で、実装を以下に修正。

(define (let->combination exp)
  (if (symbol? (cadr exp))
      (list 'begin
	    (list 'define
		  (cadr exp)
		  (make-lambda (map car (caddr exp)) (cdddr exp)))
	    (append (list (cadr exp)) (map cadr (caddr exp))))
      (append (list (make-lambda (map car (cadr exp)) (cddr exp)))
	      (map cadr (cadr exp)))))

なんかこのあたりもきちんと見直す必要あるんじゃないかなぁ。で、上記の試験に通してみると以下。

-- (test case) eval: .........F
 expected:<lambda>
  but was:<(begin 
	     (define ff 
	       (lambda (result lst) 
		 (cond ((null? lst) result) 
		       (else (ff (cons (car lst) result) (cdr lst)))))) 
	     (ff '() '(1 2 3)))
> in let

できてそげ。あと、環境を微妙に変更したりなんかしてて、以下の試験が通らなくなっていた。

  ("the-global-environment"
   ("true & false"
    (assert-equal 'true (cadr (car (car the-global-environment))))
    (assert-equal 'false (car (car (car the-global-environment))))
    (assert-true (lookup-variable-value 'true the-global-environment))
    (assert-false (lookup-variable-value 'false the-global-environment))
    )
   )

setup 入れるか、と思いつつ先頭に以下を追加。駄目だなぁ。

    (set! the-global-environment (setup-environment))

少し休憩入れて、基本手続きを盛り込んでから、もう少しきちんとした試験を検討しましょうね。

つづき

エントリ投入後、寝てしまい。現在 16:40。基本手続きを盛り込んでみた。

(define primitive-procedures
  (list (list 'car car)
	(list 'cdr cdr)
	(list 'cons cons)
	(list 'null? null?)
	(list 'list list)
	(list 'eqv? eqv?)
	(list 'eq? eq?)
	(list 'equal? equal?)
	(list 'number? number?)
	(list 'complex? complex?)
	(list 'real? real?)
	(list 'rational? rational?)
	(list 'integer? integer?)
	(list '= =)
	(list '< <)
	(list '> >)
	(list '<= <=)
	(list '>= >=)
	(list 'zero? zero?)
	(list 'positive? positive?)
	(list 'negative? negative?)
	(list 'odd? odd?)
	(list 'even? even?)
	(list 'max max)
	(list 'min min)
	(list '+ +)
	(list '* *)
	(list '- -)
	(list '/ /)
	(list 'assoc assoc)
;        <more primitives>
	))

どっからどこまでが適当なのか良く分からんな。とりあえず試験を。

  ("add primitive procedure"
   ("list"
    (let ((genv the-global-environment))
      (assert-equal '(1 2 3) (eval '(list 1 2 3) genv))
      (assert-equal '(()) (eval '(list '()) genv))
      (assert-equal '(a) (eval '(list 'a) genv))
      )
    )

   ("eqv?"
    (let ((genv the-global-environment))
      (assert-true (eval '(eqv? 'a 'a) genv))
      (assert-false (eval '(eqv? 'a 'b) genv))
      (assert-true (eval '(eqv? 2 2) genv))
      (assert-true (eval '(eqv? '() '()) genv))
      (assert-true (eval '(eqv? 10000000 10000000) genv))
      (assert-false (eval '(eqv? (cons 1 2) (cons 1 2)) genv))
      (assert-false (eval '(eqv? (lambda () 1) (lambda () 2)) genv))
      (let ((new-env (extend-environment '(p) '((lambda (x) x)) genv)))
	(assert-true (eval '(eqv? p p) new-env)))
      )
    )

   ("eq?"
    (let ((genv the-global-environment))
      (assert-true (eval '(eq? 'a 'a) genv))
      (assert-false (eval '(eq? (list 'a) (list 'a)) genv))
      (assert-true (eval '(eq? '() '()) genv))
      (assert-true (eval '(eq? car car) genv))
      (assert-true (eval '(let ((x '(a))) (eq? x x)) genv))
      (assert-true (eval '(let ((p (lambda (x) x))) (eq? p p)) genv))
      )
    )

   ("equal?"
    (let ((genv the-global-environment))
      (assert-true (eval '(equal? 'a 'a) genv))
      (assert-true (eval '(equal? '(a) '(a)) genv))
      (assert-true (eval '(equal? '(a (b) c)
				  '(a (b) c)) genv))
      (assert-true (eval '(equal? "abc" "abc") genv))
      (assert-true (eval '(equal? 2 2) genv))
      )
    )

   ("number?"
    (let ((genv the-global-environment))
      (assert-true (eval '(number? 5) genv))
      (assert-false (eval '(number? 'a) genv))
      (assert-false (eval '(number? car) genv))
      (assert-false (eval '(number? '()) genv))
      )
    )

   ("complex?"
    (let ((genv the-global-environment))
      (assert-true (eval '(complex? 3+4i) genv))
      (assert-true (eval '(complex? 3) genv))
      )
    )

   ("real?"
    (let ((genv the-global-environment))
      (assert-true (eval '(real? 3) genv))
      (assert-true (eval '(real? -2.5+0.0i) genv))
      )
    )

   ("rational?"
    (let ((genv the-global-environment))
      (assert-true (eval '(rational? 6/10) genv))
      (assert-true (eval '(rational? 6/3) genv))
      )
    )

   ("integer?"
    (let ((genv the-global-environment))
      (assert-true (eval '(integer? 3.0) genv))
      (assert-true (eval '(integer? 8/4) genv))
      )
    )

   ("compare"
    (let ((genv the-global-environment))
      (assert-true (eval '(= 1 1) genv))
      (assert-false (eval '(= 1 2) genv))
      (assert-true (eval '(< 1 2) genv))
      (assert-false (eval '(< 1 1) genv))
      (assert-false (eval '(< 1 0) genv))
      (assert-false (eval '(> 1 2) genv))
      (assert-false (eval '(> 1 1) genv))
      (assert-true (eval '(> 1 0) genv))
      (assert-true (eval '(<= 1 2) genv))
      (assert-true (eval '(<= 1 1) genv))
      (assert-false (eval '(<= 1 0) genv))
      (assert-false (eval '(>= 1 2) genv))
      (assert-true (eval '(>= 1 1) genv))
      (assert-true (eval '(>= 1 0) genv))
      )
    )

   ("zero?"
    (let ((genv the-global-environment))
      (assert-true (eval '(zero? 0) genv))
      (assert-false (eval '(zero? 1) genv))
      )
    )

   ("positive?"
    (let ((genv the-global-environment))
      (assert-true (eval '(positive? 1) genv))
      (assert-false (eval '(positive? -1) genv))
      (assert-false (eval '(positive? 0) genv))
      )
    )

   ("negative?"
    (let ((genv the-global-environment))
      (assert-true (eval '(negative? -1) genv))
      (assert-false (eval '(negative? 1) genv))
      (assert-false (eval '(negative? 0) genv))
      )
    )

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

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

   ("max & min"
    (let ((genv the-global-environment))
      (assert-equal 2 (eval '(max 1 2) genv))
      (assert-equal 1 (eval '(min 1 2) genv))
      )
    )

   ("arithmetic operation"
    (let ((genv the-global-environment))
      (assert-equal 2 (eval '(+ 1 1) genv))
      (assert-equal 4 (eval '(* 2 2) genv))
      (assert-equal 2 (eval '(/ 6 3) genv))
      (assert-equal 5 (eval '(- 10 5) genv))
      )
    )

   ("assoc"
    (let ((genv the-global-environment))
      (assert-equal '((a)) (eval '(assoc (list 'a) 
					 '(((a)) ((b)) ((c)))) 
				 genv))
      (assert-equal '(b 2) (eval '(assoc 'b
					 '((a 1) (b 2)))
				 genv))
      (assert-false (eval '(assoc 'c '((a 1) (b 2))) genv))
      )
    )
   )

だめだ。すっげえ適当。って試験書き終わったのが 17:30 ですか。一時間 ...