SICP 読み (139) 4.1.2 式の表現

例示されている部分の試験を検討して理解を深める事に。
とりあえず、eval と eval を呼び出す手続きはまだ試験不能。で、self-evaluating? から、と思ったんですが、true だの false だのがナニ。

self-evaluating?

仕方が無いので試験の中にコードを仕込んだ。こんなコトしてええんかのぅ。

#!/usr/bin/env gosh

(use test.unit)
(require "4.1.2")

(define-test-suite "4.1.2"

  ("self-evaluating?"
   ("number, string is #t"
    (define true #t)
    (define false #f)
    (define (self-evaluating? exp)
      (cond ((number? exp) true)
	    ((string? exp) true)
	    (else false)))
    (assert-true (self-evaluating? 1))
    (assert-true (self-evaluating? "abc"))
    (assert-false (self-evaluating? '(1 2 3)))
    (assert-false (self-evaluating? 'a))
    )
   )
  )

これはヒドい、と言いつつ試験パス。

variable?

これはどう試験したものか。仕様書を見ると symbol? の評価の例が列挙されている。

(symbol? 'foo)         ; => #t
(symbol? (car '(a b))) ; => #t
(symbol? "bar")        ; => #f
(symbol? 'nil)         ; => #t
(symbol? '())          ; => #f
(symbol? #f)           ; => #f

これをそのまま使う事に (を

  ("variable?"
   ("symbol?"
    (assert-true (variable? 'foo))
    (assert-true (variable? (car '(a b))))
    (assert-true (not (variable? "bar")))
    (assert-true (variable? 'nil))
    (assert-true (not (variable? '())))
    (assert-true (not (variable? #f)))
    )
   )

無論、ではありますがパス。

quoted? と tagged-list?

self-evaluating? と variable? の試験のトキに気がついてたんですが、どうやって #t と #f と true と false の関係を、収束させてたのかと。でも SICP って true とか false って書き方してたなぁ。
とりあえず、このあたりの微妙な部分は先に出てくるのを知ってるんで適当に試験。(を

  ("tagged-list?"
   ("pair & match tag is #t"
    (define (tagged-list? exp tag)
      (if (pair? exp)
	  (eq? (car exp) tag)
	  #f))

    (assert-true (tagged-list? '(a b c) 'a))
    (assert-true (not (tagged-list? 'a 'a)))
    (assert-true (not (tagged-list? '(a b) 'b)))
    )
   )

もう一つ。quoted? なんですが、同じ名前の手続きが存在する場合、直近な定義の方が優先される、と勝手読みで以下な試験をでっち上げたら通った。

  ("quoted?"
   ("car is 'quote"
    (define (tagged-list? exp tag)
      (if (pair? exp)
	  (eq? (car exp) tag)
	  #f))

    (assert-true (quoted? '(quote a b)))
    (assert-true (not (quoted? '(a b c))))
    )
   )

以降の試験は tagged-list? を試験の中で定義せんと駄目かも。

式の型の確認は面倒なので一括で

  ("verification of type of exp"
   ("lot"
    (define (tagged-list? exp tag)
      (if (pair? exp)
	  (eq? (car exp) tag)
	  #f))

    (assert-true (assignment? '(set! a b)))
    (assert-true (not (assignment? '(a b c))))
    (assert-true (definition? '(define a b)))
    (assert-true (not (definition? '(a b c))))
    (assert-true (lambda? '(lambda a b)))
    (assert-true (not (lambda? '(a b c))))
    (assert-true (if? '(if a b)))
    (assert-true (not (if? '(a b c))))
    (assert-true (begin? '(begin a b)))
    (assert-true (not (begin? '(a b c))))
    (assert-true (application? '(a . b)))
    (assert-true (application? '(a b c)))
    (assert-true (not (application? '())))
    (assert-true (not (application? '#(a b))))
    )
   )

set! について

set! は引数二つ限定とゆー事で以下。

  ("set!"
   ("set! has variable and value"
    (let ((cmd '(set! a b)))
      (assert-equal 'a (assignment-variable cmd)) ; cadr
      (assert-equal 'b (assignment-value cmd))    ; caddr
      )
    )
   )

define あたりから微妙

実装が以下。

(define (definition-variable exp)
  (if (symbol? (cadr exp))
      (cadr exp)
      (caadr exp)))
(define (definition-value exp)
  (if (symbol? (cadr exp))
      (caddr exp)
      (make-lambda (cdadr exp)
		   (cddr exp))))

(define (make-lambda parameters body)
  (cons 'lambda (cons parameters body)))

(cadr exp) が symbol だったら以下の形式で

(define xxx yyy)

そうでなければ手続き定義

(define (a b c) (d e))

てきとー杉ですが勘弁して下さい。これは p.219 に書いてある通り、という事でスルーしつつ試験を書く。

  ("define"
   ("define variable"
    (let ((x '(define a b)))
      (assert-equal 'a (definition-variable x))
      (assert-equal 'b (definition-value x))
      )
    )

   ("define procedure"
    (let ((x '(define (a b c) (d e))))
      (assert-equal 'a (definition-variable x))
      (assert-equal '(lambda (b c) (d e))
		    (definition-value x))
      )
    )
   )

む。make-lambda の試験ってしてないな。順番としては lambda に関係するナニを試験してから、だったのかなぁ。

lambda 関連

以下の試験をでっち上げたんですが

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

   ("make-lambda"
    (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))
      )
    )
   )

なんか微妙。ちょっとオチてない何かがある。