--- a/DOCUMENTATION.markdown Fri Aug 04 23:13:23 2017 -0400
+++ b/DOCUMENTATION.markdown Wed Aug 09 14:55:32 2017 -0400
@@ -547,7 +547,7 @@
### `BITS` (function)
- (BITS N SIZE &OPTIONAL (STREAM T))
+ (BITS &OPTIONAL (N *) (SIZE 8) (STREAM T))
Print the bits of the `size`-bit two's complement integer `n` to `stream`.
@@ -592,6 +592,22 @@
&BODY
BODY)
+### `HEX` (function)
+
+ (HEX &OPTIONAL (THING *) (STREAM T))
+
+Print the `thing` to `stream` with numbers in base 16.
+
+ Examples:
+
+ (hex 255)
+ => FF
+
+ (hex #(0 128))
+ => #(0 80)
+
+
+
### `PHT` (function)
(PHT HASH-TABLE &OPTIONAL (STREAM T))
@@ -909,7 +925,14 @@
### `COPY-HASH-SET` (function)
- (COPY-HASH-SET INSTANCE)
+ (COPY-HASH-SET HSET)
+
+Create a (shallow) copy of the given hash set.
+
+ Only the storage for the hash set itself will be copied -- the elements
+ themselves will not be copied.
+
+
### `HASH-SET` (struct)
--- a/losh.lisp Fri Aug 04 23:13:23 2017 -0400
+++ b/losh.lisp Wed Aug 09 14:55:32 2017 -0400
@@ -1440,7 +1440,8 @@
(defmacro-clause (FOR delta-vars WITHIN-RADIUS radius &optional
- SKIP-ORIGIN should-skip-origin)
+ SKIP-ORIGIN should-skip-origin
+ ORIGIN origin)
"Iterate through a number of delta values within a given radius.
Imagine you have a 2D array and you want to find all the neighbors of a given
@@ -1486,19 +1487,29 @@
; the point it is works in arbitrary dimensions.
"
- (with-gensyms (r -r control skip)
- `(progn
- (with ,r = ,radius)
- (with ,-r = (- ,r))
- (with ,skip = ,should-skip-origin)
- (generate-nested ,(iterate (for var :in (ensure-list delta-vars))
- (collect `(,var :from ,-r :to ,r)))
- :control-var ,control)
- (next ,control)
- (when (and ,skip
- ,@(iterate (for var :in (ensure-list delta-vars))
- (collect `(zerop ,var))))
- (next ,control)))))
+ (let* ((delta-vars (ensure-list delta-vars))
+ (origin-vars (mapcar (lambda (dv) (gensym (mkstr 'origin- dv)))
+ delta-vars))
+ (origin-vals (if (null origin)
+ (mapcar (constantly 0) delta-vars)
+ origin)))
+ (with-gensyms (r -r control skip)
+ `(progn
+ (with ,r = ,radius)
+ ,@(mapcar (lambda (ovar oval)
+ `(with ,ovar = ,oval))
+ origin-vars origin-vals)
+ (generate-nested ,(iterate (for var :in delta-vars)
+ (for orig :in origin-vars)
+ (collect `(,var :from (- ,orig ,r) :to (+ ,orig ,r))))
+ :control-var ,control)
+ (next ,control)
+ ,@(unless (null should-skip-origin)
+ `((with ,skip = ,should-skip-origin)
+ (when (and ,skip
+ ,@(iterate (for var :in (ensure-list delta-vars))
+ (collect `(zerop ,var))))
+ (next ,control))))))))
(defmacro-driver (FOR var EVERY-NTH n DO form)
@@ -1580,11 +1591,11 @@
(defmacro-clause (ORING expr &optional INTO var)
(let ((result (or var iterate::*result-var*)))
- `(reducing ,expr :by #'or :into ,var :initial-value nil)))
+ `(reducing ,expr :by #'or :into ,result :initial-value nil)))
(defmacro-clause (ANDING expr &optional INTO var)
(let ((result (or var iterate::*result-var*)))
- `(reducing ,expr :by #'and :into ,var :initial-value t)))
+ `(reducing ,expr :by #'and :into ,result :initial-value t)))
(defun keywordize-clause (clause)
@@ -1962,7 +1973,7 @@
(finish-output)))
-(defun bits (n size &optional (stream t))
+(defun bits (&optional (n *) (size 8) (stream t))
"Print the bits of the `size`-bit two's complement integer `n` to `stream`.
Examples:
@@ -1975,8 +1986,25 @@
"
;; http://blog.chaitanyagupta.com/2013/10/print-bit-representation-of-signed.html
- (format stream (format nil "~~~D,'0B" size) (ldb (byte size 0) n))
- (values))
+ (format stream (format nil "~~~D,'0B" size) (ldb (byte size 0) n)))
+
+(defun hex (&optional (thing *) (stream t))
+ "Print the `thing` to `stream` with numbers in base 16.
+
+ Examples:
+
+ (hex 255)
+ => FF
+
+ (hex #(0 128))
+ => #(0 80)
+
+ "
+ (let ((*print-base* 16))
+ (case stream
+ ((nil) (prin1-to-string thing))
+ ((t) (prin1 thing stream) (terpri stream) nil)
+ (otherwise (prin1 thing stream) (terpri stream) nil))))
(defmacro shut-up (&body body)
"Run `body` with stdout and stderr redirected to the void."
@@ -2298,7 +2326,8 @@
;;;; Hash Sets ----------------------------------------------------------------
-(defstruct (hash-set (:constructor make-hash-set%))
+(defstruct (hash-set (:constructor make-hash-set%)
+ (:copier nil))
(storage (error "Required") :type hash-table :read-only t))
(defmethod print-object ((hset hash-set) stream)
--- a/vendor/quickutils.lisp Fri Aug 04 23:13:23 2017 -0400
+++ b/vendor/quickutils.lisp Wed Aug 09 14:55:32 2017 -0400
@@ -2,7 +2,7 @@
;;;; See http://quickutil.org for details.
;;;; To regenerate:
-;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :COPY-HASH-TABLE :CURRY :EMPTYP :ENSURE-KEYWORD :ENSURE-LIST :FLATTEN :HASH-TABLE-KEYS :HASH-TABLE-VALUES :MAP-TREE :MKSTR :ONCE-ONLY :RANGE :RCURRY :SYMB :WEAVE :WITH-GENSYMS) :ensure-package T :package "LOSH.QUICKUTILS")
+;;;; (qtlc:save-utils-as "quickutils.lisp" :utilities '(:COMPOSE :COPY-HASH-TABLE :CURRY :EMPTYP :ENSURE-KEYWORD :ENSURE-LIST :FLATTEN :HASH-TABLE-ALIST :HASH-TABLE-KEYS :HASH-TABLE-VALUES :MAP-TREE :MKSTR :ONCE-ONLY :RANGE :RCURRY :SYMB :WEAVE :WITH-GENSYMS) :ensure-package T :package "LOSH.QUICKUTILS")
(eval-when (:compile-toplevel :load-toplevel :execute)
(unless (find-package "LOSH.QUICKUTILS")
@@ -16,7 +16,8 @@
(setf *utilities* (union *utilities* '(:MAKE-GENSYM-LIST :ENSURE-FUNCTION
:COMPOSE :COPY-HASH-TABLE :CURRY
:NON-ZERO-P :EMPTYP :ENSURE-KEYWORD
- :ENSURE-LIST :FLATTEN :MAPHASH-KEYS
+ :ENSURE-LIST :FLATTEN
+ :HASH-TABLE-ALIST :MAPHASH-KEYS
:HASH-TABLE-KEYS :MAPHASH-VALUES
:HASH-TABLE-VALUES :MAP-TREE :MKSTR
:ONCE-ONLY :RANGE :RCURRY :SYMB :WEAVE
@@ -152,6 +153,16 @@
(rec xs nil)))
+ (defun hash-table-alist (table)
+ "Returns an association list containing the keys and values of hash table
+`table`."
+ (let ((alist nil))
+ (maphash (lambda (k v)
+ (push (cons k v) alist))
+ table)
+ alist))
+
+
(declaim (inline maphash-keys))
(defun maphash-keys (function table)
"Like `maphash`, but calls `function` with each key in the hash table `table`."
@@ -326,7 +337,8 @@
(eval-when (:compile-toplevel :load-toplevel :execute)
(export '(compose copy-hash-table curry emptyp ensure-keyword ensure-list
- flatten hash-table-keys hash-table-values map-tree mkstr once-only
- range rcurry symb weave with-gensyms with-unique-names)))
+ flatten hash-table-alist hash-table-keys hash-table-values map-tree
+ mkstr once-only range rcurry symb weave with-gensyms
+ with-unique-names)))
;;;; END OF quickutils.lisp ;;;;