--- a/package.lisp Wed Dec 11 18:52:54 2019 -0500
+++ b/package.lisp Sun Dec 15 13:12:24 2019 -0500
@@ -28,7 +28,8 @@
(:use :cl :iterate :losh.quickutils)
(:documentation "Utilities for working with CLOS.")
(:export
- :defclass*))
+ :defclass*
+ :define-condition*))
(defpackage :losh.eldritch-horrors
(:use :cl :iterate :losh.quickutils)
--- a/src/clos.lisp Wed Dec 11 18:52:54 2019 -0500
+++ b/src/clos.lisp Sun Dec 15 13:12:24 2019 -0500
@@ -25,6 +25,9 @@
This is like `defclass`, but the `:initarg` and `:accessor` slot options will
automatically be filled in with sane values if they aren't given.
+ `name-and-options` can be a symbol or a list, which will be destructured
+ against `(name &key conc-name)`.
+
"
(destructuring-bind (name &key conc-name)
(ensure-list name-and-options)
@@ -32,3 +35,19 @@
,(mapcar (curry #'build-slot-definition conc-name) slots)
,@options)))
+(defmacro define-condition* (name-and-options direct-superclasses slots &rest options)
+ "`define-condition` without the tedium.
+
+ This is like `define-condition`, but the `:initarg` and `:accessor` slot
+ options will automatically be filled in with sane values if they aren't given.
+
+ `name-and-options` can be a symbol or a list, which will be destructured
+ against `(name &key conc-name)`.
+
+ "
+ (destructuring-bind (name &key conc-name)
+ (ensure-list name-and-options)
+ `(define-condition ,name ,direct-superclasses
+ ,(mapcar (curry #'build-slot-definition conc-name) slots)
+ ,@options)))
+
--- a/src/control-flow.lisp Wed Dec 11 18:52:54 2019 -0500
+++ b/src/control-flow.lisp Sun Dec 15 13:12:24 2019 -0500
@@ -440,20 +440,23 @@
iteration `body` will be executed with `variable` bound to successive values
in the range [`from`, `below`).
+ `from` can be larger than `below`, in which case the values will be stepped
+ down instead of up.
+
If multiple ranges are given they will be iterated in a nested fashion.
Example:
- (do-range ((x 0 3)
- (y 10 12))
+ (do-range ((x 0 6 2)
+ (y 12 10))
(pr x y))
; =>
- ; 0 10
+ ; 0 12
; 0 11
- ; 1 10
- ; 1 11
- ; 2 10
+ ; 2 12
; 2 11
+ ; 4 12
+ ; 4 11
"
(assert (not (null ranges)) ()
@@ -461,32 +464,41 @@
(recursively ((ranges ranges))
(if (null ranges)
`(progn ,@body)
- (destructuring-bind (var from below) (first ranges)
- `(loop
- :for ,var :from ,from :below ,below
- :do ,(recur (rest ranges)))))))
+ (destructuring-bind (var from to &optional by) (first ranges)
+ (with-gensyms (cmp)
+ (once-only (from to by)
+ `(do ((,cmp (if ,by
+ (if (minusp ,by) #'<= #'>=)
+ (if (< ,from ,to) #'>= #'<=)))
+ (,by (or ,by (if (< ,from ,to) 1 -1)))
+ (,var ,from (+ ,var ,by)))
+ ((funcall ,cmp ,var ,to))
+ ,(recur (rest ranges)))))))))
(defmacro 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`].
+ Each range in `ranges` should be of the form `(variable from to &optional by)`.
+ During iteration `body` will be executed with `variable` bound to successive
+ values according to `by` in the range [`from`, `to`].
+
+ `from` can be larger than `to`, in which case the values will be stepped down
+ instead of up.
If multiple ranges are given they will be iterated in a nested fashion.
Example:
- (do-irange ((x 0 2)
- (y 10 11))
+ (do-irange ((x 0 4 2)
+ (y 11 10))
(pr x y))
; =>
+ ; 0 11
; 0 10
- ; 0 11
- ; 1 10
- ; 1 11
+ ; 2 11
; 2 10
- ; 2 11
+ ; 4 11
+ ; 4 10
"
(assert (not (null ranges)) ()
@@ -494,9 +506,15 @@
(recursively ((ranges ranges))
(if (null ranges)
`(progn ,@body)
- (destructuring-bind (var from to) (first ranges)
- `(loop
- :for ,var :from ,from :to ,to
- :do ,(recur (rest ranges)))))))
+ (destructuring-bind (var from to &optional by) (first ranges)
+ (with-gensyms (cmp)
+ (once-only (from to by)
+ `(do ((,cmp (if ,by
+ (if (minusp ,by) #'< #'>)
+ (if (< ,from ,to) #'> #'<)))
+ (,by (or ,by (if (< ,from ,to) 1 -1)))
+ (,var ,from (+ ,var ,by)))
+ ((funcall ,cmp ,var ,to))
+ ,(recur (rest ranges)))))))))
--- a/src/iterate.lisp Wed Dec 11 18:52:54 2019 -0500
+++ b/src/iterate.lisp Sun Dec 15 13:12:24 2019 -0500
@@ -957,6 +957,7 @@
:next
(multiple-value-bind (,start% ,end% ,@(unless single `(,reg-start% ,reg-end%)))
(ppcre:scan ,scanner% ,string% :start ,pos% :end ,limit%)
+ (declare (ignorable ,end%))
(if (null ,start%)
(terminate)
(progn (setf ,pos% ,(if overlap? `(1+ ,start%) end%))
--- a/src/sequences.lisp Wed Dec 11 18:52:54 2019 -0500
+++ b/src/sequences.lisp Sun Dec 15 13:12:24 2019 -0500
@@ -23,8 +23,11 @@
(sum i :into s)
(collect s)))
-(defun frequencies (sequence &key (test 'eql))
- "Return a hash table containing the frequencies of the items in `sequence`.
+(defun frequencies (sequence &key (test #'eql) key)
+ "Return a hash table containing the frequencies of the elements of `sequence`.
+
+ When `key` is given, it will be called on the elements first before they are
+ counted.
Uses `test` for the `:test` of the hash table.
@@ -35,12 +38,18 @@
bar 1}
"
- (iterate (for i :in-whatever sequence)
- (collect-frequencies i)))
+ (if key
+ (iterate (for i :in-whatever sequence)
+ (collect-frequencies (funcall key i) :test test))
+ (iterate (for i :in-whatever sequence)
+ (collect-frequencies i :test test))))
-(defun proportions (sequence &key (test 'eql) (float t))
+(defun proportions (sequence &key (test 'eql) (float t) key)
"Return a hash table containing the proportions of the items in `sequence`.
+ When `key` is given, it will be called on the elements first before they are
+ counted.
+
Uses `test` for the `:test` of the hash table.
If `float` is `t` the hash table values will be coerced to floats, otherwise
@@ -57,7 +66,7 @@
bar 1/3}
"
- (let* ((freqs (frequencies sequence :test test))
+ (let* ((freqs (frequencies sequence :test test :key key))
(total (reduce #'+ (hash-table-values freqs)
:initial-value (if float 1.0 1))))
(mutate-hash-values (lambda (v) (/ v total))