; The content of this file is in the public domain.
; example usage with Chicken Scheme: csi -q -b stack-expanded.scm

; Without the benefit of the macro definition:  This is what
; the `define-opaque` expands to, for the stack example.

(define stack
  (letrec
    (
      (make-stack (lambda (items)
        (lambda (target . args)
          (if
            (equal? 'new target)
              (apply (lambda (new-items)
                (make-stack new-items))
              args)
              (if
                (equal? 'push target)
                  (apply (lambda (item)
                    (make-stack (cons item items)))
                  args)
                  (if
                    (equal? 'top target)
                      (apply (lambda ()
                        (car items))
                      args)
                      (if
                        (equal? 'pop target)
                          (apply (lambda ()
                            (make-stack (cdr items)))
                          args)
                          (error "Undefined operation:" target))))))
      ))
    )
    (make-stack '())))

; Here's a simplified version that converts the nested `if`s into
; more sensible branches in a `cond`, and eliminates the `apply`s.

(define stack
  (letrec
    (
      (make-stack (lambda (items)
        (lambda (target . args)
          (cond
            ((equal? target 'new)
              (let* ((new-items (car args)))
                (make-stack new-items)))
            ((equal? target 'push)
              (let* ((item (car args)))
                (make-stack (cons item items))))
            ((equal? target 'top)
              (car items))
            ((equal? target 'pop)
              (make-stack (cdr items)))
            (else
              (error "Undefined operation:" target))
          ))))
    )
    (make-stack '())))

(define demo (lambda ()
  (let* (
    (stack0 (stack 'new '(4 5 6)))
    (stack1 (stack0 'pop))
    (stack2 (stack1 'push 9))
    (stack3 (stack2 'pop))
    (stack4 (stack3 'push 8))
  )
    (display (stack0 'top)) (newline)
    (display (stack1 'top)) (newline)
    (display (stack2 'top)) (newline)
    (display (stack3 'top)) (newline)
    (display (stack4 'top)) (newline)
  )))

(demo)