min stacks

Write a min-stack data structure supporting the usual operators (push, pop, top) as well as min, which returns the smallest value currently contained in the stack. All operators should take constant time, and the stack should use space linear in the number of values it contains.

 $ cat mns.rkt 
 #lang racket 
  
 (define (min-stack) 
  
   ; Return a new, immutable, empty min-stack. 
    
   (define (rue msg . args) 
     (apply raise-user-error 
            (cons 'min-stack (cons msg args)))) 
  
   (define (minstk val-stk min-stk) 
  
     (lambda (cmd . args) 
  
       (case (list 'quote cmd) 
  
         (('empty?) 
           ; return true iff this min-stack is empty. 
           (null? val-stk)) 
  
         (('min) 
           ; return the minimal value in this min-stack, or 
           ; explode if it's empty. 
           (if (null? min-stk) 
             (rue "calling min on an empty min-stack") 
             (car min-stk))) 
  
         (('pop) 
           ; return a copy of this min-stack with the top 
           ; element removed, or explode if it's empty. 
           (if (null? val-stk) 
             (rue "trying to pop an empty min-stack") 
             (minstk (cdr val-stk) (cdr min-stk)))) 
  
         (('push) 
           ; return a copy of this min-stack with the 
           ; given values pushed in left-to-right order. 
           (let loop ((vals args) 
                      (val-stk val-stk) 
                      (min-stk min-stk)) 
  
             (if (null? vals) 
               (minstk val-stk min-stk) 
               (let* ((val (car vals)) 
                      (min (if (null? min-stk) 
                               val 
                               (min val (car min-stk))))) 
                 (loop (cdr vals) 
                       (cons val val-stk) 
                       (cons min min-stk)))))) 
  
         (('top) 
           ; return the top of this min-stack, or explode if 
           ; it's empty. 
           (if (null? val-stk) 
             (rue "calling top on an empty min-stack") 
             (car val-stk))) 
  
         (else 
           (rue "'~a' not a min-stack operator" cmd))))) 
  
   (minstk null null)) 
  
  
 (module+ test 
    
   (require rackunit "utl.rkt") 
  
   (define (is-min-stack min-stk) 
     (let loop ((min-stk min-stk)) 
       (unless (min-stk 'empty?) 
         (let ((min (min-stk 'min))) 
           (let loop ((min-stk min-stk)) 
             (unless (min-stk 'empty?) 
               (check-true (<= min (min-stk 'top))) 
               (loop (min-stk 'pop))))) 
         (loop (min-stk 'pop))))) 
  
   (define (is-stack min-stk vals) 
     (unless (null? vals) 
       (let ((val (car vals))) 
         (check-eq? 
           ((is-stack (min-stk 'push val) (cdr vals)) 'top) 
           val))) 
     min-stk) 
  
   (do ((i 0 (+ i 1))) ((> i 20) (void)) 
     (let ((vals (permuted-iota i))) 
       (check-true ((is-stack (min-stack) vals) 'empty?)) 
       (is-min-stack (apply (min-stack) (cons 'push vals))))) 
   ) 
  
 $ raco test mns.rkt 
 raco test: (submod "mns.rkt" test) 
 1771 tests passed 
  
 $