--- a/vendor/quickutils.lisp Sun Nov 20 17:35:34 2016 +0000
+++ b/vendor/quickutils.lisp Sun Nov 20 18:02:44 2016 +0000
@@ -2,7 +2,7 @@
;;;; See http://quickutil.org for details.
;;;; To regenerate:
-;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:CURRY :SUBDIVIDE :APPENDF :COMPOSE :DOHASH :ENSURE-BOOLEAN :ENSURE-GETHASH :ENSURE-LIST :HASH-TABLE-KEYS :MAPHASH-KEYS :MKSTR :ONCE-ONLY :RCURRY :REMOVEF :SYMB :WITH-GENSYMS) :ensure-package T :package "NREPL.QUICKUTILS")
+;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:CURRY :HASH-TABLE-KEYS :RCURRY :ALIST-PLIST :WITH-GENSYMS) :ensure-package T :package "NREPL.QUICKUTILS")
(eval-when (:compile-toplevel :load-toplevel :execute)
(unless (find-package "NREPL.QUICKUTILS")
@@ -14,11 +14,8 @@
(when (boundp '*utilities*)
(setf *utilities* (union *utilities* '(:MAKE-GENSYM-LIST :ENSURE-FUNCTION
- :CURRY :SUBDIVIDE :APPENDF :COMPOSE
- :DOHASH :ENSURE-BOOLEAN
- :ENSURE-GETHASH :ENSURE-LIST
- :MAPHASH-KEYS :HASH-TABLE-KEYS :MKSTR
- :ONCE-ONLY :RCURRY :REMOVEF :SYMB
+ :CURRY :MAPHASH-KEYS :HASH-TABLE-KEYS
+ :RCURRY :SAFE-ENDP :ALIST-PLIST
:STRING-DESIGNATOR :WITH-GENSYMS))))
(eval-when (:compile-toplevel :load-toplevel :execute)
(defun make-gensym-list (length &optional (x "G"))
@@ -64,95 +61,6 @@
(apply ,fun ,@curries more)))))
- (defun subdivide (sequence chunk-size)
- "Split `sequence` into subsequences of size `chunk-size`."
- (check-type sequence sequence)
- (check-type chunk-size (integer 1))
-
- (etypecase sequence
- ;; Since lists have O(N) access time, we iterate through manually,
- ;; collecting each chunk as we pass through it. Using SUBSEQ would
- ;; be O(N^2).
- (list (loop :while sequence
- :collect
- (loop :repeat chunk-size
- :while sequence
- :collect (pop sequence))))
-
- ;; For other sequences like strings or arrays, we can simply chunk
- ;; by repeated SUBSEQs.
- (sequence (loop :with len := (length sequence)
- :for i :below len :by chunk-size
- :collect (subseq sequence i (min len (+ chunk-size i)))))))
-
-
- (define-modify-macro appendf (&rest lists) append
- "Modify-macro for `append`. Appends `lists` to the place designated by the first
-argument.")
-
-
- (defun compose (function &rest more-functions)
- "Returns a function composed of `function` and `more-functions` that applies its ;
-arguments to to each in turn, starting from the rightmost of `more-functions`,
-and then calling the next one with the primary value of the last."
- (declare (optimize (speed 3) (safety 1) (debug 1)))
- (reduce (lambda (f g)
- (let ((f (ensure-function f))
- (g (ensure-function g)))
- (lambda (&rest arguments)
- (declare (dynamic-extent arguments))
- (funcall f (apply g arguments)))))
- more-functions
- :initial-value function))
-
- (define-compiler-macro compose (function &rest more-functions)
- (labels ((compose-1 (funs)
- (if (cdr funs)
- `(funcall ,(car funs) ,(compose-1 (cdr funs)))
- `(apply ,(car funs) arguments))))
- (let* ((args (cons function more-functions))
- (funs (make-gensym-list (length args) "COMPOSE")))
- `(let ,(loop for f in funs for arg in args
- collect `(,f (ensure-function ,arg)))
- (declare (optimize (speed 3) (safety 1) (debug 1)))
- (lambda (&rest arguments)
- (declare (dynamic-extent arguments))
- ,(compose-1 funs))))))
-
-
- (defmacro dohash ((key value table &optional result) &body body)
- "Iterate over the hash table `table`, executing `body`, with `key` and
- `value` bound to the keys and values of the hash table
- respectively. Return `result` from the iteration form."
- `(progn
- (maphash (lambda (,key ,value)
- ,@body)
- ,table)
- ,result))
-
-
- (defun ensure-boolean (x)
- "Convert `x` into a Boolean value."
- (and x t))
-
-
- (defmacro ensure-gethash (key hash-table &optional default)
- "Like `gethash`, but if `key` is not found in the `hash-table` saves the `default`
-under key before returning it. Secondary return value is true if key was
-already in the table."
- `(multiple-value-bind (value ok) (gethash ,key ,hash-table)
- (if ok
- (values value ok)
- (values (setf (gethash ,key ,hash-table) ,default) nil))))
-
-
- (defun ensure-list (list)
- "If `list` is a list, it is returned. Otherwise returns the list designated by `list`."
- (if (listp list)
- list
- (list list)))
-
-
(declaim (inline maphash-keys))
(defun maphash-keys (function table)
"Like `maphash`, but calls `function` with each key in the hash table `table`."
@@ -171,53 +79,6 @@
keys))
- (defun mkstr (&rest args)
- "Receives any number of objects (string, symbol, keyword, char, number), extracts all printed representations, and concatenates them all into one string.
-
-Extracted from _On Lisp_, chapter 4."
- (with-output-to-string (s)
- (dolist (a args) (princ a s))))
-
-
- (defmacro once-only (specs &body forms)
- "Evaluates `forms` with symbols specified in `specs` rebound to temporary
-variables, ensuring that each initform is evaluated only once.
-
-Each of `specs` must either be a symbol naming the variable to be rebound, or of
-the form:
-
- (symbol initform)
-
-Bare symbols in `specs` are equivalent to
-
- (symbol symbol)
-
-Example:
-
- (defmacro cons1 (x) (once-only (x) `(cons ,x ,x)))
- (let ((y 0)) (cons1 (incf y))) => (1 . 1)"
- (let ((gensyms (make-gensym-list (length specs) "ONCE-ONLY"))
- (names-and-forms (mapcar (lambda (spec)
- (etypecase spec
- (list
- (destructuring-bind (name form) spec
- (cons name form)))
- (symbol
- (cons spec spec))))
- specs)))
- ;; bind in user-macro
- `(let ,(mapcar (lambda (g n) (list g `(gensym ,(string (car n)))))
- gensyms names-and-forms)
- ;; bind in final expansion
- `(let (,,@(mapcar (lambda (g n)
- ``(,,g ,,(cdr n)))
- gensyms names-and-forms))
- ;; bind in user-macro
- ,(let ,(mapcar (lambda (n g) (list (car n) g))
- names-and-forms gensyms)
- ,@forms)))))
-
-
(defun rcurry (function &rest arguments)
"Returns a function that applies the arguments it is called
with and `arguments` to `function`."
@@ -228,23 +89,28 @@
(multiple-value-call fn (values-list more) (values-list arguments)))))
- (declaim (inline remove/swapped-arguments))
- (defun remove/swapped-arguments (sequence item &rest keyword-arguments)
- (apply #'remove item sequence keyword-arguments))
-
- (define-modify-macro removef (item &rest remove-keywords)
- remove/swapped-arguments
- "Modify-macro for `remove`. Sets place designated by the first argument to
-the result of calling `remove` with `item`, place, and the `keyword-arguments`.")
+ (declaim (inline safe-endp))
+ (defun safe-endp (x)
+ (declare (optimize safety))
+ (endp x))
- (defun symb (&rest args)
- "Receives any number of objects, concatenates all into one string with `#'mkstr` and converts them to symbol.
+ (defun alist-plist (alist)
+ "Returns a property list containing the same keys and values as the
+association list ALIST in the same order."
+ (let (plist)
+ (dolist (pair alist)
+ (push (car pair) plist)
+ (push (cdr pair) plist))
+ (nreverse plist)))
-Extracted from _On Lisp_, chapter 4.
-
-See also: `symbolicate`"
- (values (intern (apply #'mkstr args))))
+ (defun plist-alist (plist)
+ "Returns an association list containing the same keys and values as the
+property list PLIST in the same order."
+ (let (alist)
+ (do ((tail plist (cddr tail)))
+ ((safe-endp tail) (nreverse alist))
+ (push (cons (car tail) (cadr tail)) alist))))
(deftype string-designator ()
@@ -291,8 +157,7 @@
`(with-gensyms ,names ,@forms))
(eval-when (:compile-toplevel :load-toplevel :execute)
- (export '(curry subdivide appendf compose dohash ensure-boolean
- ensure-gethash ensure-list hash-table-keys maphash-keys mkstr
- once-only rcurry removef symb with-gensyms with-unique-names)))
+ (export '(curry hash-table-keys rcurry alist-plist plist-alist with-gensyms
+ with-unique-names)))
;;;; END OF quickutils.lisp ;;;;