Documentation cleanups.

kutils-hash-tables.lisp

@@ -40,64 +40,52 @@
 	    m)))))
 
 (defun enable-hash-table-reader ()
-  "Enables the reader macro #{}# for hash-tables. The resulting
+  "Enables the reader macro @c(#{}#) for hash-tables. The resulting
-hash-table will use #'equal for equality. For example,
+hash-table will use @c(#'equal) for equality. For example,
 
+@begin[lang=lisp](code)
 #{:a :b :c :d}#
+@end(code)
 
-will create a hash-table with the keys :a and :c. :a stores the
+will create a hash-table with the keys @c(:a) and @c(:c); :@c(a)
-value :b, and :c stores the value :d.
+stores the value @c(:b), and @c(:c) stores the value @c(:d).
 "
   (set-dispatch-macro-character
    #\# #\{ #'|#{-reader|))
 
-(defun sethash (k v m)
+(defmacro sethash (k v ht)
   "Convenience notation for setting a value in a hash table."
-  (setf (gethash k m) v))
+  `(setf (gethash ,k ,ht) ,v))
 
-(defun hashkeys (m)
+(defun hashkeys (ht)
-  "Returns a list of the keys in the hash table."
+  "Returns a list of the keys in a hash table."
   (let ((keys '()))
     (maphash (lambda (k v)
 	       (declare (ignore v))
 	       (push k keys))
-	     m)
+	     ht)
     keys))
 
-(defun hash-table-to-alist (m)
+(defun hash-table-to-alist (ht)
-  "Converts the hash-table given to an alist of (key . value) pairs."
+  "Converts the hash-table argument to an alist of @c((key . value))
+pairs."
   (let ((alist '()))
     (maphash (lambda (k v)
 	       (let ((elt (cons k v)))
 		 (setf alist (cons elt alist))))
-	     m)
+	     ht)
     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."
+  "Create a new hash table with the @c(#'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
+  "Create and bind a new hash table for each of the symbols in @c(htsyms),
-the symbols in htsyms, executing inside a let form, and returns the
+executing inside a let form, and returns the hash table(s). If only
-hash table(s). If only one hash table is provided, return it as a
+one hash table is provided, return it as a single element; otherwise,
-single element; otherwise, return an alist of the symbol names and
+return an alist of the symbol names and hash tables."
-hash tables."
   `(let ,(mapcar (lambda (sym)
                    (list sym (list 'new-hash-table))) htsyms)
      ,@body
@@ -106,3 +94,17 @@ hash tables."
 	  `(mapcar #'cons
 		  (mapcar #'mksymb (quote ,htsyms))
 		  (list ,@htsyms)))))
+
+(defun alist-to-hash-table (alist)
+  "Converts the alist to a hash-table."
+  (with-new-hash-table (ht)
+    (dolist (elt alist)
+      (sethash (car elt) (cdr elt) ht))))
+
+(defun copy-hash-table (ht)
+  "Shallow copy @c(ht)."
+  (with-new-hash-table (copied)
+    (maphash (lambda (k v)
+	       (sethash k v copied))
+	     ht)))
+

kutils.lisp

@@ -71,53 +71,6 @@ additional args provided to the lambda."
   "Create a keyword from its arguments."
   (intern (string (apply #'mksymb args)) "KEYWORD"))
 
-(defun build-slot (class-name slot)
-  (let* ((slot-sym (mksymb slot))
-	 (accessor (mksymb class-name "-" slot-sym)))
-    (list slot-sym
-	  :initarg (mkkw slot-sym)
-	  :accessor accessor)))
-
-(defun build-slot-list (class-name &rest slots)
-  (mapcar (partial #'build-slot class-name) slots))
-
-(defun build-arg-list (slots)
-  (mapcar (lambda (slot) (list (mkkw slot) (mksymb slot))) slots))
-
-(defun inherited-slots (supers)
-  (mapcar #'closer-mop:slot-definition-name
-	  (flatten
-	   (mapcar #'closer-mop:class-slots
-		   (mapcar (lambda (cls) (find-class cls t nil)) supers)))))
-
-(defun superclasses (superclasses)
-  (mapcar #'class-name
-	  (mapcar (lambda (cls) (find-class cls t nil))
-		  superclasses)))
-
-(defmacro defclass! (name superclass-spec slots &body body)
-  "Defines a new class and default constructor for name, based on the
-superclasses and slots provided. If the first argument to body is a
-string, it will be used as the class's docstring."
-  (let* ((name (mksymb name))
-	 (docstring (if (stringp (first body))
-		      (list :documentation (first body))
-		      (list :documentation (format nil"Automatically generated class."))))
-	 (supers (superclasses superclass-spec))
-	 (body (if docstring (rest body) body))
-	 (ctor (mksymb "make-" name))
-	 (all-slots (flatten (append (inherited-slots supers) slots))))
-    (format t "supers: ~A~%" supers)
-    `(progn
-       (closer-mop:ensure-finalized
-	(defclass ,name ,supers
-	  ,(loop for slot in slots collecting
-		(list slot :initarg (mksymb slot)
-                      :accessor (mksymb name #\- slot)))
-	  ,docstring
-	  ,@body))
-       t)))
-
 (defun zip (&rest lsts)
   "Zip together elements from each list: (zip '(a b c) '(1 2 3))
 produces '((a 1) (b 2) (c 3))."
@@ -143,10 +96,24 @@ produces '((a 1) (b 2) (c 3))."
   `(map 'vector ,fn ,@vecs))
 
 (defun build-vector (arg)
-  "If @c(arg) is an atom, create a vector for it."
+  "If @c(arg) is an atom, return it as a list. If it's a list,
+coerce it to a vector. If it's a vector, return the
+vector. Otherwise, attempt to map it into a vector."
   (cond ((listp arg) (apply #'vector arg))
         ((vectorp arg) arg)
-        (otherwise (mapv #'identity arg))))
+	((atom arg)
+	 (let ((v (new-vector)))
+	   (vector-push-extend arg v)
+	   v))	
+        (t (mapv #'identity arg))))
+
+(defun extend-vector (v)
+  "Create a new vector from the contents of its argument where the
+new vector is adjustable and has a fill pointer set."
+  (make-array (length v)
+	      :adjustable t
+	      :initial-contents v
+	      :fill-pointer t))
 
 (defmacro assoc-val (item alist &rest key-args)
   "Return the value of @c(item) in @c(alist). @c(key-args) should

package.lisp

@@ -21,19 +21,20 @@
            #:macroexpand-n
            #:mksymb
            #:mkkw
-           #:defclass!
            #:zip
            #:new-vector
            #:mapv
            #:build-vector
+	   #:extend-vector
 	   #: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
+	   #:copy-hash-table
+           #:hash-table-to-alist
+           #:alist-to-hash-table
            ))