+;;; A basic FIFO queue module.
+;;;
+
(module fifo
(make-fifo
fifo-push
fifo->list)
(import scheme
- (chicken base)
- srfi-18)
+ (chicken base))
(define (make-fifo)
(define (cell val prev next)
(set-car! (cddr cell) next-cell))
(let ((head '())
- (tail '())
- (pop-mutex (make-mutex)))
- (mutex-lock! pop-mutex #f #f)
+ (tail '()))
(lambda (cmd . args)
(case cmd
- ((empty?) (null? head))
((push)
(if (not (null? head))
(let ((old-head head))
(begin
;; Initialize list
(set! head (cell (car args) '() '()))
- (set! tail head)
- (mutex-unlock! pop-mutex))))
+ (set! tail head))))
((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))))))))))
+ (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))