EoPL reading (110) 2.3 Representation Strategies for Data Types

the world of Android の開始前に紙の上で検討。

Exercise 2.19

以下がでっち上がる。

(add-load-path ".")
(load "define-datatype")

(define scheme-value? (lambda (v) #t))

(define-datatype stack stack?
  (empty-stack-record)
  (extended-stack-record
   (val scheme-value?)
   (env stack?)))

(define empty-stack
  (lambda ()
    (empty-stack-record)))

(define push
  (lambda (val env)
    (extended-stack-record val env)))

(define apply-env
  (lambda (cmd env)
    (cases stack env
	   (empty-stack-record 
	    ()
	    (if (eqv? cmd 'empty?)
		#t
		(eopl:error 'apply-env
			    "No binding for" sym)))
	   (extended-stack-record 
	    (val env)
	    (cond ((eqv? cmd 'pop) env)
		  ((eqv? cmd 'top) val)
		  ((eqv? cmd 'empty?) #f))))))

(define pop
  (lambda (env)
    (apply-env 'pop env)))
(define top
  (lambda (env)
    (apply-env 'top env)))
(define empty?
  (lambda (env)
    (apply-env 'empty? env)))

で、試験も作った。

(use gauche.test)

(add-load-path ".")
(load "stack")

(test-start "stack")

(test-section "empty-stack")
(test* "empty-stack-record"
       '(empty-stack-record)
       (empty-stack))

(test-section "push")
(test* "push 1 to null-stack"
       '(extended-stack-record 1 (empty-stack-record))
       (push 1 (empty-stack)))
(test* "push 1, push 2 to null-stack"
       '(extended-stack-record 
	 1
	 (extended-stack-record
	  2
	  (empty-stack-record)))
       (push 1 (push 2 (empty-stack))))

(test-section "apply-env")
(let ((stack (push 1 (push 2 (push 3 (empty-stack))))))
  (test* "(empty? (empty-stack))"
	 #t
	 (apply-env 'empty? (empty-stack)))
  (test* "(not (empty? stack))"
	 #f
	 (apply-env 'empty? stack))
  (test* "(pop (empty-stack))"
	 *test-error*
	 (apply-env 'pop (empty-stack)))
  (test* "(pop stack)"
	 '(extended-stack-record
	   2
	   (extended-stack-record
	    3
	    (empty-stack-record)))
	 (apply-env 'pop stack))
  (test* "(top (empty-stack))"
	 *test-error*
	 (apply-env 'top (empty-stack)))
  (test* "(top stack)"
	 1
	 (apply-env 'top stack))
  )

(test-section "pop")
(let ((s (push 1 (empty-stack))))
  (test* "(pop (empty-stack))"
	 *test-error*
	 (pop (empty-stack)))
  (test* "(pop s)"
	 '(empty-stack-record)
	 (pop s))
  )

(test-section "top")
(let ((s (push 1 (empty-stack))))
  (test* "(top (empty-stack))"
	 *test-error*
	 (top (empty-stack)))
  (test* "(top s)"
	 1
	 (top s))
  )

(test-section "empty?")
(let ((s (push 1 (empty-stack))))
  (test* "(empty? (empty-stack))"
	 #t
	 (empty? (empty-stack)))
  (test* "(not (empty? s))"
	 #f
	 (empty? s))
  )

(test-end)

実は当初、apply-env 手続きが以下になってて

(define apply-env
  (lambda (cmd env)
    (cases stack env
	   (empty-stack-record 
	    ()
	    (if (eqv? cmd 'empty?)
		#t
		(eopl:error 'apply-env
			    "No binding for" sym)))
	   (extended-stack-record 
	    (val env)
	    (cond ((eqv? cmd 'pop) env)
		  ((eqv? cmd 'top) val)
		  ((eqv? cmd 'empty?)
		   (apply-env cmd env)))))))

何故か

  (test* "(not (empty? s))"
	 #f
	 (empty? s))

な試験に失敗する #t が戻る。あら? って思ったら extend-stack-record 検出時点で #f を戻せば良い事に気づく。割り込みがいくつかあるので、所用を済ませて余裕があったら次のソレもヤッツケ予定。