;;; A basic FIFO queue module.
;;;

(module fifo
    (make-fifo
     fifo-push
     fifo-pop
     fifo-empty?
     fifo->list)

  (import scheme
          (chicken base))

  (define (make-fifo)
    (define (cell val prev next)
      (list val prev next))
    (define cell-val car)
    (define cell-prev cadr)
    (define cell-next caddr)
    (define (set-cell-prev! cell prev-cell)
      (set-car! (cdr cell) prev-cell))
    (define (set-cell-next! cell next-cell)
      (set-car! (cddr cell) next-cell))

    (let ((head '())
          (tail '()))
      (lambda (cmd . args)
        (case cmd
          ((push)
           (if (not (null? head))
               (let ((old-head head))
                 (set! head (cell (car args) '() old-head))
                 (set-cell-prev! old-head head))
               (begin
                 ;; Initialize list
                 (set! head (cell (car args) '() '()))
                 (set! tail head))))
          ((pop)
           (let ((old-tail tail))
             (set! tail (cell-prev old-tail))
             (if (null? tail)
                 (set! head '())
                 (set-cell-next! tail '()))
             (cell-val old-tail)))
          ((empty?) (null? head))
          ((->list)
           (let loop ((this-cell head))
             (if (null? this-cell)
                 '()
                 (cons (cell-val this-cell)
                       (loop (cell-next this-cell))))))))))
  
  (define (fifo-push fifo x)
    (fifo 'push x))

  (define (fifo-pop fifo)
    (fifo 'pop))

  (define (fifo-empty? fifo)
    (fifo 'empty?))

  (define (fifo->list fifo)
    (fifo '->list)))