74 lines
2.0 KiB
Scheme
74 lines
2.0 KiB
Scheme
(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))
|