@@ 0,0 1,98 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Copyright 2019 Linus Björnstam
+;;
+;; Permission to use, copy, modify, and/or distribute this software for any
+;; purpose with or without fee is hereby granted, provided that the above
+;; copyright notice and this permission notice appear in all source copies.
+;; The software is provided "as is", without any express or implied warranties.
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;
+;; Yall should check out the following srfis before deciding to use this:
+;; srfi-134 (ideques): a generalisation of fifo/lifo that is persistent.
+;; as described by Chris Okasaki. If you only want a
+;; fifo, this library should be slightly faster, since it does
+;; not do any "balancing".
+;; srfi-117 (list-queues): a mutable general queue. Could be both fifo and lifo.
+;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; A persistent fifo. Enqueue operations are O(1), while dequeue is amortized O(1)
+;; worst case being O(n), which entails a reverse of all enqueued items.
+;;
+;; pfifo-length, pfifo-merge, pfifo-fold, pfifo-map and pfifo-filter are all O(n)-ish
+;; as they just transverse the deq and (reverse enq).
+;;
+;; Now, as they say: "Take my clothes off, dip me in chocolate and throw me to the
+;; homophobes".
+
+(define-module (persistent-fifo)
+ #:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-8)
+ #:use-module (srfi srfi-9)
+ #:export (pfifo
+ pfifo-empty?
+ pfifo-length
+ pfifo-enqueue
+ pfifo-dequeue
+ pfifo-dequeue/pair
+ pfifo-fold
+ pfifo-map
+ pfifo-filter))
+
+(define-record-type <pfifo>
+ (%make-pfifo enq deq)
+ pfifo?
+ (enq pfifo-get-enq)
+ (deq pfifo-get-deq))
+
+
+(define (pfifo . items)
+ (pfifo-enqueue (%make-pfifo '() items)))
+
+(define (pfifo-empty? pfifo)
+ (and (null? (pfifo-get-deq pfifo)) (null? (pfifo-get-enq pfifo))))
+
+(define (check-pfifo pf)
+ (when (pfifo-empty? pf)
+ (error "Pfifo is empty" pf)))
+
+(define (pfifo-length pfifo)
+ (+ (length (pfifo-get-enq pfifo)) (length (pfifo-get-enq pfifo))))
+
+;; enqueues items in pfifo. items are enqueued front to back.
+;; It is faster to enqueue many items at once than to enqueue
+;; several items in separate pfifo-enqueue calls.
+(define (pfifo-enqueue pfifo . items)
+ (define enq (pfifo-get-enq pfifo))
+ (define new-enq (fold cons enq items))
+ (%make-pfifo new-enq (pfifo-get-deq pfifo)))
+
+(define (pfifo-dequeue pfifo)
+ (if (pfifo-empty? pfifo)
+ (values #f #f)
+ (receive (enq deq)
+ (if (null? (pfifo-get-deq pfifo))
+ (values '() (reverse (pfifo-get-enq pfifo)))
+ (values (pfifo-get-enq pfifo) (pfifo-get-deq pfifo)))
+ (values (%make-pfifo enq (cdr deq)) (car deq)))))
+
+(define (pfifo-dequeue/pair pfifo)
+ (call-with-values (lambda () (pfifo-dequeue pfifo)) cons))
+
+;; Merges the content of p2 into p1, by putting all of the elements in both p1 and p2
+;; in a new pfifo's deq. o(n)-ish.
+(define (pfifo-merge p1 p2)
+ (%make-pfifo '() (append (pfifo-get-deq p1) (reverse (pfifo-get-enq p1))
+ (pfifo-get-deq p2) (reverse (pfifo-get-deq p2)))))
+
+(define (pfifo-fold proc identity pf)
+ (define first-round (fold proc identity (pfifo-get-deq pf)))
+ (fold proc first-round (reverse (pfifo-get-enq pf))))
+
+(define (pfifo-map proc pf)
+ (check-pfifo pf)
+ (%make-pfifo '() (reverse (pfifo-fold (lambda (x acc) (cons (proc x) acc)) '() pf))))
+
+(define (pfifo-filter pred pf)
+ (check-pfifo pf)
+ (%make-pfifo '() (reverse (pfifo-fold (lambda (x acc) (if (pred x) (cons x acc) acc)) '() pf))))
+