Adding more utilities and organising code.

kutils-hash-tables.lisp

@@ -0,0 +1,108 @@
+(in-package #:kutils)
+
+;;; hash-table functions.
+
+
+(defun |#{-reader| (stream sub-char numarg)
+  (declare (ignore sub-char numarg))
+  (let ((m     (make-hash-table :test 'equal))
+	(k     nil)
+	(v     nil)
+	(key-p t))
+    (labels ((finalise-read (x)
+	       (reverse (concatenate 'string x)))
+	     (finalise-kv-pair ()
+	       (if key-p
+		   (unless (null k)
+		     (setq key-p nil
+			   k     (read-from-string (finalise-read k))))
+		   (unless (null v)
+		     (setq key-p t
+			   v     (read-from-string (finalise-read v)))
+		     (setf (gethash k m) v)
+		     (setq k nil v nil))))
+	     (reading-complete-p ()
+	       (and (null v)
+		    (not
+		     (null k)))))
+      (do ((prev (read-char stream) curr)
+	   (curr (read-char stream) (read-char stream)))
+	  ((and (char= prev #\}) (char= curr #\#)))
+	(if (char= prev #\Space)
+	    (finalise-kv-pair)
+	    (if key-p
+		(push prev k)
+		(push prev v))))
+      (if (reading-complete-p)
+	  (error "Mismatched key value pairs.")
+	  (progn 
+	    (finalise-kv-pair)
+	    m)))))
+
+(defun enable-hash-table-reader ()
+  "Enables the reader macro #{}# for hash-tables. The resulting
+hash-table will use #'equal for equality. For example,
+
+#{:a :b :c :d}#
+
+will create a hash-table with the keys :a and :c. :a stores the
+value :b, and :c stores the value :d.
+"
+  (set-dispatch-macro-character
+   #\# #\{ #'|#{-reader|))
+
+(defun sethash (k v m)
+  "Convenience notation for setting a value in a hash table."
+  (setf (gethash k m) v))
+
+(defun hashkeys (m)
+  "Returns a list of the keys in the hash table."
+  (let ((keys '()))
+    (maphash (lambda (k v)
+	       (declare (ignore v))
+	       (push k keys))
+	     m)
+    keys))
+
+(defun hash-table-to-alist (m)
+  "Converts the hash-table given to an alist of (key . value) pairs."
+  (let ((alist '()))
+    (maphash (lambda (k v)
+	       (let ((elt (cons k v)))
+		 (setf alist (cons elt alist))))
+	     m)
+    alist))
+
+(defun alist-to-hash-table (alist)
+  "Converts the alist to a hash-table."
+  (let ((m (make-hash-table :test 'equal)))
+    (dolist (elt alist)
+      (sethash (car elt) (cdr elt) m))
+    m))
+
+
+(defun copy-hash-table (ht)
+  (let ((copied (make-hash-table :equal #'equal)))
+    (maphash (lambda (k v)
+	       (sethash k v copied))
+	     ht)
+    copied))
+
+(defun new-hash-table ()
+  "Create a new hash table with the #'equal function as its test."
+  (make-hash-table :test #'equal))
+
+(defmacro with-new-hash-table (htsyms &body body)
+  "with-new-hash-table creates and binds a new hash table for each of
+the symbols in htsyms, executing inside a let form, and returns the
+hash table(s). If only one hash table is provided, return it as a
+single element; otherwise, return an alist of the symbol names and
+hash tables."
+  `(let ,(mapcar (lambda (sym)
+                   (list sym (list 'new-hash-table))) htsyms)
+     ,@body
+     ,(if (null (rest htsyms))
+	  (first htsyms)
+	  `(mapcar #'cons
+		  (mapcar #'mksymb (quote ,htsyms))
+		  (list ,@htsyms)))))

kutils.asd

@@ -9,5 +9,6 @@
   :components ((:file "package")
 	       (:file "on")
 	       (:file "lol")
-               (:file "kutils")))
+               (:file "kutils")
+               (:file "kutils-hash-tables")))
 

kutils.lisp

@@ -127,95 +127,28 @@ produces '((a 1) (b 2) (c 3))."
     (zip-acc lsts)))
 
 
-;;; hash-table functions.
+(defun read-file-string (path)
+  "Read the contents of the file at path as a string."
+  (with-open-file (s path)
+    (let ((data (make-string (file-length s))))
+      (read-sequence data s)
+      data)))
 
+(defun new-vector ()
+  "Create a new, empty, adjustable vector with fill pointer."
+  (make-array 0 :adjustable t :fill-pointer t))
 
-(defun |#{-reader| (stream sub-char numarg)
+(defmacro mapv (fn &rest vecs)
-  (declare (ignore sub-char numarg))
+  "Utility to map @c(fn) over the vectors @c(vecs), producing a vector."
-  (let ((m     (make-hash-table :test 'equal))
+  `(map 'vector ,fn ,@vecs))
-	(k     nil)
-	(v     nil)
-	(key-p t))
-    (labels ((finalise-read (x)
-	       (reverse (concatenate 'string x)))
-	     (finalise-kv-pair ()
-	       (if key-p
-		   (unless (null k)
-		     (setq key-p nil
-			   k     (read-from-string (finalise-read k))))
-		   (unless (null v)
-		     (setq key-p t
-			   v     (read-from-string (finalise-read v)))
-		     (setf (gethash k m) v)
-		     (setq k nil v nil))))
-	     (reading-complete-p ()
-	       (and (null v)
-		    (not
-		     (null k)))))
-      (do ((prev (read-char stream) curr)
-	   (curr (read-char stream) (read-char stream)))
-	  ((and (char= prev #\}) (char= curr #\#)))
-	(if (char= prev #\Space)
-	    (finalise-kv-pair)
-	    (if key-p
-		(push prev k)
-		(push prev v))))
-      (if (reading-complete-p)
-	  (error "Mismatched key value pairs.")
-	  (progn 
-	    (finalise-kv-pair)
-	    m)))))
     
-(defun enable-hash-table-reader ()
+(defun vectorise (lst)
-  "Enables the reader macro #{}# for hash-tables. The resulting
+  "Ensure @c(lst) is a vector."
-hash-table will use #'equal for equality. For example,
+  (cond ((listp lst) (apply #'vector lst))
+        ((vectorp lst) lst)
+        (otherwise (mapv #'identity lst))))
 
-#{:a :b :c :d}#
+(defmacro assoc-val (item alist &rest key-args)
-
+  "Return the value of @c(item) in @c(alist). @c(key-args) should
-will create a hash-table with the keys :a and :c. :a stores the
+contain any additional keyword arguments to @c(assoc)."
-value :b, and :c stores the value :d.
+  `(first (assoc ,item ,alist ,@key-args)))
-"
-  (set-dispatch-macro-character
-   #\# #\{ #'|#{-reader|))
-
-(defun sethash (k v m)
-  "Convenience notation for setting a value in a hash table."
-  (setf (gethash k m) v))
-
-(defun hashkeys (m)
-  "Returns a list of the keys in the hash table."
-  (let ((keys '()))
-    (maphash (lambda (k v)
-	       (declare (ignore v))
-	       (push k keys))
-	     m)
-    keys))
-
-(defun hash-table-to-alist (m)
-  "Converts the hash-table given to an alist of (key . value) pairs."
-  (let ((alist '()))
-    (maphash (lambda (k v)
-	       (let ((elt (cons k v)))
-		 (setf alist (cons elt alist))))
-	     m)
-    alist))
-
-(defun alist-to-hash-table (alist)
-  "Converts the alist to a hash-table."
-  (let ((m (make-hash-table :test 'equal)))
-    (dolist (elt alist)
-      (sethash (car elt) (cdr elt) m))
-    m))
-
-
-(defun copy-hash-table (ht)
-  (let ((copied (make-hash-table :equal #'equal)))
-    (maphash (lambda (k v)
-	       (sethash k v copied))
-	     ht)
-    copied))
-
-       ;; (defun ,ctor (&key ,@(append (inherited-slots supers)
-       ;; 				    slots))
-       ;; 	 (make-instance (find-class ,name t nil)
-       ;; 			,@(flatten (build-arg-list all-slots))))

package.lisp

@@ -2,13 +2,18 @@
 
 (defpackage #:kutils
   (:use #:cl)
-  (:export #:mkstr     ; On Lisp utilities
+  (:export ;; on.lisp : utilities from Graham's On Lisp.
+           #:mkstr
            #:symb
            #:group
            #:flatten
            #:compose
-           #:defmacro! ; Let Over Lambda utilities
+
-           #:interpose ; My utilities
+	   ;; lol.lisp : utilities from Let Over Lambda
+           #:defmacro!
+
+	   ;; kutils.lisp
+           #:interpose
            #:take
 	   #:drop
            #:build-list
@@ -18,9 +23,17 @@
            #:mkkw
            #:defclass!
            #:zip
+           #:new-vector
+           #:mapv
+           #:vectorise
+	   #:assoc-val
+
+	   ;; kutils-hash-tables.lisp
            #:enable-hash-table-reader
            #:hashkeys
            #:sethash
            #:hash-table-to-alist
            #:alist-to-hash-table
+	   #:new-hash-table
+	   #:with-new-hash-table
            ))