SICP 読み (140) 4.1.2 式の表現

昨晩、微妙なまま力尽きた模様。続きを。

lambda 関連

試験を追加。

  ("lambda"
   ("lambda (1)"
    (let ((l '(lambda (x y) (* x y))))
      (assert-equal '(x y) (lambda-parameters l))
      (assert-equal '((* x y)) (lambda-body l))
      )
    )

   ("lambda (2)"
    (let ((l '(lambda (x y) (* x y) (+ x y))))
      (assert-equal '(x y) (lambda-parameters l))
      (assert-equal '((* x y) (+ x y)) (lambda-body l))
      )
    )

   ("make-lambda (1)"
    (let ((l (make-lambda '(x y) '(+ (* x y) (+ x y)))))
      (assert-equal '(x y) (lambda-parameters l))
      (assert-equal '(+ (* x y) (+ x y)) (lambda-body l))
      )
    )

   ("make-lambda (2)"
    (let ((l (make-lambda '(x y) '((* x y) (+ x y)))))
      (assert-equal 'lambda (car l))
      (assert-equal '(x y) (lambda-parameters l))
      (assert-equal '((* x y) (+ x y)) (lambda-body l))
      )
    )

うーん。どんどん試験を書こう。

if 関連

  ("if"
   ("if (1)"
    (let ((l '(if (= x 1)
		  x
		  (- x 1))))
      (assert-equal '(= x 1) (if-predicate l))
      (assert-equal 'x (if-consequent l))
      (assert-equal '(- x 1) (if-alternative l))
      )
    )

   ("if (2)"
    (let ((l '(if (= x 1)
		  x)))
      (assert-equal '(= x 1) (if-predicate l))
      (assert-equal 'x (if-consequent l))
      (assert-equal 'false (if-alternative l))
      )
    )
   )

何故にここだけ quote な false を戻すんだろうか。

make-if

make-if 微妙。必ず alternative なソレを渡さないといけないのか。

  ("make-if"
   ("make-if (1)"
    (let ((l (make-if '(= x 1) 'x '(- x 1))))
      (assert-equal '(= x 1) (if-predicate l))
      (assert-equal 'x (if-consequent l))
      (assert-equal '(- x 1) (if-alternative l))
      )
    )

   ("make-if (2)"
    (let ((l (make-if '(= x 1) 'x 'false)))
      (assert-equal '(= x 1) (if-predicate l))
      (assert-equal 'x (if-consequent l))
      (assert-equal 'false (if-alternative l))
      )
    )
   )

begin

last-exp? の取り扱いが微妙に感じる。

  ("begin"
   ("begin (1)"
    (let ((l '(begin x y z)))
      (assert-equal 'x (first-exp (begin-action l)))
      (assert-equal 'y (first-exp (rest-exps (begin-action l))))
      (assert-equal 'z (first-exp (rest-exps (rest-exps (begin-action l)))))
      (assert-false (last-exp? (begin-action l)))
      (assert-false (last-exp? (rest-exps (begin-action l))))
      (assert-true (last-exp? (rest-exps (rest-exps (begin-action l)))))
      )
    )

   ("sequence->exp"
    (let ((l (sequence->exp '(x y z))))
      (assert-equal 'begin (car l))
      (assert-equal 'x (first-exp (begin-action l)))
      (assert-equal 'y (first-exp (rest-exps (begin-action l))))
      (assert-equal 'z (first-exp (rest-exps (rest-exps (begin-action l)))))
      (assert-true (last-exp? (rest-exps (rest-exps (begin-action l)))))
      )
    )
   )

application

うーん。なんか機械的にヤッツケてしまってる感満点だなぁ。

  ("application"
   ("application (1)"
    (let ((l '(car x)))
      (assert-equal 'car (operator l))
      (assert-equal '(x) (operands l))
      )
    )

   ("application (2)"
    (let ((l '(cons x (cons y z))))
      (assert-equal 'cons (operator l))
      (assert-equal '(x (cons y z)) (operands l))
      (assert-equal 'x (first-operand (operands l)))
      (assert-equal '(cons y z) (first-operand (rest-operands (operands l))))
      (assert-false (no-operands? (operands l)))
      (assert-false (no-operands? (rest-operands (operands l))))
      (assert-true (no-operands? (rest-operands (rest-operands (operands l)))))
      )
    )
   )

cond

cond の書き方ってどうだったか。たまたま sequence->exp 手続きが見えるので以下。

(define (sequence->exp seq)
  (cond ((null? seq) seq)
	((last-exp? seq) (first-exp seq))
	(else (make-begin seq))))

cdr が条件式なソレですね。cond-clauses で取り出せるのが以下。これが clause か。

(((null? seq) seq) ((last-exp? seq) (first-exp seq)) (else (make-begin seq)))

clauses から要素を取り出す手続きが無いな、って cond は if に変換されるのか。とりあえず cond 関連の試験を書いとこう。 expand-clauses はその後。

  ("cond"
   ("cond"
    (let ((clauses '(((null? seq) seq) 
		     ((last-exp? seq) (first-exp seq)) 
		     (else (make-begin seq)))))
      (let ((l (cons 'cond clauses)))
	(assert-equal clauses (cond-clauses l))
	(assert-false (cond-else-clause? (car clauses)))
	(assert-false (cond-else-clause? (cadr clauses)))
	(assert-true (cond-else-clause? (caddr clauses)))
	(assert-equal '(null? seq) (cond-predicate (car clauses)))
	(assert-equal '(seq) (cond-actions (car clauses)))
	)
      )
    )
   )

expand-clauses

cond の試験に追加する形で以下。

   ("expand-clauses"
    (assert-equal 'false (expand-clauses '()))
    (assert-error (lambda () (expand-clauses '((else (x)) ((= x 1) (y))))))

    (let ((l '(cond ((last-exp? exps) (eval (first-exp exps) env))
		    (else (eval (first-exp exps) env)
			  (eval-sequence (rest-exps exps) env)))))
      (let ((if-S '(if (last-exp? exps)
		       (eval (first-exp exps) env)
		       (begin (eval (first-exp exps) env)
			      (eval-sequence (rest-exps exps) env)))))
	(assert-equal if-S (expand-clauses (cond-clauses l)))))

    (let ((l '(cond ((null? seq) seq)
		    ((last-exp? seq) (first-exp seq))
		    (else (make-begin seq)))))
      (let ((if-S '(if (null? seq)
		       seq
		       (if (last-exp? seq)
			   (first-exp seq)
			   (make-begin seq)))))
	(assert-equal if-S (expand-clauses (cond-clauses l)))))
    )

cond->if もやっとくか。

   ("cond->if"
    (let ((l '(cond ((last-exp? exps) (eval (first-exp exps) env))
		    (else (eval (first-exp exps) env)
			  (eval-sequence (rest-exps exps) env)))))
      (let ((if-S '(if (last-exp? exps)
		       (eval (first-exp exps) env)
		       (begin (eval (first-exp exps) env)
			      (eval-sequence (rest-exps exps) env)))))
	(assert-equal if-S (cond->if l))))
    (let ((l '(cond ((null? seq) seq)
		    ((last-exp? seq) (first-exp seq))
		    (else (make-begin seq)))))
      (let ((if-S '(if (null? seq)
		       seq
		       (if (last-exp? seq)
			   (first-exp seq)
			   (make-begin seq)))))
	(assert-equal if-S (cond->if l))))
    )

eval もなんとかなるかと思いきや、env が何とかならんとどうにもならん。問題 4.3 の書き換えは別途きちんとやりたい、という事で以降の問題に着手予定。