Behaviours are now tagged lists.

[sam.git] / fifo.scm

diff --git a/fifo.scm b/fifo.scm
index d2cea22..ca5634f 100644 (file)
--- a/fifo.scm
+++ b/fifo.scm
@@ -1,3 +1,6 @@
+;;; A basic FIFO queue module.
+;;;
+
 (module fifo
     (make-fifo
      fifo-push
@@ -6,8 +9,7 @@
      fifo->list)
 
   (import scheme
-          (chicken base)
-          srfi-18)
+          (chicken base))
 
   (define (make-fifo)
     (define (cell val prev next)
@@ -21,12 +23,9 @@
       (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))
@@ -35,29 +34,22 @@
                (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))