# HG changeset patch # User Steve Losh # Date 1479664964 0 # Node ID c8a2b5ade9f88c213c014d818549c73bf55af584 # Parent ca726222b6f10efd68cf4630592e0cabdc44dbc9 Fix quickutil fuckery diff -r ca726222b6f1 -r c8a2b5ade9f8 src/utils.lisp --- a/src/utils.lisp Sun Nov 20 17:35:34 2016 +0000 +++ b/src/utils.lisp Sun Nov 20 18:02:44 2016 +0000 @@ -4,20 +4,16 @@ (defun make-map (&rest keyvals) - "Create an fset map of the given riffle of keys and values." - (fset:convert 'fset:map (subdivide keyvals 2))) + "Create an fset map of the `keyvals` plist of keys and values." + (fset:convert 'fset:map (plist-alist keyvals) + :from-type 'alist)) (defun with-when (map &rest keyvals) - "Add the items in the `keyvals` riffle with non-nil values to `map`." - (labels ((build (map keyvals) - (if (null keyvals) - map - (destructuring-bind (k v &rest remaining) keyvals - (build (if v - (fset:with map k v) - map) - remaining))))) - (build map keyvals))) + "Add the items in the `keyvals` plist with non-nil values to `map`." + (reduce (lambda (map kv) + (fset:with map (car kv) (cdr kv))) + (remove-if #'null (plist-alist keyvals) :key #'cdr) + :initial-value map)) (defun read-all-from-string (s) "Read all forms in `s` and return them as a list." diff -r ca726222b6f1 -r c8a2b5ade9f8 vendor/make-quickutils.lisp --- a/vendor/make-quickutils.lisp Sun Nov 20 17:35:34 2016 +0000 +++ b/vendor/make-quickutils.lisp Sun Nov 20 18:02:44 2016 +0000 @@ -7,7 +7,7 @@ :curry :hash-table-keys :rcurry - :subdivide + :alist-plist :with-gensyms ) diff -r ca726222b6f1 -r c8a2b5ade9f8 vendor/quickutils.lisp --- 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 ;;;;