EoPL Ex.2.15

stack.scm

(define empty-stack
  (lambda ()
    (lambda (sym)
      (cond ((eqv? sym 'empty-stack?) #t)
	    (else
	     (eopl:error 'empty-stack "stack is empty ~s" sym))))))

(define push
  (lambda (value stack)
    (lambda (sym)
      (cond ((eqv? sym 'pop) stack)
	    ((eqv? sym 'top) value)
	    ((eqv? sym 'empty-stack?) #f)))))

(define pop
  (lambda (stack)
    (stack 'pop)))

(define top
  (lambda (stack)
    (stack 'top)))

(define empty-stack?
  (lambda (stack)
    (stack 'empty-stack?)))

test-stack.scm

(use gauche.test)
(add-load-path ".")
(load "stack")

(test-start "stack")
(test-section "empty-stack")

(test* "empty-stack"
       (test-error)
       ((empty-stack)))

(test-section "empty-stack?")
(test* "empty-stack"
       #t
       (empty-stack? (empty-stack)))

(test-section "push")
(test* "pushed stack is not empty"
       #f
       (empty-stack? (push 1 (empty-stack))))

(test-section "pop")
(test* "cannot pop from empty-stack"
       (test-error)
       (pop (empty-stack)))
(test* "get top of stack"
       (empty-stack)
       (pop (push 1 (empty-stack))))
(test* "after pop"
       #t
       (empty-stack? (pop (push 1 (empty-stack)))))

(test-section "top")
(test* "cannot get from empty-stack"
       (test-error)
       (top (empty-stack)))
(test* "top of _not empty-stack_ check"
       1
       (top (push 1 (empty-stack))))

(test-end)