--- a/DOCUMENTATION.markdown Tue Apr 30 17:06:11 2019 -0400
+++ b/DOCUMENTATION.markdown Tue Apr 30 17:06:46 2019 -0400
@@ -24,16 +24,18 @@
### `BISECT-LEFT` (function)
- (BISECT-LEFT PREDICATE VECTOR TARGET)
-
-Bisect `vector` based on `(predicate el target)` and return the LEFT element.
+ (BISECT-LEFT PREDICATE VECTOR TARGET &KEY (KEY #'IDENTITY) (START 0) (END (LENGTH VECTOR)))
+
+Bisect `vector` with `predicate` and return the LEFT element.
+
+ Only the subsequence of `vector` bounded by `start` and `end` is considered.
`vector` must be sorted (with `predicate`) before this function is called
(this is not checked).
You can think of this function as partitioning the elements into two halves:
- those that satisfy `(predicate el target)` and those that don't, and then
- selecting the element on the LEFT side of the split:
+ those that satisfy `(predicate (funcall key element) target)` and those that
+ don't, and then selecting the element on the LEFT side of the split:
satisfying not statisfying
#(.......... ...............)
@@ -46,28 +48,32 @@
Examples:
- ; index
- ; 0 1 2 3 4 5 val index
- (bisect #'< #(1 3 5 7 7 9) 5) ; => 3, 1
- (bisect #'<= #(1 3 5 7 7 9) 5) ; => 5, 2
- (bisect #'<= #(1 3 5 7 7 9) 7) ; => 7, 4
- (bisect #'< #(1 3 5 7 7 9) 1) ; => nil, nil
- (bisect #'> #(9 8 8 8 1 0) 5) ; => 8, 3
+ ; index
+ ; 0 1 2 3 4 5 val index
+ (bisect-left '< #(1 3 5 7 7 9) 5) ; => 3, 1
+ (bisect-left '<= #(1 3 5 7 7 9) 5) ; => 5, 2
+ (bisect-left '<= #(1 3 5 7 7 9) 7) ; => 7, 4
+ (bisect-left '< #(1 3 5 7 7 9) 1) ; => nil, nil
+ (bisect-left '> #(9 8 8 8 1 0) 5) ; => 8, 3
+ (bisect-left '< #((1) (2 2) (3 3 3)) 2 :key #'length) ; => (1), 0
+ (bisect-left '<= #((1) (2 2) (3 3 3)) 2 :key #'length) ; => (2 2), 1
### `BISECT-RIGHT` (function)
- (BISECT-RIGHT PREDICATE VECTOR TARGET)
-
-Bisect `vector` based on `(predicate el target)` and return the RIGHT element.
+ (BISECT-RIGHT PREDICATE VECTOR TARGET &KEY (KEY #'IDENTITY) (START 0) (END (LENGTH VECTOR)))
+
+Bisect `vector` with `predicate` and return the RIGHT element.
+
+ Only the subsequence of `vector` bounded by `start` and `end` is considered.
`vector` must be sorted (with `predicate`) before this function is called
(this is not checked).
You can think of this function as partitioning the elements into two halves:
- those that satisfy `(predicate el target)` and those that don't, and then
- selecting the element on the RIGHT side of the split:
+ those that satisfy `(predicate (funcall key element) target)` and those that
+ don't, and then selecting the element on the RIGHT side of the split:
satisfying not statisfying
#(.......... ...............)
@@ -80,13 +86,15 @@
Examples:
- ; index
- ; 0 1 2 3 4 5 val index
- (rbisect #'< #(1 3 5 7 7 9) 5) ; => 5, 2
- (rbisect #'<= #(1 3 5 7 7 9) 5) ; => 7, 3
- (rbisect #'<= #(1 3 5 7 7 9) 7) ; => 9, 5
- (rbisect #'< #(1 3 5 7 7 9) 10) ; => nil, nil
- (rbisect #'> #(9 8 8 8 1 0) 5) ; => 1, 4
+ ; index
+ ; 0 1 2 3 4 5 val index
+ (bisect-right '< #(1 3 5 7 7 9) 5) ; => 5, 2
+ (bisect-right '<= #(1 3 5 7 7 9) 5) ; => 7, 3
+ (bisect-right '<= #(1 3 5 7 7 9) 7) ; => 9, 5
+ (bisect-right '< #(1 3 5 7 7 9) 10) ; => nil, nil
+ (bisect-right '> #(9 8 8 8 1 0) 5) ; => 1, 4
+ (bisect-right '< #((1) (2 2) (3 3 3)) 2 :key #'length) ; => (2 2), 1
+ (bisect-right '<= #((1) (2 2) (3 3 3)) 2 :key #'length) ; => (3 3 3), 2
@@ -313,6 +321,35 @@
Thread the given forms, with `<>` as a placeholder.
+### `DO-IRANGE` (macro)
+
+ (DO-IRANGE RANGES
+ &BODY
+ BODY)
+
+Perform `body` on the given inclusive `ranges`.
+
+ Each range in `ranges` should be of the form `(variable from to)`. During
+ iteration `body` will be executed with `variable` bound to successive values
+ in the range [`from`, `to`].
+
+ If multiple ranges are given they will be iterated in a nested fashion.
+
+ Example:
+
+ (do-irange ((x 0 2)
+ (y 10 11))
+ (pr x y))
+ ; =>
+ ; 0 10
+ ; 0 11
+ ; 1 10
+ ; 1 11
+ ; 2 10
+ ; 2 11
+
+
+
### `DO-RANGE` (macro)
(DO-RANGE RANGES
@@ -463,7 +500,7 @@
This macro combines `if` and `let`. It takes a list of bindings and binds
them like `let` before executing the `then` branch of `body`, but if any
- binding's value evaluate to `nil` the process stops there and the `else`
+ binding's value evaluates to `nil` the process stops there and the `else`
branch is immediately executed (with no bindings in effect).
If any `optional-declarations` are included they will only be in effect for
@@ -779,12 +816,6 @@
-### `PHT` (function)
-
- (PHT HASH-TABLE &OPTIONAL (STREAM T))
-
-Synonym for `print-hash-table` for less typing at the REPL.
-
### `PR` (function)
(PR &REST ARGS)
@@ -798,25 +829,9 @@
-### `PRINT-HASH-TABLE` (function)
-
- (PRINT-HASH-TABLE HASH-TABLE &OPTIONAL (STREAM T))
-
-Print a pretty representation of `hash-table` to `stream.`
-
- Respects `*print-length*` when printing the elements.
-
-
-
-### `PRINT-HASH-TABLE-CONCISELY` (function)
-
- (PRINT-HASH-TABLE-CONCISELY HASH-TABLE &OPTIONAL (STREAM T))
-
-Print a concise representation of `hash-table` to `stream.`
-
- Should respect `*print-length*` when printing the elements.
-
-
+### `PRETTY-PRINT-HASH-TABLE` (function)
+
+ (PRETTY-PRINT-HASH-TABLE *STANDARD-OUTPUT* HT)
### `PRINT-TABLE` (function)
@@ -957,14 +972,71 @@
Utilities for working with higher-order functions.
+### `FIXED-POINT` (function)
+
+ (FIXED-POINT FUNCTION DATA &KEY (TEST 'EQL) (LIMIT NIL))
+
+Find a fixed point of `function`, starting with `data`.
+
+ Successive runs of `function` will be compared with `test`. Once `test`
+ returns true the last result will be returned.
+
+ `limit` can be an integer to limit the maximum number of iterations performed.
+
+ A second value is also returned: `t` if a fixed point was found or `nil` if
+ the iteration limit was reached.
+
+
+
+### `JUXT` (function)
+
+ (JUXT &REST FUNCTIONS)
+
+Return a function that will juxtapose the results of `functions`.
+
+ This is like Clojure's `juxt`. Given functions `(f0 f1 ... fn)`, this will
+ return a new function which, when called with some arguments, will return
+ `(list (f0 ...args...) (f1 ...args...) ... (fn ...args...))`.
+
+ Example:
+
+ (funcall (juxt #'list #'+ #'- #'*) 1 2)
+ => ((1 2) 3 -1 2)
+
+
+
+### `NULLARY` (function)
+
+ (NULLARY FUNCTION &OPTIONAL RESULT)
+
+Return a new function that acts as a nullary-patched version of `function`.
+
+ The new function will return `result` when called with zero arguments, and
+ delegate to `function` otherwise.
+
+ Examples:
+
+ (max 1 10 2) ; => 10
+ (max) ; => invalid number of arguments
+
+ (funcall (nullary #'max)) ; => nil
+ (funcall (nullary #'max 0)) ; => 0
+ (funcall (nullary #'max 0) 1 10 2) ; => 10
+
+ (reduce #'max nil) ; => invalid number of arguments
+ (reduce (nullary #'max) nil) ; => nil
+ (reduce (nullary #'max :empty) nil) ; => :empty
+ (reduce (nullary #'max) '(1 10 2)) ; => 10
+
+
+
## Package `LOSH.GNUPLOT`
Utilities for plotting data with gnuplot.
### `GNUPLOT` (function)
- (GNUPLOT DATA &REST ARGS &KEY (X #'CAR) (Y #'CDR) (SPEW-OUTPUT NIL)
- &ALLOW-OTHER-KEYS)
+ (GNUPLOT DATA &REST ARGS &KEY (X #'CAR) (Y #'CDR) (SPEW-OUTPUT NIL) &ALLOW-OTHER-KEYS)
Plot `data` to `filename` with gnuplot.
@@ -983,12 +1055,11 @@
### `GNUPLOT-ARGS` (function)
- (GNUPLOT-ARGS &KEY (OUTPUT :QT) (FILENAME plot.png) (STYLE :LINES)
- (SIZE-X 1200) (SIZE-Y 800) (LABEL-X) (LABEL-Y)
- (LINE-TITLE 'DATA) (LINE-WIDTH 4) (SMOOTH NIL) (AXIS-X NIL)
- (AXIS-Y NIL) (MIN-X NIL) (MAX-X NIL) (MIN-Y NIL) (MAX-Y NIL)
- (TICS-X NIL) (GRAPH-TITLE) (LOGSCALE-X NIL) (LOGSCALE-Y NIL)
- (BOX-WIDTH NIL) &ALLOW-OTHER-KEYS)
+ (GNUPLOT-ARGS &KEY (OUTPUT :QT) (FILENAME plot.png) (STYLE :LINES) (SIZE-X 1200) (SIZE-Y 800)
+ (LABEL-X) (LABEL-Y) (LINE-TITLE 'DATA) (LINE-WIDTH 4) (SMOOTH NIL) (AXIS-X NIL)
+ (AXIS-Y NIL) (MIN-X NIL) (MAX-X NIL) (MIN-Y NIL) (MAX-Y NIL) (TICS-X NIL)
+ (TICS-Y NIL) (GRAPH-TITLE) (LOGSCALE-X NIL) (LOGSCALE-Y NIL) (BOX-WIDTH NIL)
+ &ALLOW-OTHER-KEYS)
Return the formatted command line arguments for the given gnuplot arguments.
@@ -997,22 +1068,12 @@
-### `GNUPLOT-EXPR` (macro)
-
- (GNUPLOT-EXPR EXPR &REST ARGS)
-
-Plot `expr` (an expression involving `x`) with gnuplot.
-
- See the docstring of `gnuplot-args` for other keyword arguments.
-
-
-
### `GNUPLOT-FUNCTION` (function)
- (GNUPLOT-FUNCTION FUNCTION &REST ARGS &KEY (START 0.0) (END 1.0) (STEP 0.1)
- (INCLUDE-END NIL) &ALLOW-OTHER-KEYS)
-
-Plot `function` over [`start`, `end`) by `step` with gnuplot.
+ (GNUPLOT-FUNCTION FUNCTION &REST ARGS &KEY (START 0.0) (END 1.0) (STEP 0.1) (INCLUDE-END NIL)
+ &ALLOW-OTHER-KEYS)
+
+Plot `function` over `[start, end)` by `step` with gnuplot.
If `include-end` is `t` the `end` value will also be plotted.
@@ -1022,7 +1083,7 @@
### `GNUPLOT-HISTOGRAM` (function)
- (GNUPLOT-HISTOGRAM DATA &KEY (BIN-WIDTH 1) SPEW-OUTPUT)
+ (GNUPLOT-HISTOGRAM DATA &REST ARGS &KEY (BIN-WIDTH 1) &ALLOW-OTHER-KEYS)
Plot `data` as a histogram with gnuplot.
@@ -1244,6 +1305,12 @@
Utilities for input/output/reading/etc.
+### `READ-ALL` (function)
+
+ (READ-ALL STREAM)
+
+Read all forms from `stream` and return them as a fresh list.
+
### `READ-ALL-FROM-FILE` (function)
(READ-ALL-FROM-FILE PATH)
@@ -1675,8 +1742,7 @@
### `RANDOM-GAUSSIAN-INTEGER` (function)
- (RANDOM-GAUSSIAN-INTEGER MEAN STANDARD-DEVIATION &OPTIONAL
- (GENERATOR #'RANDOM))
+ (RANDOM-GAUSSIAN-INTEGER MEAN STANDARD-DEVIATION &OPTIONAL (GENERATOR #'RANDOM))
Return a random integer from a gaussian distribution. NOT THREAD-SAFE (yet)!
@@ -1863,18 +1929,30 @@
### `PRODUCT` (function)
- (PRODUCT SEQUENCE &KEY KEY)
+ (PRODUCT SEQUENCE &KEY KEY (INITIAL-VALUE 1) MODULO)
Return the product of all elements of `sequence`.
If `key` is given, it will be called on each element to compute the
multiplicand.
+ If `initial-value` is given, it will be used instead of 1 to seed the
+ multiplication.
+
+ If `modulo` is given the successive products will be modulo'ed by it along the
+ way, which can prevent the need for bignums if you don't need the full result.
+
Examples:
(product #(1 2 3))
; => 6
+ (product #(1 2 3) :modulo 5)
+ ; => 1
+
+ (product #(1 2 3) :modulo 5 :initial-value 2)
+ ; => 2
+
(product '("1" "2" "3") :key #'parse-integer)
; => 6
@@ -1906,14 +1984,33 @@
+### `STRING-JOIN` (function)
+
+ (STRING-JOIN SEPARATOR SEQUENCE)
+
+Join a `sequence` of objects into a string, separated by `separator`.
+
+ All objects in `sequence` (and `separator`) will be `princ-to-string`ed before
+ joining.
+
+ This is implemented simply, not efficiently, so consider implementing your own
+ if you're joining a lot of stuff.
+
+
+
### `SUMMATION` (function)
- (SUMMATION SEQUENCE &KEY KEY)
+ (SUMMATION SEQUENCE &KEY KEY (INITIAL-VALUE 0) MODULO)
Return the sum of all elements of `sequence`.
If `key` is given, it will be called on each element to compute the addend.
+ If `initial-value` is given, it will be used instead of 0 to seed the addition.
+
+ If `modulo` is given the successive sums will be modulo'ed by it along the
+ way, which can prevent the need for bignums if you don't need the full result.
+
This function's ugly name was chosen so it wouldn't clash with iterate's `sum`
symbol. Sorry.
--- a/losh.asd Tue Apr 30 17:06:11 2019 -0400
+++ b/losh.asd Tue Apr 30 17:06:46 2019 -0400
@@ -54,7 +54,9 @@
"hash-tables"))
(:file "iterate" :depends-on ("control-flow"
- "sequences"))
+ "sequences"
+ "iterate-pre"
+ "hash-sets"))
(:file "gnuplot" :depends-on ("control-flow"
"debugging"
"sequences"))
--- a/package.lisp Tue Apr 30 17:06:11 2019 -0400
+++ b/package.lisp Tue Apr 30 17:06:46 2019 -0400
@@ -82,6 +82,7 @@
(:use :cl :iterate :losh.quickutils)
(:documentation "Utilities for input/output/reading/etc.")
(:export
+ :read-all
:read-all-from-file
:read-all-from-string))
@@ -323,6 +324,7 @@
(defpackage :losh.iterate
(:use :cl :iterate :losh.quickutils
:losh.iterate-pre
+ :losh.hash-sets
:losh.control-flow ;; always needed because we need a single RECURSIVELY symbol
:losh.sequences)
(:documentation "Custom `iterate` drivers and clauses.")
@@ -332,8 +334,10 @@
:anding
:averaging
:collect-hash
+ :collect-set
:cycling
:every-nth
+ :finding-all
:for-nested
:in-array
:in-hashset
@@ -351,9 +355,11 @@
:real-time
:recursively
:run-time
+ :seed
:since-start-into
:skip-origin
:test
+ :then
:timing
:within-radius
--- a/src/debugging.lisp Tue Apr 30 17:06:11 2019 -0400
+++ b/src/debugging.lisp Tue Apr 30 17:06:46 2019 -0400
@@ -192,12 +192,12 @@
(dump-profile filename))
#+sbcl
-(defmacro profile (&body body)
- "Profile `body` and dump the report to `lisp.prof`."
+(defmacro profile (form &key (mode :cpu))
+ "Profile `form` and dump the report to `lisp.prof`."
`(progn
- (start-profiling)
+ (start-profiling :mode ,mode)
(unwind-protect
- (time (progn ,@body))
+ (time ,form)
(stop-profiling))))
--- a/src/gnuplot.lisp Tue Apr 30 17:06:11 2019 -0400
+++ b/src/gnuplot.lisp Tue Apr 30 17:06:46 2019 -0400
@@ -5,7 +5,7 @@
(remove nil args)))
(defun gnuplot-args (&key
- (output :wxt)
+ (output :qt)
(filename "plot.png")
(style :lines)
(size-x 1200)
@@ -22,6 +22,7 @@
(min-y nil)
(max-y nil)
(tics-x nil)
+ (tics-y nil)
(graph-title)
(logscale-x nil)
(logscale-y nil)
@@ -33,12 +34,28 @@
the list of possible gnuplot arguments all in one place.
"
+ (check-type axis-x boolean)
+ (check-type axis-y boolean)
+ (check-type logscale-x boolean)
+ (check-type logscale-y boolean)
+ (check-type line-width (or integer float))
+ (check-type box-width (or null integer float))
+ (check-type min-x (or null integer float))
+ (check-type min-y (or null integer float))
+ (check-type max-x (or null integer float))
+ (check-type max-y (or null integer float))
+ (check-type tics-x (or null integer float))
+ (check-type tics-y (or null integer float))
+ (check-type graph-title (or null string))
+ (check-type label-x (or null string))
+ (check-type label-y (or null string))
+ (check-type smooth (member nil :unique :frequency :csplines :acsplines :bezier :sbezier))
(flet ((esc (string) (remove #\' (aesthetic-string string)))
(f (&rest args) (apply #'format nil (substitute "" nil args))))
(gnuplot-args%
(ccase output
((:x :x11) (f "set terminal x11 persist"))
- (:qt (f "set terminal qt persist"))
+ (:qt (f "set terminal qt"))
(:wxt (f "set terminal wxt persist"))
(:png
(f "set terminal pngcairo dashed size ~D,~D font \"Lucida Grande,20\""
@@ -47,8 +64,9 @@
(f "set border linewidth 1")
(f "set style line 10 dashtype 2 linewidth 3 linecolor \"#666666\"")
(when axis-x (f "set xzeroaxis linestyle 10"))
+ (when axis-y (f "set yzeroaxis linestyle 10"))
(when tics-x (f "set xtics ~A" tics-x))
- (when axis-y (f "set yzeroaxis linestyle 10"))
+ (when tics-y (f "set ytics ~A" tics-y))
(when box-width (f "set boxwidth ~A" box-width))
(when graph-title (f "set title '~A'" (esc graph-title)))
(when label-x (f "set xlabel '~A'" (esc label-x)))
@@ -59,12 +77,11 @@
(f "set yrange [~A:~A]" min-y max-y)
(f "plot '-' using 1:2 title '~A' with ~(~A~) linewidth ~D ~A"
(esc line-title) style line-width
- (when smooth (f "smooth ~(~A~)" smooth))))))
+ (when smooth (f "smooth ~(~A~)" smooth)))
+ (f "pause mouse close"))))
-(defun gnuplot (data
- &rest args
- &key
+(defun gnuplot (data &rest args &key
(x #'car)
(y #'cdr)
(spew-output nil)
@@ -83,16 +100,14 @@
See the docstring of `gnuplot-args` for other keyword arguments.
"
- (uiop/package:symbol-call :ql :quickload 'external-program :silent t)
- (let* ((process (uiop/package:symbol-call
- :external-program :start
- "gnuplot"
- (apply #'gnuplot-args args)
- :input :stream
- :output (if spew-output *standard-output* nil)))
- (in (uiop/package:symbol-call
- :external-program :process-input-stream
- process)))
+ (funcall (read-from-string "ql:quickload") 'external-program :silent t)
+ (let* ((process (funcall (read-from-string "external-program:start")
+ "gnuplot"
+ (apply #'gnuplot-args args)
+ :input :stream
+ :output (if spew-output *standard-output* nil)))
+ (in (funcall (read-from-string "external-program:process-input-stream")
+ process)))
(unwind-protect
(progn
(iterate (for item :in-whatever data)
@@ -101,15 +116,13 @@
(close in))
process))
-(defun gnuplot-function (function
- &rest args
- &key
+(defun gnuplot-function (function &rest args &key
(start 0.0)
(end 1.0)
(step 0.1)
(include-end nil)
&allow-other-keys)
- "Plot `function` over [`start`, `end`) by `step` with gnuplot.
+ "Plot `function` over `[start, end)` by `step` with gnuplot.
If `include-end` is `t` the `end` value will also be plotted.
@@ -126,9 +139,8 @@
(apply #'gnuplot data args)))
-(defun gnuplot-histogram (data
- &rest args
- &key (bin-width 1)
+(defun gnuplot-histogram (data &rest args &key
+ (bin-width 1)
&allow-other-keys)
"Plot `data` as a histogram with gnuplot.
--- a/src/io.lisp Tue Apr 30 17:06:11 2019 -0400
+++ b/src/io.lisp Tue Apr 30 17:06:46 2019 -0400
@@ -1,5 +1,11 @@
(in-package :losh.io)
+(defun read-all (stream)
+ "Read all forms from `stream` and return them as a fresh list."
+ (iterate
+ (for v :in-stream stream)
+ (collect v)))
+
(defun read-all-from-string (string)
"Read all forms from `string` and return them as a fresh list."
(iterate
@@ -14,10 +20,4 @@
(defun read-all-from-file (path)
"Read all forms from the file at `path` and return them as a fresh list."
(with-open-file (file path :direction :input)
- (iterate
- (with done = (gensym))
- (for form = (read file nil done))
- (while (not (eq form done)))
- (collect form))))
-
-
+ (read-all file)))
--- a/src/iterate.lisp Tue Apr 30 17:06:11 2019 -0400
+++ b/src/iterate.lisp Tue Apr 30 17:06:46 2019 -0400
@@ -249,7 +249,6 @@
(elt ,source ,i))))))))
-
(defclause-sequence ACROSS-FLAT-ARRAY INDEX-OF-FLAT-ARRAY
:access-fn 'row-major-aref
:size-fn 'array-total-size
@@ -596,6 +595,28 @@
(with ,hash-table = (make-hash-table :test ,test))
(setf (gethash ,key ,hash-table) ,value)))))
+(defmacro-clause (COLLECT-SET element &optional
+ INTO var
+ TEST (test '#'eql))
+ "Collect elements into a hash set at `var`.
+
+ If `var` is omitted the hash set will be returned instead.
+
+ `test` specifies the test used for the hash set.
+
+ Example:
+
+ (iterate (for y :in '(a b a))
+ (collect-set y))
+ ; => {a b}
+
+ "
+ (let ((hash-set (or var iterate::*result-var*)))
+ `(progn
+ (with ,hash-set = (make-hash-set :test ,test))
+ (hset-insert! ,hash-set ,element))))
+
+
(defmacro-clause (ORING expr &optional INTO var)
(let ((result (or var iterate::*result-var*)))
`(reducing ,expr :by #'or :into ,result :initial-value nil)))
@@ -665,3 +686,124 @@
(,kwd ,var = ,expr))))
+(defmacro-driver (FOR var SEED seed THEN then)
+ "Bind `var` to `seed` initially, then to `then` on every iteration.
+
+ This differs from `(FOR … FIRST … THEN …)` and `(FOR … INITIALLY … THEN …)`
+ because `then` is evaluated on every iteration, *including* the first.
+
+ Example:
+
+ (iterate
+ (repeat 3)
+ (for x :first 0 :then (1+ x))
+ (for y :initially 0 :then (1+ y))
+ (for z :seed 0 :then (1+ z))
+ (collect (list x y z)))
+ ; =>
+ ((0 0 1)
+ (1 1 2)
+ (2 2 3))
+
+ "
+ (let ((kwd (if generate 'generate 'for)))
+ `(progn
+ (,kwd ,var :next ,then)
+ (initially (setf ,var ,seed)))))
+
+
+(defmacro-clause (FINDING-ALL expr MINIMIZING m-expr &optional INTO var)
+ "Collect all `expr`s minimizing `m-expr` into a list at `var`.
+
+ The partial list at `var` is available for inspection at any point in the loop.
+
+ If `m-expr` is a sharp-quoted function, then it is called on `expr` instead of
+ being evaluated and compared itself.
+
+ "
+ ;; TODO: result-type
+ (alexandria:with-gensyms (min value m-value tail)
+ (let ((result (or var iterate::*result-var*)))
+ `(progn
+ (with ,result = '())
+ (with ,tail = nil)
+ (with ,min = nil)
+ ,(typecase m-expr
+ ((cons (eql function) (cons t null))
+ `(progn
+ (for ,value = ,expr)
+ (for ,m-value = (funcall ,m-expr ,value))
+ (cond
+ ((or (null ,min)
+ (< ,m-value ,min)) (setf ,result (list ,value)
+ ,tail ,result
+ ,min ,m-value))
+ ((= ,m-value ,min) (setf (cdr ,tail) (cons ,value nil)
+ ,tail (cdr ,tail))))))
+ (t `(progn
+ (for ,m-value = ,m-expr)
+ (cond
+ ((or (null ,min)
+ (< ,m-value ,min)) (setf ,result (list ,expr)
+ ,tail ,result
+ ,min ,m-value))
+ ((= ,m-value ,min) (setf (cdr ,tail) (cons ,expr nil)
+ ,tail (cdr ,tail)))))))))))
+
+(defmacro-clause (FINDING-ALL expr MAXIMIZING m-expr &optional INTO var)
+ "Collect all `expr`s maximizing `m-expr` into a list at `var`.
+
+ The partial list at `var` is available for inspection at any point in the loop.
+
+ If `m-expr` is a sharp-quoted function, then it is called on `expr` instead of
+ being evaluated and compared itself.
+
+ "
+ ;; TODO: result-type
+ (alexandria:with-gensyms (max value m-value tail)
+ (let ((result (or var iterate::*result-var*)))
+ `(progn
+ (with ,result = '())
+ (with ,tail = nil)
+ (with ,max = nil)
+ ,(typecase m-expr
+ ((cons (eql function) (cons t null))
+ `(progn
+ (for ,value = ,expr)
+ (for ,m-value = (funcall ,m-expr ,value))
+ (cond
+ ((or (null ,max)
+ (> ,m-value ,max)) (setf ,result (list ,value)
+ ,tail ,result
+ ,max ,m-value))
+ ((= ,m-value ,max) (setf (cdr ,tail) (cons ,value nil)
+ ,tail (cdr ,tail))))))
+ (t `(progn
+ (for ,m-value = ,m-expr)
+ (cond
+ ((or (null ,max)
+ (> ,m-value ,max)) (setf ,result (list ,expr)
+ ,tail ,result
+ ,max ,m-value))
+ ((= ,m-value ,max) (setf (cdr ,tail) (cons ,expr nil)
+ ,tail (cdr ,tail)))))))))))
+
+(defmacro-clause (FINDING-ALL expr SUCH-THAT test &optional INTO var RESULT-TYPE result-type)
+ "Collect all `expr`s for which `test` is true.
+
+ If `test` is a sharp-quoted function, then it is called on `expr` instead of
+ being evaluated and compared itself.
+
+ "
+ (let ((result (or var iterate::*result-var*)))
+ (typecase test
+ ((cons (eql function) (cons t null))
+ (alexandria:with-gensyms (value)
+ `(progn
+ (for ,value = ,expr)
+ (when (funcall ,test ,value)
+ (collect ,value :into ,result
+ ,@(when result-type `(:result-type ,result-type)))))))
+ (t `(when ,test
+ (collect ,expr :into ,result
+ ,@(when result-type `(:result-type ,result-type))))))))