--- a/DOCUMENTATION.markdown Mon Nov 09 21:51:32 2020 -0400
+++ b/DOCUMENTATION.markdown Tue Dec 22 20:05:01 2020 -0500
@@ -278,6 +278,7 @@
### `DEFUN-INLINE` (macro)
(DEFUN-INLINE NAME
+ ARGS
&BODY
BODY)
@@ -453,7 +454,7 @@
### `GATHERING-VECTOR` (macro)
- (GATHERING-VECTOR OPTIONS
+ (GATHERING-VECTOR (&KEY (SIZE 16) (ELEMENT-TYPE T))
&BODY
BODY)
@@ -845,6 +846,12 @@
+### `PHR` (function)
+
+ (PHR)
+
+Print a horizontal rule to aid in visual debugging.
+
### `PR` (function)
(PR &REST ARGS)
@@ -1433,6 +1440,42 @@
Utilities for operating on lists.
+### `0..` (function)
+
+ (0.. BELOW)
+
+Return a fresh list of the range `[0, below)`.
+
+### `0...` (function)
+
+ (0... TO)
+
+Return a fresh list of the range `[0, to]`.
+
+### `1..` (function)
+
+ (1.. BELOW)
+
+Return a fresh list of the range `[1, below)`.
+
+### `1...` (function)
+
+ (1... TO)
+
+Return a fresh list of the range `[1, to]`.
+
+### `N..` (function)
+
+ (N.. FROM BELOW)
+
+Return a fresh list of the range `[from, below)`.
+
+### `N...` (function)
+
+ (N... FROM TO)
+
+Return a fresh list of the range `[from, to]`.
+
### `SOMELIST` (function)
(SOMELIST PREDICATE LIST &REST MORE-LISTS)
@@ -1656,6 +1699,12 @@
Remainder `place` by `divisor` in-place.
+### `TRUNCATEF` (macro)
+
+ (TRUNCATEF PLACE DIVISOR)
+
+Truncate `place` by `divisor` in-place.
+
### `ZAPF` (macro)
(ZAPF &REST PLACE-EXPR-PAIRS)
@@ -1851,6 +1900,51 @@
Utilities for operating on sequences.
+### `DEFINE-SORTING-PREDICATE` (macro)
+
+ (DEFINE-SORTING-PREDICATE NAME PREDICATE-SPEC &REST MORE-PREDICATE-SPECS)
+
+Define `name` as a predicate that composes the given predicates.
+
+ This function takes one or more predicates and composes them into a single
+ predicate suitable for passing to `sort`. Earlier predicates will take
+ precedence over later ones — later predicates will only be called to break
+ ties for earlier predicates. This is useful if you want to do something like
+ "sort customers by last name, then by first name, then by ID number".
+
+ `predicate-spec` can be one of:
+
+ * `(function ...)`
+ * `(lambda ...)`
+ * A list of `(predicate &key key)`.
+ * Any other object, which will be treated as a predicate.
+
+ If a `key` is specified, it will be called on arguments before passing them to
+ `predicate`. Note that the `key` only affects the predicate it's consed to,
+ not later predicates.
+
+ See `make-sorting-predicate` for a functional version.
+
+ Examples:
+
+ ;; Sort shorter strings first, breaking ties lexicographically:
+ (define-sorting-predicate fancy<
+ (#< :key #'length)
+ #'string<)
+
+ (sort (list "zz" "abc" "yy") #'fancy<)
+ ; => ("yy" "zz" "abc")
+
+ ;; Sort customers by last name, then first name, then ID number:
+ (define-sorting-predicate customer<
+ (#string< :key #'last-name)
+ (#string< :key #'first-name)
+ (#< :key #'id))
+
+ (sort (find-customers) #'customer<)
+
+
+
### `DOSEQ` (macro)
(DOSEQ (VAR SEQUENCE)
@@ -1994,16 +2088,63 @@
+### `MAKE-SORTING-PREDICATE` (function)
+
+ (MAKE-SORTING-PREDICATE PREDICATE-SPEC &REST MORE-PREDICATE-SPECS)
+
+Compose the given predicates into a single predicate and return it.
+
+ This function takes one or more predicates and composes them into a single
+ predicate suitable for passing to `sort`. Earlier predicates will take
+ precedence over later ones — later predicates will only be called to break
+ ties for earlier predicates. This is useful if you want to do something like
+ "sort customers by last name, then by first name, then by ID number".
+
+ `predicate-spec` can be either a function or a cons of `(predicate . key)`,
+ in which case the key will be called on arguments before passing them to
+ `predicate`. Note that the `key` only affects the predicate it's consed to,
+ not later predicates.
+
+ See `define-sorting-predicate` for a convenient way to define named sorting
+ predicates.
+
+ Examples:
+
+ ;; Trivial example:
+ (sort (list "zz" "abc")
+ (make-sorting-predicate #'string<))
+ ; => ("abc" "zz")
+
+ ;; Sort shorter strings first, breaking ties lexicographically:
+ (sort (list "zz" "abc" "yy")
+ (make-sorting-predicate (cons #'< #'length) #'string<))
+ ; => ("yy" "zz" "abc")
+
+ ;; Sort customers by last name, then first name, then ID number:
+ (sort (find-customers)
+ (make-sorting-predicate
+ (cons #'string< #'last-name)
+ (cons #'string< #'first-name)
+ (cons #'< #'id)))
+
+
+
### `PREFIX-SUMS` (function)
- (PREFIX-SUMS SEQUENCE)
-
-Return a list of the prefix sums of the numbers in `sequence`.
+ (PREFIX-SUMS SEQUENCE &KEY KEY (RESULT-TYPE 'LIST))
+
+Return the prefix sums of the elements of `sequence`.
+
+ If `key` is given, it will be called on the elements before summing.
+ `result-type` must be a type suitable for passing to `map`.
Example:
(prefix-sums '(10 10 10 0 1))
- => (10 20 30 30 31)
+ ; => (10 20 30 30 31)
+
+ (prefix-sums "ABCD" :key #'char-code :result-type '(vector fixnum))
+ ; => #(65 131 198 266)
@@ -2073,11 +2214,7 @@
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.
+ All objects in `sequence` (and `separator`) will be `princ`ed before joining.
@@ -2099,13 +2236,13 @@
Examples:
- (sum #(1 2 3))
+ (summation #(1 2 3))
; => 6
- (sum '("1" "2" "3") :key #'parse-integer)
+ (summation '("1" "2" "3") :key #'parse-integer)
; => 6
- (sum '("1" "2" "3") :key #'length)
+ (summation '("1" "2" "3") :key #'length)
; => 3
@@ -2154,6 +2291,14 @@
Utilities for interacting with external programs.
+### `*PBCOPY-COMMAND*` (variable)
+
+The shell command to use for `pbcopy`. When run, this command should set the clipboard contents to its standard input.
+
+### `*PBPASTE-COMMAND*` (variable)
+
+The shell command to use for `pbpaste`. When run, this command should print the clipboard contents on standard output.
+
### `PBCOPY` (function)
(PBCOPY OBJECT)
--- a/losh.asd Mon Nov 09 21:51:32 2020 -0400
+++ b/losh.asd Tue Dec 22 20:05:01 2020 -0500
@@ -87,6 +87,7 @@
(:file "base")
(:file "arrays")
(:file "lists")
+ (:file "sequences")
(:file "control-flow"))))
:perform (asdf:test-op (op system)
--- a/package.lisp Mon Nov 09 21:51:32 2020 -0400
+++ b/package.lisp Tue Dec 22 20:05:01 2020 -0500
@@ -338,7 +338,9 @@
:summation
:product
:doseq
- :string-join))
+ :string-join
+ :define-sorting-predicate
+ :make-sorting-predicate))
(defpackage :losh.debugging
(:use :cl :iterate :losh.quickutils
--- a/src/sequences.lisp Mon Nov 09 21:51:32 2020 -0400
+++ b/src/sequences.lisp Tue Dec 22 20:05:01 2020 -0500
@@ -373,15 +373,155 @@
(defun 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.
+ All objects in `sequence` (and `separator`) will be `princ`ed before joining.
"
(unless (stringp separator)
(callf separator #'princ-to-string))
- (flet ((concat (current next)
- (concatenate 'string current separator next)))
- (reduce (nullary #'concat "") sequence :key #'princ-to-string)))
+ (with-output-to-string (s)
+ (let ((first t))
+ (map nil (lambda (el)
+ (if first
+ (setf first nil)
+ (write-string separator s))
+ (princ el s))
+ sequence))))
+
+
+(defun make-sorting-predicate (predicate-spec &rest more-predicate-specs)
+ "Compose the given predicates into a single predicate and return it.
+
+ This function takes one or more predicates and composes them into a single
+ predicate suitable for passing to `sort`. Earlier predicates will take
+ precedence over later ones — later predicates will only be called to break
+ ties for earlier predicates. This is useful if you want to do something like
+ \"sort customers by last name, then by first name, then by ID number\".
+
+ `predicate-spec` can be either a function or a cons of `(predicate . key)`,
+ in which case the key will be called on arguments before passing them to
+ `predicate`. Note that the `key` only affects the predicate it's consed to,
+ not later predicates.
+
+ See `define-sorting-predicate` for a convenient way to define named sorting
+ predicates.
+
+ Examples:
+
+ ;; Trivial example:
+ (sort (list \"zz\" \"abc\")
+ (make-sorting-predicate #'string<))
+ ; => (\"abc\" \"zz\")
+
+ ;; Sort shorter strings first, breaking ties lexicographically:
+ (sort (list \"zz\" \"abc\" \"yy\")
+ (make-sorting-predicate (cons #'< #'length) #'string<))
+ ; => (\"yy\" \"zz\" \"abc\")
+
+ ;; Sort customers by last name, then first name, then ID number:
+ (sort (find-customers)
+ (make-sorting-predicate
+ (cons #'string< #'last-name)
+ (cons #'string< #'first-name)
+ (cons #'< #'id)))
+
+ "
+ (let (predicate key)
+ (if (consp predicate-spec)
+ (setf predicate (car predicate-spec)
+ key (cdr predicate-spec))
+ (setf predicate predicate-spec
+ key nil))
+ (if (null more-predicate-specs)
+ (if key
+ (lambda (x y)
+ (funcall predicate (funcall key x) (funcall key y)))
+ predicate)
+ (let ((next (apply #'make-sorting-predicate more-predicate-specs)))
+ (if key
+ (lambda (x y)
+ (let ((kx (funcall key x))
+ (ky (funcall key y)))
+ (cond
+ ((funcall predicate kx ky) t)
+ ((funcall predicate ky kx) nil)
+ (t (funcall next x y)))))
+ (lambda (x y)
+ (cond
+ ((funcall predicate x y) t)
+ ((funcall predicate y x) nil)
+ (t (funcall next x y)))))))))
+
+(defmacro define-sorting-predicate (name predicate-spec &rest more-predicate-specs)
+ "Define `name` as a predicate that composes the given predicates.
+
+ This function takes one or more predicates and composes them into a single
+ predicate suitable for passing to `sort`. Earlier predicates will take
+ precedence over later ones — later predicates will only be called to break
+ ties for earlier predicates. This is useful if you want to do something like
+ \"sort customers by last name, then by first name, then by ID number\".
+
+ `predicate-spec` can be one of:
+
+ * `(function ...)`
+ * `(lambda ...)`
+ * A list of `(predicate &key key)`.
+ * Any other object, which will be treated as a predicate.
+
+ If a `key` is specified, it will be called on arguments before passing them to
+ `predicate`. Note that the `key` only affects the predicate it's consed to,
+ not later predicates.
+
+ See `make-sorting-predicate` for a functional version.
+
+ Examples:
+
+ ;; Sort shorter strings first, breaking ties lexicographically:
+ (define-sorting-predicate fancy<
+ (#\< :key #'length)
+ #'string<)
+
+ (sort (list \"zz\" \"abc\" \"yy\") #'fancy<)
+ ; => (\"yy\" \"zz\" \"abc\")
+
+ ;; Sort customers by last name, then first name, then ID number:
+ (define-sorting-predicate customer<
+ (#\string< :key #'last-name)
+ (#\string< :key #'first-name)
+ (#\< :key #'id))
+
+ (sort (find-customers) #'customer<)
+
+ "
+ (with-gensyms (x y kx ky)
+ (labels
+ ((parse-spec (spec)
+ (if (consp spec)
+ (if (member (first spec) '(function lambda))
+ (values spec nil)
+ (destructuring-bind (predicate &key key) spec
+ (values predicate key)))
+ (values spec nil)))
+ (expand (spec more-specs)
+ (multiple-value-bind (predicate key) (parse-spec spec)
+ (once-only (predicate)
+ (if (null more-specs)
+ `(if ,(if key
+ (once-only (key)
+ `(funcall ,predicate (funcall ,key ,x) (funcall ,key ,y)))
+ `(funcall ,predicate ,x ,y))
+ t
+ nil)
+ (if key
+ (once-only (key)
+ `(let ((,kx (funcall ,key ,x))
+ (,ky (funcall ,key ,y)))
+ (cond
+ ((funcall ,predicate ,kx ,ky) t)
+ ((funcall ,predicate ,ky ,kx) nil)
+ (t ,(expand (first more-specs) (rest more-specs))))))
+ `(cond
+ ((funcall ,predicate ,x ,y) t)
+ ((funcall ,predicate ,y ,x) nil)
+ (t ,(expand (first more-specs) (rest more-specs))))))))))
+ `(defun ,name (,x ,y)
+ ,(expand predicate-spec more-predicate-specs)))))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/test/sequences.lisp Tue Dec 22 20:05:01 2020 -0500
@@ -0,0 +1,86 @@
+(in-package :losh.test)
+
+
+(define-test make-sorting-predicate
+ (flet ((check (original expected &rest preds)
+ (let ((actual (sort (copy-seq original)
+ (apply #'make-sorting-predicate preds))))
+ (is (equalp expected actual)))))
+ (check '("zz" "yy" "abc")
+ '("abc" "yy" "zz")
+ #'string<)
+ (check '("zz" "yy" "abc")
+ '("yy" "zz" "abc")
+ (cons #'< #'length)
+ #'string<)
+ (check '("yy" "zz" "abc")
+ '("zz" "yy" "abc")
+ (cons #'< #'length)
+ #'string>)
+ (check '("az" "by" "aby" "zzy")
+ '("by" "aby" "zzy" "az")
+ (lambda (x y)
+ (char< (char x (1- (length x)))
+ (char y (1- (length y)))))
+ (cons #'< #'length)
+ #'string<)
+ (check '("az" "by" "aby" "zzy")
+ '("by" "aby" "zzy" "az")
+ (cons #'char< (lambda (s) (char s (1- (length s)))))
+ (cons #'< #'length)
+ #'string<)))
+
+
+(define-sorting-predicate sort-trivial<
+ #'string<)
+
+(define-sorting-predicate sort-short<
+ (#'< :key #'length)
+ #'string<)
+
+(define-sorting-predicate sort-short>
+ (#'< :key #'length)
+ #'string>)
+
+(define-sorting-predicate sort-last-char<
+ (lambda (x y)
+ (char< (char x (1- (length x)))
+ (char y (1- (length y)))))
+ (#'< :key #'length)
+ #'string<)
+
+(define-sorting-predicate sort-fancy<
+ (#'char< :key (lambda (s) (char s (1- (length s)))))
+ (#'< :key #'length)
+ #'string<)
+
+
+(define-test define-sorting-predicate
+ (flet ((check (original expected pred)
+ (let ((actual (sort (copy-seq original) pred)))
+ (is (equalp expected actual)))))
+ (check '("zz" "yy" "abc")
+ '("abc" "yy" "zz")
+ #'sort-trivial<)
+ (check '("zz" "yy" "abc")
+ '("yy" "zz" "abc")
+ #'sort-short<)
+ (check '("yy" "zz" "abc")
+ '("zz" "yy" "abc")
+ #'sort-short>)
+ (check '("az" "by" "aby" "zzy")
+ '("by" "aby" "zzy" "az")
+ #'sort-last-char<)
+ (check '("az" "by" "aby" "zzy")
+ '("by" "aby" "zzy" "az")
+ #'sort-fancy<)))
+
+
+(define-test string-join
+ (is (string= "" (string-join #\x '())))
+ (is (string= "A" (string-join #\x '(a))))
+ (is (string= "AxB" (string-join #\x '(a b))))
+ (is (string= "AxBxC" (string-join #\x '(a b c))))
+ (is (string= "A, B, C" (string-join ", " #(a b c))))
+ (is (string= "foo" (string-join #\space '("foo"))))
+ (is (string= "f o o" (string-join #\space "foo"))))