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 を戻せば良い事に気づく。割り込みがいくつかあるので、所用を済ませて余裕があったら次のソレもヤッツケ予定。