(define-module (scmvm util stack)
  #:use-module (srfi srfi-43)
  #:export (make-stack stack-ref stack->list stack-set!
                       (push . stack-push) (pop . stack-pop) (peek . stack-peek) (swap . stack-swap)))

;; Stack data structure. I made this a closure implementation for some reason

(define *stack-size* 512)

(define* (make-stack #:optional (stack-size *stack-size*))
  "Make a new stack, optionally setting the size"
  (define the-stack (make-vector stack-size))
  (define top 0)
  (lambda (x)
    (case x
      [(push)
       (lambda (v)
         (if (>= top stack-size)
             (error "stack overflow")
             (begin
               (vector-set! the-stack top v)
               (set! top (1+ top)))))]
      [(pop)
       (lambda ()
         (if (zero? top)
             (error "pop empty stack")
             (begin
               (set! top (1- top))
               (vector-ref the-stack top))))]
      [(peek)
       (lambda ()
         (if (zero? top)
             (error "peek empty stack")
             (vector-ref the-stack (1- top))))]
      [(swap)
       (lambda ()
         (if (< (vector-length the-stack) 2)
             (error "no value to swap")
             (let ([a (vector-ref the-stack (- top 2))]
                   [b (vector-ref the-stack (- top 1))])
               (vector-set! the-stack (- top 2) b)
               (vector-set! the-stack (- top 1) a))))]
      [(ref)
       (lambda (k)
         (vector-ref the-stack k))]
      [(->list)
       (lambda ()
	 (reverse-vector->list the-stack 0 top))]
      [(set!)
       (lambda (k obj)
         (vector-set! the-stack k obj))]
      [else (error "stack dispatch unknown value")])))

(define (push stack v)
  ((stack 'push) v))

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

(define (peek stack)
  ((stack 'peek)))

(define (swap stack)
  ((stack 'swap)))

(define (stack-ref stack k)
  ((stack 'ref) k))

(define (stack->list stack)
  ((stack '->list)))

(define (stack-set! stack k obj)
  ((stack 'set!) k obj))