Externalize stack for some reason, am I deathless?

scmvm/util/stack.scm

@@ -0,0 +1,73 @@
+(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))