--- 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
--- 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"
--- 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
--- 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))))))))
--- 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.
--- 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))
--- 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)))))