An imperative stack implementation in Racket.

stack.rkt

#lang racket
(provide (except-out (all-defined-out)
                     stack))

(struct exn:fail:stack exn:fail ())

(struct stack ([vector]
               [top #:mutable])
  #:transparent)

(define (make-stack [size 100])
  (stack (make-vector size) -1))

(define (push!-one s x)
  (let ((s-vector (stack-vector s))
        (s-top (stack-top s)))
    (set-stack-top! s (+ s-top 1))
    (vector-set! s-vector (stack-top s) x)
    (void)))

(define (push! s x . xs)
  (push!-one s x)
  (for ([y xs])
    (push!-one s y)))

(define (pop! s)
  (if (equal? (stack-top s) -1)
      (raise (exn:fail:stack "stack underflow" (current-continuation-marks)))
      (let* ((s-vector (stack-vector s))
             (s-top (stack-top s))
             (s-top-x (vector-ref s-vector s-top)))
        (vector-set! s-vector s-top #f)
        (set-stack-top! s (- s-top 1))
        s-top-x)))

(define (peek s)
  (if (equal? (stack-top s) -1)
      (raise (exn:fail:stack "stack underflow" (current-continuation-marks)))
      (vector-ref (stack-vector s) (stack-top s))))

(define (stack-empty? s)
  (equal? (stack-top s) -1))

(define (stack->list s)
  (define s-vector (stack-vector s))
  (define s-top (stack-top s))  
  (define (stack->list-iter i acc)
    (if (< i 0)
        acc
        (stack->list-iter (- i 1)
                          (cons (vector-ref s-vector i) acc))))
  (stack->list-iter s-top '()))

(module+ test
  (require rackunit rackunit/text-ui)

  (define stack-tests
    (test-suite
     "Tests for stack"
     
     (let ((the-stack (make-stack)))
       (check-exn exn:fail:stack? (λ () (pop! the-stack)))
       (check-exn exn:fail:stack? (λ () (peek the-stack)))
       (check-equal? (stack->list the-stack) '())

       (push! the-stack 1)
       (push! the-stack 2)
       (push! the-stack 3)
       (push! the-stack 4)
       (push! the-stack 5)

       (check-equal? (pop! the-stack) 5)
       (check-equal? (pop! the-stack) 4)
       (check-equal? (pop! the-stack) 3)
       (check-equal? (peek the-stack) 2)
       (check-equal? (stack->list the-stack) '(1 2))

       (push! the-stack 6 7 8)
       (check-equal? (stack->list the-stack) '(1 2 6 7 8))
       )
     ))

  (run-tests stack-tests)
  )