48057be36858 — Linus Björnstam 5 years ago
a fastish persistent fifo.
1 files changed, 98 insertions(+), 0 deletions(-)

A => persistent-fifo.scm
A => persistent-fifo.scm +98 -0
@@ 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))))
+