# HG changeset patch
# User Steve Losh <steve@stevelosh.com>
# Date 1617993960 14400
# Node ID 40d63316cd3c120b115f30dc65450894d88ce9e0
# Parent  4e5867a99afe1427c3ceb2228f06efc5de5b423b# Parent  2db6543352b624d553d6575a4b83eb2ab753b00b
Merge

diff -r 2db6543352b6 -r 40d63316cd3c losh.asd
--- a/losh.asd	Tue Dec 22 20:05:01 2020 -0500
+++ b/losh.asd	Fri Apr 09 14:46:00 2021 -0400
@@ -12,6 +12,7 @@
   :depends-on (:iterate
                :cl-ppcre
                :external-program
+               :flexi-streams
                #+sbcl :sb-sprof)
 
   :serial t
diff -r 2db6543352b6 -r 40d63316cd3c make-docs.lisp
--- a/make-docs.lisp	Tue Dec 22 20:05:01 2020 -0500
+++ b/make-docs.lisp	Fri Apr 09 14:46:00 2021 -0400
@@ -22,6 +22,7 @@
         "LOSH.PRIORITY-QUEUES"
         "LOSH.QUEUES"
         "LOSH.RANDOM"
+        "LOSH.RING-BUFFERS"
         "LOSH.SEQUENCES"
         "LOSH.SHELL"
         "LOSH.WEIGHTLISTS"
diff -r 2db6543352b6 -r 40d63316cd3c package.lisp
--- a/package.lisp	Tue Dec 22 20:05:01 2020 -0500
+++ b/package.lisp	Fri Apr 09 14:46:00 2021 -0400
@@ -78,6 +78,7 @@
     :hset-map!
     :hset-reduce))
 
+
 (defpackage :losh.io
   (:use :cl :iterate :losh.quickutils)
   (:documentation "Utilities for input/output/reading/etc.")
@@ -92,7 +93,9 @@
   (:export
     :0..   :1..   :n..
     :0...  :1...  :n...
-    :somelist))
+    :somelist
+    :assocar  :assocdr
+    :rassocar :rassocdr))
 
 (defpackage :losh.mutation
   (:use :cl :iterate :losh.quickutils)
@@ -175,6 +178,29 @@
     :pq-ensure
     :pq-dequeue))
 
+(defpackage :losh.ring-buffers
+  (:use :cl :iterate :losh.quickutils
+    :losh.chili-dogs
+    :losh.eldritch-horrors
+    :losh.mutation)
+  (:documentation "Simple ring buffer implementation.")
+  (:export
+
+    :do-ring-buffer
+    :make-ring-buffer
+    :rb-contents
+    :rb-count
+    :rb-empty-p
+    :rb-full-p
+    :rb-pop
+    :rb-push
+    :rb-ref
+    :rb-safe-push
+    :rb-size
+    :ring-buffer
+
+    ))
+
 
 (defpackage :losh.control-flow
   (:use :cl :iterate :losh.quickutils
@@ -199,7 +225,8 @@
     :multiple-value-bind*
     :do-repeat
     :do-range
-    :do-irange))
+    :do-irange
+    :do-file))
 
 
 (defpackage :losh.math
@@ -252,17 +279,20 @@
 
 (defpackage :losh.iterate
   (:use :cl :iterate :losh.quickutils
-    :losh.hash-sets)
+    :losh.hash-sets
+    :losh.ring-buffers)
   (:documentation "Custom `iterate` drivers and clauses.")
   (:export
 
     :across-flat-array
+    :against
     :anding
     :averaging
     :collect-frequencies
     :collect-hash
     :collect-set
     :cycling
+    :end
     :every-nth
     :finding-all
     :finding-first
@@ -270,31 +300,30 @@
     :in-array
     :in-hashset
     :in-lists
+    :in-ring-buffer
     :in-sequences
     :in-whatever
     :index-of-flat-array
     :initially
     :into
     :macroexpand-iterate
+    :matching
     :modulo
     :oring
+    :overlap
     :pairs-of-list
     :per-iteration-into
     :real-time
+    :returning
     :run-time
     :seed
     :since-start-into
     :skip-origin
+    :start
     :test
     :then
     :timing
     :within-radius
-    :returning
-    :matching
-    :against
-    :overlap
-    :start
-    :end
 
     ))
 
