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

  (import scheme
          (chicken base)
          srfi-18)

  (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 '())
          (pop-mutex (make-mutex)))
      (mutex-lock! pop-mutex #f #f)
      (lambda (cmd . args)
        (case cmd
          ((empty?) (null? head))
          ((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)
                 (mutex-unlock! pop-mutex))))
          ((pop)
           (mutex-lock! pop-mutex #f #f)
           (if (null? head)
               (error "FIFO empty.")
               (let ((old-tail tail))
                 (set! tail (cell-prev old-tail))
                 (if (null? tail)
                     (set! head '())
                     (begin
                       (set-cell-next! tail '())
                       (mutex-unlock! pop-mutex #f #f)))
                 (cell-val old-tail)))))
        ((->list) (if (not (= (length args) 0))
                      (error "Wrong number of arguments to ->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)))