@@ -417,6 +446,7 @@
    :losh.priority-queues
    :losh.queues
    :losh.random
+   :losh.ring-buffers
    :losh.sequences
    :losh.shell
    :losh.weightlists
diff -r 2db6543352b6 -r 40d63316cd3c src/control-flow.lisp
--- a/src/control-flow.lisp	Tue Dec 22 20:05:01 2020 -0500
+++ b/src/control-flow.lisp	Fri Apr 09 14:46:00 2021 -0400
@@ -516,3 +516,49 @@
                ,(recur (rest ranges)))))))))
 
 
+(let ((eof (gensym "EOF")))
+  (defmacro do-file
+      ((symbol path &rest open-options &key (reader '#'read-line) &allow-other-keys)
+       &body body)
+    "Iterate over the contents of `file` using `reader`.
+
+    During iteration, `symbol` will be set to successive values read from the
+    file by `reader`.
+
+    `reader` can be any function that conforms to the usual reading interface,
+    i.e. anything that can handle `(read-foo stream eof-error-p eof-value)`.
+
+    Any keyword arguments other than `:reader` will be passed along to `open`.
+    If `nil` is used for one of the `:if-…` options to `open` and this results
+    in `open` returning `nil`, no iteration will take place.
+
+    An implicit block named `nil` surrounds the iteration, so `return` can be
+    used to terminate early.
+
+    Returns `nil` by default.
+
+    Examples:
+
+      (do-file (line \"foo.txt\")
+        (print line))
+
+      (do-file (form \"foo.lisp\" :reader #'read :external-format :EBCDIC-US)
+        (when (eq form :stop)
+          (return :stopped-early))
+        (print form))
+
+      (do-file (line \"does-not-exist.txt\" :if-does-not-exist nil)
+        (this-will-not-be-executed))
+
+    "
+    (let ((open-options (alexandria:remove-from-plist open-options :reader)))
+      (with-gensyms (stream)
+        (once-only (path reader)
+          `(when-let ((,stream (open ,path :direction :input ,@open-options)))
+             (unwind-protect
+                 (do ((,symbol
+                       (funcall ,reader ,stream nil ',eof)
+                       (funcall ,reader ,stream nil ',eof)))
+                     ((eq ,symbol ',eof))
+                   ,@body)
+               (close ,stream))))))))
diff -r 2db6543352b6 -r 40d63316cd3c src/iterate.lisp
--- a/src/iterate.lisp	Tue Dec 22 20:05:01 2020 -0500
+++ b/src/iterate.lisp	Fri Apr 09 14:46:00 2021 -0400
@@ -730,6 +730,24 @@
     `(,kwd (,var) :in-hashtable (losh.hash-sets::hash-set-storage ,hset))))
 
 
+(defmacro-driver (FOR var IN-RING-BUFFER ring-buffer)
+  "Iterate over the elements of `ring-buffer`, oldest to newest."
+  (let ((kwd (if generate 'generate 'for)))
+    (with-gensyms (rb r w d s)
+      `(progn
+         (with ,rb = ,ring-buffer)
+         (with ,r = (losh.ring-buffers::r ,rb))
+         (with ,w = (losh.ring-buffers::w ,rb))
+         (with ,d = (losh.ring-buffers::data ,rb))
+         (with ,s = (losh.ring-buffers::size ,rb))
+         (,kwd ,var :next (if (= ,r ,w)
+                            (terminate)
+                            (prog1 (svref ,d ,r)
+                              (incf ,r)
+                              (when (= ,r ,s)
+                                (setf ,r 0)))))))))
+
+
 (defmacro-driver (FOR var SEED seed THEN then)
   "Bind `var` to `seed` initially, then to `then` on every iteration.
 
diff -r 2db6543352b6 -r 40d63316cd3c src/lists.lisp
--- a/src/lists.lisp	Tue Dec 22 20:05:01 2020 -0500
+++ b/src/lists.lisp	Fri Apr 09 14:46:00 2021 -0400
@@ -38,3 +38,41 @@
 (defun n... (from to)
   "Return a fresh list of the range `[from, to]`."
   (loop :for i :from from :to to :collect i))
+
+
+(declaim (inline assocar assocdr rassocar rassocdr
+                 (setf assocar) (setf assocdr) (setf rassocar) (setf rassocdr)))
+
+
+(defun assocar (item alist &rest args)
+  "Return the `car` of `(apply #'assoc item alist args)`."
+  (car (apply #'assoc item alist args)))
+
+(defun assocdr (item alist &rest args)
+  "Return the `cdr` of `(apply #'assoc item alist args)`."
+  (cdr (apply #'assoc item alist args)))
+
+(defun rassocar (item alist &rest args)
+  "Return the `car` of `(apply #'rassoc item alist args)`."
+  (car (apply #'rassoc item alist args)))
+
+(defun rassocdr (item alist &rest args)
+  "Return the `cdr` of `(apply #'rassoc item alist args)`."
+  (cdr (apply #'rassoc item alist args)))
+
+
+(defun (setf assocar) (new-value item alist &rest args)
+  "Set the `car` of `(apply #'assoc item alist args)` to `new-value`."
+  (setf (car (apply #'assoc item alist args)) new-value))
+
+(defun (setf assocdr) (new-value item alist &rest args)
+  "Set the `cdr` of `(apply #'assoc item alist args)` to `new-value`."
+  (setf (cdr (apply #'assoc item alist args)) new-value))
+
+(defun (setf rassocar) (new-value item alist &rest args)
+  "Set the `car` of `(apply #'rassoc item alist args)` to `new-value`."
+  (setf (car (apply #'rassoc item alist args)) new-value))
+
+(defun (setf rassocdr) (new-value item alist &rest args)
+  "Set the `cdr` of `(apply #'rassoc item alist args)` to `new-value`."
+  (setf (cdr (apply #'rassoc item alist args)) new-value))
diff -r 2db6543352b6 -r 40d63316cd3c src/shell.lisp
--- a/src/shell.lisp	Tue Dec 22 20:05:01 2020 -0500
+++ b/src/shell.lisp	Fri Apr 09 14:46:00 2021 -0400
@@ -19,6 +19,7 @@
   * `stream`: output will be returned as a character stream.
   * `string`: all output will be gathered up and returned as a single string.
   * `list`: all output will be gathered up and returned as a list of lines.
+  * `vector`: all output will be gathered up and returned as a vector of octets.
 
   If `wait` is `nil`, the only acceptable values for `result-type` are `null`
   and `stream`.
@@ -29,6 +30,7 @@
     ((cons string list)))
   (ctypecase input
     (string (setf input (make-string-input-stream input)))
+    (vector (setf input (flexi-streams:make-in-memory-input-stream input)))
     (stream)
     (null))
   (when (not wait)
@@ -37,9 +39,11 @@
   (let* ((out (if wait ; why is every external programming running facility a goddamn mess?
                 (ecase result-type
                   ((string stream list) (make-string-output-stream))
+                  (vector (flexi-streams:make-in-memory-output-stream))
                   (null nil))
                 (ecase result-type
                   ((string list) (make-string-output-stream))
+                  (vector (flexi-streams:make-in-memory-output-stream))
                   (stream :stream)
                   (null nil))))
          (result (multiple-value-list
@@ -56,6 +60,7 @@
                 (null nil)
                 (stream (output-stream))
                 (string (get-output-stream-string out))
+                (vector (flexi-streams:get-output-stream-sequence out))
                 (list (iterate (for line :in-stream (output-stream) :using #'read-line)
                                (collect line))))
               result)))))