From: Kevin M. Rosenberg <kevin@rosenberg.net>
Date: Mon, 28 Apr 2003 23:51:59 +0000 (+0000)
Subject: r4666: *** empty log message ***
X-Git-Tag: v1.96~262
X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=commitdiff_plain;h=4de7f25a69c218303f170314ac26217770a531ed

r4666: *** empty log message ***
---

diff --git a/attrib-class.lisp b/attrib-class.lisp
index 0b837ad..1c15e34 100644
--- a/attrib-class.lisp
+++ b/attrib-class.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: attrib-class.lisp,v 1.5 2003/04/28 21:12:27 kevin Exp $
+;;;; $Id: attrib-class.lisp,v 1.6 2003/04/28 23:51:59 kevin Exp $
 ;;;;
 ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -21,70 +21,64 @@
 
 (in-package :kmrcl)
 
-(defclass attributes-dsd (standard-direct-slot-definition)
-  ((attributes :initarg :attributes :initform nil 
-	       :accessor attributes)))
+(defclass attributes-dsd (kmr-mop:standard-direct-slot-definition)
+  ((attributes :initarg :attributes :initform nil
+	       :accessor dsd-attributes)))
 
-(defclass attributes-esd (standard-effective-slot-definition)
+(defclass attributes-esd (kmr-mop:standard-effective-slot-definition)
   ((attributes :initarg :attributes :initform nil 
-	       :accessor slot-definition-attributes)))
+	       :accessor esd-attributes)))
 
 
-(defclass attributes-class (standard-class)
+(defclass attributes-class (kmr-mop:standard-class)
   ()
-  )
+  (:documentation "metaclass that implements attributes on slots. Based
+on example from AMOP"))
+
 
 #+(or cmu scl sbcl)
-(defmethod validate-superclass ((class attributes-class)
-				(superclass standard-class))
+(defmethod kmr-mop:validate-superclass ((class attributes-class)
+					(superclass kmr-mop:standard-class))
   t)
 
-(defmethod direct-slot-definition-class ((cl attributes-class) 
-					      &rest iargs &key attributes)
-  (declare (ignorable attributes))
-;;  (format t "attributes:~s iargs:~s~%" attributes iargs)
-  (find-class 'attributes-dsd))
+(defmethod kmr-mop:direct-slot-definition-class ((cl attributes-class) 
+						 &rest iargs &key attributes)
+  (declare (ignore attributes))
+  ;;  (format t "attributes:~s iargs:~s~%" attributes iargs)
+  (kmr-mop:find-class 'attributes-dsd))
 
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (when (>= (length (generic-function-lambda-list
-		     (ensure-generic-function
-		      'compute-effective-slot-definition)))
-	    3)
-    (push :ho-named-cesd-fun cl:*features*)))
-
-(defmethod compute-effective-slot-definition :around
-    ((cl attributes-class) #+ho-named-cesd-fun name dsds)
-  #+ho-named-cesd-fun (declare (ignore name))
+(defmethod kmr-mop:compute-effective-slot-definition :around
+    ((cl attributes-class) #+kmr-named-cesd name dsds)
+  #+kmr-named-cesd (declare (ignore name))
   (apply
    #'make-instance 'attributes-esd 
-   :attributes (remove-duplicates (mapappend #'attributes dsds))
-   (compute-effective-slot-definition-initargs cl dsds))
+   :attributes (remove-duplicates (mapappend #'dsd-attributes dsds))
+   (kmr-mop:compute-effective-slot-definition-initargs cl dsds))
   )
 
-
 #+ignore
-(defmethod compute-effective-slot-definition :around
-    ((cl attributes-class) #+ho-named-cesd-fun name dsds)
-  #+ho-named-cesd-fun (declare (ignore name))
+(defmethod kmr-mop:compute-effective-slot-definition :around
+    ((cl attributes-class) #+kmr-named-cesd name dsds)
+  #+kmr-named-cesd (declare (ignore name))
   (let ((normal-slot (call-next-method)))
-    (setf (slot-definition-attributes normal-slot)
+    (setf (esd-attributes normal-slot)
       (remove-duplicates
-       (mapappend #'slot-definition-attributes dsds)))
+       (mapappend #'esd-attributes dsds)))
     normal-slot))
 
 
-(defmethod compute-slots ((class attributes-class))
+(defmethod kmr-mop:compute-slots ((class attributes-class))
   (let* ((normal-slots (call-next-method))
 	 (alist
 	  (mapcar
 	   #'(lambda (slot)
 	       (let ((attr-list (mapcar #'(lambda (attr) (cons attr nil))
-					(slot-definition-attributes slot))))
+					(esd-attributes slot))))
 		 (when attr-list
-		   (cons (mop::slot-definition-name slot) attr-list))))
+		   (cons (kmr-mop:slot-definition-name slot) attr-list))))
 	   normal-slots)))
     (setq alist (delete nil alist))
-    (cons (mop::make-instance 'mop::standard-effective-slot-definition
+    (cons (make-instance 'kmr-mop:standard-effective-slot-definition
 	    :name 'all-attributes
 	    :initform `',alist
 	    :initfunction #'(lambda () alist))
@@ -109,4 +103,6 @@
 	       slot-name instance attribute))
       attr-bucket)))
 
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (export '(attributes-class slot-attributes)))
 
diff --git a/cl-symbols.lisp b/cl-symbols.lisp
deleted file mode 100644
index ab709f6..0000000
--- a/cl-symbols.lisp
+++ /dev/null
@@ -1,72 +0,0 @@
-;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name:          cl-symbols.lisp
-;;;; Purpose:       Returns all defined Common Lisp symbols
-;;;; Programmer:    Kevin M. Rosenberg
-;;;; Date Started:  Apr 2000
-;;;;
-;;;; $Id: cl-symbols.lisp,v 1.5 2002/12/15 17:10:50 kevin Exp $
-;;;;
-;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
-;;;;
-;;;; KMRCL users are granted the rights to distribute and use this software
-;;;; as governed by the terms of the Lisp Lesser GNU Public License
-;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
-;;;; *************************************************************************
-
-(in-package :kmrcl)
-
-(defun cl-symbols ()
-  (append (cl-variables) (cl-functions)))
-
-(defun cl-variables ()
-  (let ((vars '()))
-    (do-symbols (s 'common-lisp)
-      (multiple-value-bind (sym status)
-	  (find-symbol (symbol-name s) 'common-lisp)
-	(when (and (or (eq status :external)
-		       (eq status :internal))
-		   (boundp sym))
-	  (push sym vars))))
-    (nreverse vars)))
-
-(defun cl-functions ()
-  (let ((funcs '()))
-    (do-symbols (s 'common-lisp)
-      (multiple-value-bind (sym status)
-	(find-symbol (symbol-name s) 'common-lisp)
-	(when (and (or (eq status :external)
-		       (eq status :internal))
-		   (fboundp sym))
-	  (push sym funcs))))
-    (nreverse funcs)))
-
-;;; Symbol functions
-
-(defun concat-symbol-pkg (pkg &rest args)
-  (declare (dynamic-extent args))
-  (flet ((stringify (arg)
-           (etypecase arg
-             (string
-              (string-upcase arg))
-             (symbol
-              (symbol-name arg)))))
-    (let ((str (apply #'concatenate 'string (mapcar #'stringify args))))
-      (intern #-case-sensitive (string-upcase str)
-	      #+case-sensitive str
-	      (if pkg pkg *package*)))))
-
-
-(defun concat-symbol (&rest args)
-  (apply #'concat-symbol-pkg nil args))
-
-(defun ensure-keyword (name)
-  "Returns keyword for a name"
-  (etypecase name
-    (keyword name)
-    (string (intern #-case-sensitive (string-upcase name)
-		    #+case-sensitive name
-		    :keyword))
-    (symbol (intern (symbol-name name) :keyword))))
diff --git a/datetime.lisp b/datetime.lisp
index 9d20449..b8d3267 100644
--- a/datetime.lisp
+++ b/datetime.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: datetime.lisp,v 1.1 2003/04/28 21:12:27 kevin Exp $
+;;;; $Id: datetime.lisp,v 1.2 2003/04/28 23:51:59 kevin Exp $
 ;;;;
 ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -47,3 +47,24 @@
 		(1- mon)
 		year
 		hr min sec))))
+
+(defun print-seconds (secs)
+  (print-float-units secs "sec"))
+
+(defun print-float-units (val unit)
+  (cond
+    ((< val 1d-6)
+     (format t "~,2,9F nano~A" val unit))
+    ((< val 1d-3)
+     (format t "~,2,6F micro~A" val unit))
+    ((< val 1)
+     (format t "~,2,3F milli~A" val unit))
+    ((> val 1d9)
+     (format t "~,2,-9F giga~A" val unit))
+    ((> val 1d6)
+     (format t "~,2,-6F mega~A" val unit))
+    ((> val 1d3)
+     (format t "~,2,-3F kilo~A" val unit))
+    (t
+     (format t "~,2F ~A" val unit))))
+
diff --git a/debian/changelog b/debian/changelog
index e8165ab..075394f 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,6 +1,7 @@
 cl-kmrcl (1.31-1) unstable; urgency=low
 
   * New upstream
+  * Add kmr-mop package
   * Add tests suite, add cl-rt to depends
   * Use compat file rather than DH_COMPAT variable
 
diff --git a/functions.lisp b/functions.lisp
new file mode 100644
index 0000000..ffc8ac6
--- /dev/null
+++ b/functions.lisp
@@ -0,0 +1,54 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          functions.lisp
+;;;; Purpose:       Function routines for KMRCL package
+;;;; Programmer:    Kevin M. Rosenberg
+;;;; Date Started:  Apr 2000
+;;;;
+;;;; $Id: functions.lisp,v 1.1 2003/04/28 23:51:59 kevin Exp $
+;;;;
+;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;;
+;;;; KMRCL users are granted the rights to distribute and use this software
+;;;; as governed by the terms of the Lisp Lesser GNU Public License
+;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+;;;; *************************************************************************
+
+(in-package :kmrcl)
+
+(defun memo-proc (fn)
+  "Memoize results of call to fn, returns a closure with hash-table"
+  (let ((cache (make-hash-table :test #'equal)))
+    #'(lambda (&rest args)
+        (multiple-value-bind (val foundp) (gethash args cache)
+          (if foundp
+              val
+              (setf (gethash args cache) 
+                    (apply fn args)))))))
+
+(defun memoize (fn-name)
+  (setf (fdefinition fn-name) (memo-proc (fdefinition fn-name))))
+
+(defmacro defun-memo (fn args &body body)
+  "Define a memoized function"
+  `(memoize (defun ,fn ,args . ,body)))
+
+(defmacro _f (op place &rest args)
+  (multiple-value-bind (vars forms var set access) 
+                       (get-setf-expansion place)
+    `(let* (,@(mapcar #'list vars forms)
+            (,(car var) (,op ,access ,@args)))
+       ,set)))
+
+(defun compose (&rest fns)
+  (if fns
+      (let ((fn1 (car (last fns)))
+            (fns (butlast fns)))
+        #'(lambda (&rest args)
+            (reduce #'funcall fns 
+                    :from-end t
+                    :initial-value (apply fn1 args))))
+      #'identity))
+
diff --git a/genutils.lisp b/genutils.lisp
deleted file mode 100644
index cbd78f1..0000000
--- a/genutils.lisp
+++ /dev/null
@@ -1,529 +0,0 @@
-;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; Name:          gentils.lisp
-;;;; Purpose:       Main general utility functions for KMRCL package
-;;;; Programmer:    Kevin M. Rosenberg
-;;;; Date Started:  Apr 2000
-;;;;
-;;;; $Id: genutils.lisp,v 1.16 2003/04/28 21:12:27 kevin Exp $
-;;;;
-;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
-;;;;
-;;;; KMRCL users are granted the rights to distribute and use this software
-;;;; as governed by the terms of the Lisp Lesser GNU Public License
-;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
-;;;; *************************************************************************
-
-
-(in-package :kmrcl)
-
-(defmacro let-when ((var test-form) &body body)
-  `(let ((,var ,test-form))
-      (when ,var ,@body)))
-  
-(defmacro let-if ((var test-form) if-true &optional if-false)
-  `(let ((,var ,test-form))
-      (if ,var ,if-true ,if-false)))
-
-;; Anaphoric macros
-
-(defmacro aif (test then &optional else)
-  `(let ((it ,test))
-     (if it ,then ,else)))
-
-(defmacro awhen (test-form &body body)
-  `(aif ,test-form
-        (progn ,@body)))
-
-(defmacro awhile (expr &body body)
-  `(do ((it ,expr ,expr))
-       ((not it))
-     ,@body))
-
-(defmacro aand (&rest args)
-  (cond ((null args) t)
-        ((null (cdr args)) (car args))
-        (t `(aif ,(car args) (aand ,@(cdr args))))))
-
-(defmacro acond (&rest clauses)
-  (if (null clauses)
-      nil
-      (let ((cl1 (car clauses))
-            (sym (gensym)))
-        `(let ((,sym ,(car cl1)))
-           (if ,sym
-               (let ((it ,sym)) ,@(cdr cl1))
-               (acond ,@(cdr clauses)))))))
-
-(defmacro alambda (parms &body body)
-  `(labels ((self ,parms ,@body))
-     #'self))
-
-
-(defmacro aif2 (test &optional then else)
-  (let ((win (gensym)))
-    `(multiple-value-bind (it ,win) ,test
-       (if (or it ,win) ,then ,else))))
-
-(defmacro awhen2 (test &body body)
-  `(aif2 ,test
-         (progn ,@body)))
-
-(defmacro awhile2 (test &body body)
-  (let ((flag (gensym)))
-    `(let ((,flag t))
-       (while ,flag
-         (aif2 ,test
-               (progn ,@body)
-               (setq ,flag nil))))))
-
-(defmacro acond2 (&rest clauses)
-  (if (null clauses)
-      nil
-      (let ((cl1 (car clauses))
-            (val (gensym))
-            (win (gensym)))
-        `(multiple-value-bind (,val ,win) ,(car cl1)
-           (if (or ,val ,win)
-               (let ((it ,val)) ,@(cdr cl1))
-               (acond2 ,@(cdr clauses)))))))
-
-
-;; Debugging 
-
-(defmacro mac (expr)
-"Expand a macro"
-  `(pprint (macroexpand-1 ',expr)))
-
-(defmacro print-form-and-results (form)
-  `(format t "~&~A --> ~S~%" (write-to-string ',form) ,form))
-
-(defun show (&optional (what :variables) (package *package*))
-  (ecase what
-    (:variables (show-variables package))
-    (:functions (show-functions package))))
-
-(defun show-variables (package)
-  (do-symbols (s package)
-    (multiple-value-bind (sym status)
-	(find-symbol (symbol-name s) package)
-      (when (and (or (eq status :external)
-		     (eq status :internal))
-		 (boundp sym))
-	(format t "~&Symbol ~S~T -> ~S~%"
-		sym
-		(symbol-value sym))))))
-
-(defun show-functions (package)
-  (do-symbols (s package)
-    (multiple-value-bind (sym status)
-	(find-symbol (symbol-name s) package)
-      (when (and (or (eq status :external)
-		     (eq status :internal))
-		 (fboundp sym))
-	(format t "~&Function ~S~T -> ~S~%"
-		sym
-		(symbol-function sym))))))
-
-#+allegro
-(ff:def-foreign-call (memory-status-dump "memory_status_dump")
-    ()
-  :strings-convert t)
-
-
-;; Ensure functions
-
-(defmacro ensure-integer (obj)
-  "Ensure object is an integer. If it is a string, then parse it"
-  `(if (stringp ,obj)
-      (parse-integer ,obj)
-    ,obj))
-
-;; Lists
-
-(defun mklist (obj)
-  "Make into list if atom"
-  (if (listp obj) obj (list obj)))
-
-(defun filter (fn lst)
-  "Filter a list by function, eliminate elements where fn returns nil"
-  (let ((acc nil))
-    (dolist (x lst)
-      (let ((val (funcall fn x)))
-        (if val (push val acc))))
-    (nreverse acc)))
-
-(defun appendnew (l1 l2)
-  "Append two lists, filtering out elem from second list that are already in first list"
-  (dolist (elem l2)
-    (unless (find elem l1)
-      (setq l1 (append l1 (list elem)))))
-  l1)
-
-;; Functions
-
-(defun memo-proc (fn)
-  "Memoize results of call to fn, returns a closure with hash-table"
-  (let ((cache (make-hash-table :test #'equal)))
-    #'(lambda (&rest args)
-        (multiple-value-bind (val foundp) (gethash args cache)
-          (if foundp
-              val
-              (setf (gethash args cache) 
-                    (apply fn args)))))))
-
-(defun memoize (fn-name)
-  (setf (fdefinition fn-name) (memo-proc (fdefinition fn-name))))
-
-(defmacro defun-memo (fn args &body body)
-  "Define a memoized function"
-  `(memoize (defun ,fn ,args . ,body)))
-
-(defmacro _f (op place &rest args)
-  (multiple-value-bind (vars forms var set access) 
-                       (get-setf-expansion place)
-    `(let* (,@(mapcar #'list vars forms)
-            (,(car var) (,op ,access ,@args)))
-       ,set)))
-
-(defun compose (&rest fns)
-  (if fns
-      (let ((fn1 (car (last fns)))
-            (fns (butlast fns)))
-        #'(lambda (&rest args)
-            (reduce #'funcall fns 
-                    :from-end t
-                    :initial-value (apply fn1 args))))
-      #'identity))
-
-;;; Loop macros
-
-(defmacro until (test &body body)
-  `(do ()
-       (,test)
-     ,@body))
-
-(defmacro while (test &body body)
-  `(do ()
-       ((not ,test))
-     ,@body))
-
-(defmacro for ((var start stop) &body body)
-  (let ((gstop (gensym)))
-    `(do ((,var ,start (1+ ,var))
-          (,gstop ,stop))
-         ((> ,var ,gstop))
-       ,@body)))
-
-(defmacro with-each-stream-line ((var stream) &body body)
-  (let ((eof (gensym))
-	(eof-value (gensym))
-	(strm (gensym)))
-    `(let ((,strm ,stream)
-	   (,eof ',eof-value))
-      (do ((,var (read-line ,strm nil ,eof) (read-line ,strm nil ,eof)))
-	  ((eql ,var ,eof))
-	,@body))))
-
-(defmacro with-each-file-line ((var file) &body body)
-  (let ((stream (gensym)))
-    `(with-open-file (,stream ,file :direction :input)
-      (with-each-stream-line (,var ,stream)
-	,@body))))
-
-		
-;;; Keyword functions
-
-(defun remove-keyword (key arglist)
-  (loop for sublist = arglist then rest until (null sublist)
-	for (elt arg . rest) = sublist
-	unless (eq key elt) append (list elt arg)))
-
-(defun remove-keywords (key-names args)
-  (loop for ( name val ) on args by #'cddr
-	unless (member (symbol-name name) key-names 
-		       :key #'symbol-name :test 'equal)
-	append (list name val)))
-
-(defmacro in (obj &rest choices)
-  (let ((insym (gensym)))
-    `(let ((,insym ,obj))
-       (or ,@(mapcar #'(lambda (c) `(eql ,insym ,c))
-                     choices)))))
-
-(defmacro mean (&rest args)
-  `(/ (+ ,@args) ,(length args)))
-
-(defmacro with-gensyms (syms &body body)
-  `(let ,(mapcar #'(lambda (s) `(,s (gensym)))
-	  syms)
-     ,@body))
-
-
-;;; Mapping
-
-(defun mapappend (fn list)
-  (apply #'append (mapcar fn list)))
-
-
-(defun mapcar-append-string-nontailrec (func v)
-  "Concatenate results of mapcar lambda calls"  
-  (aif (car v)
-       (concatenate 'string (funcall func it)
-		    (mapcar-append-string-nontailrec func (cdr v)))
-       ""))
-
-
-(defun mapcar-append-string (func v &optional (accum ""))
-  "Concatenate results of mapcar lambda calls"  
-  (aif (car v)
-       (mapcar-append-string 
-	func 
-	(cdr v) 
-	(concatenate 'string accum (funcall func it)))
-       accum))
-
-(defun mapcar2-append-string-nontailrec (func la lb)
-  "Concatenate results of mapcar lambda call's over two lists"  
-  (let ((a (car la))
-	(b (car lb)))
-    (if (and a b)
-      (concatenate 'string (funcall func a b)
-		   (mapcar2-append-string-nontailrec func (cdr la) (cdr lb)))
-      "")))
-  
-(defun mapcar2-append-string (func la lb &optional (accum ""))
-  "Concatenate results of mapcar lambda call's over two lists"  
-  (let ((a (car la))
-	(b (car lb)))
-    (if (and a b)
-	(mapcar2-append-string 
-	 func 
-	 (cdr la) 
-	 (cdr lb)
-	 (concatenate 'string accum (funcall func a b)))
-      accum)))
-  
-
-;;; Output
-
-(defun indent-spaces (n &optional (stream *standard-output*))
-  "Indent n*2 spaces to output stream"
-  (when (numberp n)
-    (let ((fmt (format nil "~~~DT" (+ n n))))
-      (format stream fmt))))
-
-(defun print-list (l &optional (output *standard-output*))
-  "Print a list to a stream"
-  (if (consp l)
-    (progn
-      (mapcar (lambda (x) (princ x output) (princ #\newline output)) l)
-      t)
-    nil))
-
-(defun print-rows (rows &optional (ostrm *standard-output*))
-  "Print a list of list rows to a stream"  
-  (dolist (r rows)
-    (mapcar (lambda (a) (princ a ostrm) (princ #\space ostrm)) r)
-    (terpri ostrm)))
-
-
-;;; IO
-
-
-(defstruct buf
-  vec (start -1) (used -1) (new -1) (end -1))
-
-(defun bref (buf n)
-  (svref (buf-vec buf)
-         (mod n (length (buf-vec buf)))))
-
-(defun (setf bref) (val buf n)
-  (setf (svref (buf-vec buf)
-               (mod n (length (buf-vec buf))))
-        val))
-
-(defun new-buf (len)
-  (make-buf :vec (make-array len)))
-
-(defun buf-insert (x b)
-  (setf (bref b (incf (buf-end b))) x))
-
-(defun buf-pop (b)
-  (prog1 
-    (bref b (incf (buf-start b)))
-    (setf (buf-used b) (buf-start b)
-          (buf-new  b) (buf-end   b))))
-
-(defun buf-next (b)
-  (when (< (buf-used b) (buf-new b))
-    (bref b (incf (buf-used b)))))
-
-(defun buf-reset (b)
-  (setf (buf-used b) (buf-start b)
-        (buf-new  b) (buf-end   b)))
-
-(defun buf-clear (b)
-  (setf (buf-start b) -1 (buf-used  b) -1
-        (buf-new   b) -1 (buf-end   b) -1))
-
-(defun buf-flush (b str)
-  (do ((i (1+ (buf-used b)) (1+ i)))
-      ((> i (buf-end b)))
-    (princ (bref b i) str)))
-
-
-(defun file-subst (old new file1 file2)
-  (with-open-file (in file1 :direction :input)
-    (with-open-file (out file2 :direction :output
-			 :if-exists :supersede)
-      (stream-subst old new in out))))
-
-(defun stream-subst (old new in out)
-  (declare (string old new))
-  (let* ((pos 0)
-         (len (length old))
-         (buf (new-buf len))
-         (from-buf nil))
-    (declare (fixnum pos len))
-    (do ((c (read-char in nil :eof)
-            (or (setf from-buf (buf-next buf))
-                (read-char in nil :eof))))
-        ((eql c :eof))
-      (declare (character c))
-      (cond ((char= c (char old pos))
-             (incf pos)
-             (cond ((= pos len)            ; 3
-                    (princ new out)
-                    (setf pos 0)
-                    (buf-clear buf))
-                   ((not from-buf)         ; 2
-                    (buf-insert c buf))))
-            ((zerop pos)                   ; 1
-             (princ c out)
-             (when from-buf
-               (buf-pop buf)
-               (buf-reset buf)))
-            (t                             ; 4
-             (unless from-buf
-               (buf-insert c buf))
-             (princ (buf-pop buf) out)
-             (buf-reset buf)
-             (setf pos 0))))
-    (buf-flush buf out)))
-
-
-;;; Tree Functions
-
-(defun remove-tree-if (pred tree)
-  "Strip from tree of atoms that satistify predicate"
-  (if (atom tree)
-      (unless (funcall pred tree)
-	tree)
-    (let ((car-strip (remove-tree-if pred (car tree)))
-	  (cdr-strip (remove-tree-if pred (cdr tree))))
-      (cond
-       ((and car-strip (atom (cadr tree)) (null cdr-strip))
-	(list car-strip))
-       ((and car-strip cdr-strip)
-	(cons car-strip cdr-strip))
-       (car-strip
-	car-strip)
-       (cdr-strip
-	cdr-strip)))))
-
-(defun find-tree (sym tree)
-  "Finds an atom as a car in tree and returns cdr tree at that positions"
-  (if (or (null tree) (atom tree))
-      nil
-    (if (eql sym (car tree))
-	(cdr tree)
-      (aif (find-tree sym (car tree))
-	  it
-	(aif (find-tree sym (cdr tree))
-	    it
-	  nil)))))
-
-;;; Files
-
-(defun print-file-contents (file &optional (strm *standard-output*))
-  "Opens a reads a file. Returns the contents as a single string"
-  (when (probe-file file)
-    (with-open-file (in file :direction :input)
-      (let ((eof (gensym)))		    
-	(do ((line (read-line in nil eof) 
-		   (read-line in nil eof)))
-	    ((eq line eof))
-	  (format strm "~A~%" line))))))
-
-(defun read-file-to-string (file)
-  "Opens a reads a file. Returns the contents as a single string"
-  (with-output-to-string (out)
-    (with-open-file (in file :direction :input)
-      (let ((eof (gensym)))		    
-	(do ((line (read-line in nil eof) 
-		   (read-line in nil eof)))
-	    ((eq line eof))
-	  (format out "~A~%" line))))))
-
-(defun read-file-to-strings (file)
-  "Opens a reads a file. Returns the contents as a list of strings"
-  (let ((lines '()))
-    (with-open-file (in file :direction :input)
-      (let ((eof (gensym)))		    
-	(do ((line (read-line in nil eof) 
-		   (read-line in nil eof)))
-	    ((eq line eof))
-	  (push line lines)))
-      (nreverse lines))))
-
-
-
-;; Benchmarking
-
-(defun print-float-units (val unit)
-  (cond
-    ((< val 1d-6)
-     (format t "~,2,9F nano~A" val unit))
-    ((< val 1d-3)
-     (format t "~,2,6F micro~A" val unit))
-    ((< val 1)
-     (format t "~,2,3F milli~A" val unit))
-    ((> val 1d9)
-     (format t "~,2,-9F giga~A" val unit))
-    ((> val 1d6)
-     (format t "~,2,-6F mega~A" val unit))
-    ((> val 1d3)
-     (format t "~,2,-3F kilo~A" val unit))
-    (t
-     (format t "~,2F ~A" val unit))))
-
-(defun print-seconds (secs)
-  (print-float-units secs "sec"))
-
-(defmacro time-iterations (n &body body)
-  (let ((i (gensym))
-	(count (gensym)))
-    `(progn
-       (let ((,count ,n))
-	 (format t "~&Test with ~d iterations: ~W" ,count (quote ,body))
-	 (let ((t1 (get-internal-real-time)))
-	   (dotimes (,i ,count)
-	     ,@body)
-	   (let* ((t2 (get-internal-real-time))
-		  (secs (coerce (/ (- t2 t1)
-				   internal-time-units-per-second)
-				'double-float)))
-	     (format t "~&Total time: ")
-	     (print-seconds secs)
-	     (format t ", time per iteration: ")
-	     (print-seconds (coerce (/ secs ,n) 'double-float))))))))
-
-
-(defun nsubseq (sequence start &optional (end (length sequence)))
-  (make-array (- end start)
-	      :element-type (array-element-type sequence)
-	      :displaced-to sequence
-	      :displaced-index-offset start))
diff --git a/io.lisp b/io.lisp
new file mode 100644
index 0000000..753cc44
--- /dev/null
+++ b/io.lisp
@@ -0,0 +1,156 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          io.lisp
+;;;; Purpose:       Input/Output functions for KMRCL package
+;;;; Programmer:    Kevin M. Rosenberg
+;;;; Date Started:  Apr 2000
+;;;;
+;;;; $Id: io.lisp,v 1.1 2003/04/28 23:51:59 kevin Exp $
+;;;;
+;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;;
+;;;; KMRCL users are granted the rights to distribute and use this software
+;;;; as governed by the terms of the Lisp Lesser GNU Public License
+;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+;;;; *************************************************************************
+
+(in-package :kmrcl)
+
+(defun print-file-contents (file &optional (strm *standard-output*))
+  "Opens a reads a file. Returns the contents as a single string"
+  (when (probe-file file)
+    (with-open-file (in file :direction :input)
+      (let ((eof (gensym)))		    
+	(do ((line (read-line in nil eof) 
+		   (read-line in nil eof)))
+	    ((eq line eof))
+	  (format strm "~A~%" line))))))
+
+(defun read-file-to-string (file)
+  "Opens a reads a file. Returns the contents as a single string"
+  (with-output-to-string (out)
+    (with-open-file (in file :direction :input)
+      (let ((eof (gensym)))		    
+	(do ((line (read-line in nil eof) 
+		   (read-line in nil eof)))
+	    ((eq line eof))
+	  (format out "~A~%" line))))))
+
+(defun read-file-to-strings (file)
+  "Opens a reads a file. Returns the contents as a list of strings"
+  (let ((lines '()))
+    (with-open-file (in file :direction :input)
+      (let ((eof (gensym)))		    
+	(do ((line (read-line in nil eof) 
+		   (read-line in nil eof)))
+	    ((eq line eof))
+	  (push line lines)))
+      (nreverse lines))))
+
+(defun file-subst (old new file1 file2)
+  (with-open-file (in file1 :direction :input)
+    (with-open-file (out file2 :direction :output
+			 :if-exists :supersede)
+      (stream-subst old new in out))))
+
+
+(defun indent-spaces (n &optional (stream *standard-output*))
+  "Indent n*2 spaces to output stream"
+  (when (numberp n)
+    (let ((fmt (format nil "~~~DT" (+ n n))))
+      (format stream fmt))))
+
+(defun print-list (l &optional (output *standard-output*))
+  "Print a list to a stream"
+  (if (consp l)
+    (progn
+      (mapcar (lambda (x) (princ x output) (princ #\newline output)) l)
+      t)
+    nil))
+
+(defun print-rows (rows &optional (ostrm *standard-output*))
+  "Print a list of list rows to a stream"  
+  (dolist (r rows)
+    (mapcar (lambda (a) (princ a ostrm) (princ #\space ostrm)) r)
+    (terpri ostrm)))
+
+
+;; Buffered stream substitute
+
+(defstruct buf
+  vec (start -1) (used -1) (new -1) (end -1))
+
+(defun bref (buf n)
+  (svref (buf-vec buf)
+         (mod n (length (buf-vec buf)))))
+
+(defun (setf bref) (val buf n)
+  (setf (svref (buf-vec buf)
+               (mod n (length (buf-vec buf))))
+        val))
+
+(defun new-buf (len)
+  (make-buf :vec (make-array len)))
+
+(defun buf-insert (x b)
+  (setf (bref b (incf (buf-end b))) x))
+
+(defun buf-pop (b)
+  (prog1 
+    (bref b (incf (buf-start b)))
+    (setf (buf-used b) (buf-start b)
+          (buf-new  b) (buf-end   b))))
+
+(defun buf-next (b)
+  (when (< (buf-used b) (buf-new b))
+    (bref b (incf (buf-used b)))))
+
+(defun buf-reset (b)
+  (setf (buf-used b) (buf-start b)
+        (buf-new  b) (buf-end   b)))
+
+(defun buf-clear (b)
+  (setf (buf-start b) -1 (buf-used  b) -1
+        (buf-new   b) -1 (buf-end   b) -1))
+
+(defun buf-flush (b str)
+  (do ((i (1+ (buf-used b)) (1+ i)))
+      ((> i (buf-end b)))
+    (princ (bref b i) str)))
+
+
+(defun stream-subst (old new in out)
+  (declare (string old new))
+  (let* ((pos 0)
+         (len (length old))
+         (buf (new-buf len))
+         (from-buf nil))
+    (declare (fixnum pos len))
+    (do ((c (read-char in nil :eof)
+            (or (setf from-buf (buf-next buf))
+                (read-char in nil :eof))))
+        ((eql c :eof))
+      (declare (character c))
+      (cond ((char= c (char old pos))
+             (incf pos)
+             (cond ((= pos len)            ; 3
+                    (princ new out)
+                    (setf pos 0)
+                    (buf-clear buf))
+                   ((not from-buf)         ; 2
+                    (buf-insert c buf))))
+            ((zerop pos)                   ; 1
+             (princ c out)
+             (when from-buf
+               (buf-pop buf)
+               (buf-reset buf)))
+            (t                             ; 4
+             (unless from-buf
+               (buf-insert c buf))
+             (princ (buf-pop buf) out)
+             (buf-reset buf)
+             (setf pos 0))))
+    (buf-flush buf out)))
+
diff --git a/kmrcl.asd b/kmrcl.asd
index 6b7ca40..eb47c3f 100644
--- a/kmrcl.asd
+++ b/kmrcl.asd
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: kmrcl.asd,v 1.24 2003/04/28 21:12:27 kevin Exp $
+;;;; $Id: kmrcl.asd,v 1.25 2003/04/28 23:51:59 kevin Exp $
 ;;;;
 ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -19,7 +19,7 @@
 (defpackage #:kmrcl-system (:use #:asdf #:cl))
 (in-package #:kmrcl-system)
 
-#+(or allegro cmucl lispworks sbcl scl) (push :kmr-mop cl:*features*)
+#+(or allegro cmucl lispworks sbcl scl) (pushnew :kmr-mop cl:*features*)
 
 (defsystem kmrcl
     :name "kmrcl"
@@ -30,20 +30,24 @@
 
     :components 
     ((:file "package")
-     (:file "console" :depends-on ("package"))
-     (:file "genutils" :depends-on ("package"))
-     (:file "strings" :depends-on ("package"))
-     (:file "equal" :depends-on ("package"))
-     (:file "buff-input" :depends-on ("genutils"))
-     (:file "telnet-server" :depends-on ("genutils"))
-     (:file "random" :depends-on ("package"))
-     (:file "cl-symbols" :depends-on ("package"))
-     (:file "datetime" :depends-on ("package"))
-     (:file "math" :depends-on ("package"))
-     #+kmr-mop (:file "mop" :depends-on ("package"))
-     #+kmr-mop (:file "attrib-class" :depends-on ("package"))
-     (:file "web-utils" :depends-on ("package"))
-     (:file "xml-utils" :depends-on ("package")))
+     (:file "macros" :depends-on ("package"))
+     (:file "functions" :depends-on ("macros"))
+     (:file "lists" :depends-on ("macros"))
+     (:file "seqs" :depends-on ("macros"))
+     (:file "io" :depends-on ("macros"))
+     (:file "console" :depends-on ("macros"))
+     (:file "strings" :depends-on ("genutils"))
+     (:file "equal" :depends-on ("macros"))
+     (:file "buff-input" :depends-on ("macros"))
+     (:file "telnet-server" :depends-on ("macros"))
+     (:file "random" :depends-on ("macros"))
+     (:file "symbols" :depends-on ("macros"))
+     (:file "datetime" :depends-on ("macros"))
+     (:file "math" :depends-on ("macros"))
+     #+kmr-mop (:file "mop" :depends-on ("macros"))
+     #+kmr-mop (:file "attrib-class" :depends-on ("genutils" "mop"))
+     (:file "web-utils" :depends-on ("macros"))
+     (:file "xml-utils" :depends-on ("macros")))
     )
 
 #+(or allegro lispworks sbcl cmu scl)
@@ -51,3 +55,5 @@
   (oos 'load-op 'kmrcl-tests)
   (oos 'test-op 'kmrcl-tests))
 
+#+kmr-mop
+(setq cl:*features* (delete :kmr-mop cl:*features*))
diff --git a/macros.lisp b/macros.lisp
new file mode 100644
index 0000000..74ea24b
--- /dev/null
+++ b/macros.lisp
@@ -0,0 +1,167 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          gentils.lisp
+;;;; Purpose:       Main general utility functions for KMRCL package
+;;;; Programmer:    Kevin M. Rosenberg
+;;;; Date Started:  Apr 2000
+;;;;
+;;;; $Id: macros.lisp,v 1.1 2003/04/28 23:51:59 kevin Exp $
+;;;;
+;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;;
+;;;; KMRCL users are granted the rights to distribute and use this software
+;;;; as governed by the terms of the Lisp Lesser GNU Public License
+;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+;;;; *************************************************************************
+
+(in-package :kmrcl)
+
+(defmacro let-when ((var test-form) &body body)
+  `(let ((,var ,test-form))
+      (when ,var ,@body)))
+  
+(defmacro let-if ((var test-form) if-true &optional if-false)
+  `(let ((,var ,test-form))
+      (if ,var ,if-true ,if-false)))
+
+;; Anaphoric macros
+
+(defmacro aif (test then &optional else)
+  `(let ((it ,test))
+     (if it ,then ,else)))
+
+(defmacro awhen (test-form &body body)
+  `(aif ,test-form
+        (progn ,@body)))
+
+(defmacro awhile (expr &body body)
+  `(do ((it ,expr ,expr))
+       ((not it))
+     ,@body))
+
+(defmacro aand (&rest args)
+  (cond ((null args) t)
+        ((null (cdr args)) (car args))
+        (t `(aif ,(car args) (aand ,@(cdr args))))))
+
+(defmacro acond (&rest clauses)
+  (if (null clauses)
+      nil
+      (let ((cl1 (car clauses))
+            (sym (gensym)))
+        `(let ((,sym ,(car cl1)))
+           (if ,sym
+               (let ((it ,sym)) ,@(cdr cl1))
+               (acond ,@(cdr clauses)))))))
+
+(defmacro alambda (parms &body body)
+  `(labels ((self ,parms ,@body))
+     #'self))
+
+
+(defmacro aif2 (test &optional then else)
+  (let ((win (gensym)))
+    `(multiple-value-bind (it ,win) ,test
+       (if (or it ,win) ,then ,else))))
+
+(defmacro awhen2 (test &body body)
+  `(aif2 ,test
+         (progn ,@body)))
+
+(defmacro awhile2 (test &body body)
+  (let ((flag (gensym)))
+    `(let ((,flag t))
+       (while ,flag
+         (aif2 ,test
+               (progn ,@body)
+               (setq ,flag nil))))))
+
+(defmacro acond2 (&rest clauses)
+  (if (null clauses)
+      nil
+      (let ((cl1 (car clauses))
+            (val (gensym))
+            (win (gensym)))
+        `(multiple-value-bind (,val ,win) ,(car cl1)
+           (if (or ,val ,win)
+               (let ((it ,val)) ,@(cdr cl1))
+               (acond2 ,@(cdr clauses)))))))
+
+(defmacro mac (expr)
+"Expand a macro"
+  `(pprint (macroexpand-1 ',expr)))
+
+(defmacro print-form-and-results (form)
+  `(format t "~&~A --> ~S~%" (write-to-string ',form) ,form))
+
+
+;;; Loop macros
+
+(defmacro until (test &body body)
+  `(do ()
+       (,test)
+     ,@body))
+
+(defmacro while (test &body body)
+  `(do ()
+       ((not ,test))
+     ,@body))
+
+(defmacro for ((var start stop) &body body)
+  (let ((gstop (gensym)))
+    `(do ((,var ,start (1+ ,var))
+          (,gstop ,stop))
+         ((> ,var ,gstop))
+       ,@body)))
+
+(defmacro with-each-stream-line ((var stream) &body body)
+  (let ((eof (gensym))
+	(eof-value (gensym))
+	(strm (gensym)))
+    `(let ((,strm ,stream)
+	   (,eof ',eof-value))
+      (do ((,var (read-line ,strm nil ,eof) (read-line ,strm nil ,eof)))
+	  ((eql ,var ,eof))
+	,@body))))
+
+(defmacro with-each-file-line ((var file) &body body)
+  (let ((stream (gensym)))
+    `(with-open-file (,stream ,file :direction :input)
+      (with-each-stream-line (,var ,stream)
+	,@body))))
+
+
+(defmacro in (obj &rest choices)
+  (let ((insym (gensym)))
+    `(let ((,insym ,obj))
+       (or ,@(mapcar #'(lambda (c) `(eql ,insym ,c))
+                     choices)))))
+
+(defmacro mean (&rest args)
+  `(/ (+ ,@args) ,(length args)))
+
+(defmacro with-gensyms (syms &body body)
+  `(let ,(mapcar #'(lambda (s) `(,s (gensym)))
+	  syms)
+     ,@body))
+
+
+(defmacro time-iterations (n &body body)
+  (let ((i (gensym))
+	(count (gensym)))
+    `(progn
+       (let ((,count ,n))
+	 (format t "~&Test with ~d iterations: ~W" ,count (quote ,body))
+	 (let ((t1 (get-internal-real-time)))
+	   (dotimes (,i ,count)
+	     ,@body)
+	   (let* ((t2 (get-internal-real-time))
+		  (secs (coerce (/ (- t2 t1)
+				   internal-time-units-per-second)
+				'double-float)))
+	     (format t "~&Total time: ")
+	     (print-seconds secs)
+	     (format t ", time per iteration: ")
+	     (print-seconds (coerce (/ secs ,n) 'double-float))))))))
diff --git a/math.lisp b/math.lisp
index 9a6862b..6e585ba 100644
--- a/math.lisp
+++ b/math.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Nov 2002
 ;;;;
-;;;; $Id: math.lisp,v 1.2 2003/04/28 16:07:42 kevin Exp $
+;;;; $Id: math.lisp,v 1.3 2003/04/28 23:51:59 kevin Exp $
 ;;;;
 ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -28,3 +28,9 @@
     (funcall (deriv #'sin 1d-8) x))
 
 ;;; (sin^ pi)
+
+(defmacro ensure-integer (obj)
+  "Ensure object is an integer. If it is a string, then parse it"
+  `(if (stringp ,obj)
+      (parse-integer ,obj)
+     ,obj))
diff --git a/package.lisp b/package.lisp
index f518b81..7b7238b 100644
--- a/package.lisp
+++ b/package.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: package.lisp,v 1.20 2003/02/07 14:21:55 kevin Exp $
+;;;; $Id: package.lisp,v 1.21 2003/04/28 23:51:59 kevin Exp $
 ;;;;
 ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -23,126 +23,133 @@
 (defpackage #:kmrcl
   (:nicknames :kl)
   (:use :common-lisp)
-  (:export #:let-if
-	   #:let-when
-	   #:aif
-	  #:awhen
-	  #:awhile
-	  #:aand
-	  #:acond
-	  #:alambda
-	  #:it
-	  #:mac
-	  #:show
-	  #:show-variables
-	  #:show-functions
-	  #:ensure-integer
-	  #:mklist
-	  #:filter
-	  #:appendnew
-	  #:memo-proc
-	  #:memoize
-	  #:defun-memo
-	  #:_f
-	  #:compose
-	  #:until
-	  #:while
-	  #:for
-	  #:mapappend
-	  #:mapcar-append-string
-	  #:mapcar2-append-string
-	  #:delimited-string-to-list
-	  #:list-to-delimited-string
-	  #:indent-spaces
-	  #:print-list
-	  #:print-rows
-	  #:file-subst
-	  #:stream-subst
-	  #:remove-tree-if
-	  #:find-tree
-	  #:with-each-file-line
-	  #:with-each-stream-line
-	  #:print-file-contents
-	  #:read-file-to-string
-	  #:read-file-to-strings
-	  #:add-sql-quotes
-	  #:escape-backslashes
-	  #:remove-keyword
-	  #:remove-keywords
-	  #:in
-	  #:mean
-	  #:with-gensyms
-	  #:time-iterations
-	  #:print-float-units
-	  #:print-seconds
-	  #:nsubseq
-	  
-	  ;; strings.lisp
-	  #:string-append
-	  #:count-string-words
-	  #:substitute-string-for-char
-	  #:string-trim-last-character
-	  #:string-hash
-	  #:string-not-null?
-	  #:whitespace?
-	  #:not-whitespace?
-	  #:string-ws?
-	  #:string-invert
-	  #:escape-xml-string
-	  #:string-replace-char-string
-	  #:make-usb8-array
-	  #:usb8-array-to-string
-	  #:string-to-usb8-array
-	  
-	  ;; symbols.lisp
-	  #:ensure-keyword
-	  #:concat-symbol
-	  #:concat-symbol-pkg
-
-	  ;; From attrib-class.lisp
-	  #:attributes-class
-	  #:slot-attribute
-
-	  #:generalized-equal
-	  
-	  ;; From buffered input
-	  
-	  #:make-fields-buffer
-	  #:read-buffered-fields
-
-	  #:pretty-date
-	  #:date-string
-
-	  ;; From random.lisp
-	  #:seed-random-generator
-	  #:random-choice
-
-	  ;; From telnet-server.lisp
-	  #:start-telnet-server	  
-
-	  ;; From web-utils
-	  #:*base-url*
-	  #:base-url!
-	  #:make-url
-	  #:*standard-html-header*
-	  #:*standard-xhtml-header*
-	  #:*standard-xml-header*
-	  #:user-agent-ie-p
-
-	  ;; From xml-utils
-	  #:wrap-with-xml
-	  #:xml-tag-contents
-	  #:positions-xml-tag-contents
-	  #:xml-cdata
-	  
-	  ;; From console
-	  *console-msgs*
-	  cmsg
-	  cmsg-c
-	  cmsg-add
-	  cmsg-remove
-	  fixme
-	  ))
+  (:export
+   #:ensure-integer
+   #:mklist
+   #:filter
+   #:appendnew
+   #:memo-proc
+   #:memoize
+   #:defun-memo
+   #:_f
+   #:compose
+   #:until
+   #:while
+   #:for
+   #:mapappend
+   #:mapcar-append-string
+   #:mapcar2-append-string
+   #:delimited-string-to-list
+   #:list-to-delimited-string
+   #:indent-spaces
+   #:print-list
+   #:print-rows
+   #:file-subst
+   #:stream-subst
+   #:remove-tree-if
+   #:find-tree
+   #:with-each-file-line
+   #:with-each-stream-line
+   #:remove-keyword
+   #:remove-keywords
+   #:nsubseq
+   
+   ;; macros.lisp
+   #:time-iterations
+   #:in
+   #:mean
+   #:with-gensyms
+   #:let-if
+   #:let-when
+   #:aif
+   #:awhen
+   #:awhile
+   #:aand
+   #:acond
+   #:alambda
+   #:it
+   #:mac
+   
+   ;; files.lisp
+   #:print-file-contents
+   #:read-file-to-string
+   #:read-file-to-strings
+   
+   ;; strings.lisp
+   #:string-append
+   #:count-string-words
+   #:substitute-string-for-char
+   #:string-trim-last-character
+   #:string-hash
+   #:string-not-null?
+   #:whitespace?
+   #:not-whitespace?
+   #:string-ws?
+   #:string-invert
+   #:escape-xml-string
+   #:string-replace-char-string
+   #:make-usb8-array
+   #:usb8-array-to-string
+   #:string-to-usb8-array
+   #:string-replace-chars-strings
+   #:add-sql-quotes
+   #:escape-backslashes
+   
+   ;; symbols.lisp
+   #:ensure-keyword
+   #:concat-symbol
+   #:concat-symbol-pkg
+   #:show
+   #:show-variables
+   #:show-functions
+   
+   ;; From attrib-class.lisp
+   #:attributes-class
+   #:slot-attribute
+   
+   #:generalized-equal
+   
+   ;; From buffered input
+   
+   #:make-fields-buffer
+   #:read-buffered-fields
+   
+   ;; From datetime.lisp
+   #:pretty-date
+   #:date-string
+   #:print-float-units
+   #:print-seconds
+   
+   ;; From random.lisp
+   #:seed-random-generator
+   #:random-choice
+   
+   ;; From telnet-server.lisp
+   #:start-telnet-server	  
+   
+   ;; From web-utils
+   #:*base-url*
+   #:base-url!
+   #:make-url
+   #:*standard-html-header*
+   #:*standard-xhtml-header*
+   #:*standard-xml-header*
+   #:user-agent-ie-p
+   
+   ;; From xml-utils
+   #:wrap-with-xml
+   #:xml-tag-contents
+   #:positions-xml-tag-contents
+   #:xml-cdata
+   
+   ;; From console
+   *console-msgs*
+   cmsg
+   cmsg-c
+   cmsg-add
+   cmsg-remove
+   fixme
+   ))
 
 
 
diff --git a/strings.lisp b/strings.lisp
index d8c0e43..45c2d7a 100644
--- a/strings.lisp
+++ b/strings.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
-;;;; $Id: strings.lisp,v 1.9 2003/04/28 21:12:27 kevin Exp $
+;;;; $Id: strings.lisp,v 1.10 2003/04/28 23:51:59 kevin Exp $
 ;;;;
 ;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
 ;;;;
@@ -90,12 +90,7 @@
 
 (defun substitute-string-for-char (procstr match-char subst-str) 
   "Substitutes a string for a single matching character of a string"
-  (let ((pos (position match-char procstr)))
-    (if pos
-	(concatenate 'string
-	  (subseq procstr 0 pos) subst-str
-	  (substitute-string-for-char (subseq procstr (1+ pos)) match-char subst-str))
-      procstr)))
+  (replace-chars-strings procstr (list (cons match-char subst-str))))
 
 (defun string-substitute (string substring replacement-string)
   "String substitute by Larry Hunter. Obtained from Google"
@@ -114,10 +109,11 @@
 	  replacement-string))
       (setq last-end (+ next-start substring-length)))))
 
-
 (defun string-trim-last-character (s)
-"Return the string less the last character"
-  (subseq s 0 (1- (length s))))
+  "Return the string less the last character"
+  (aif (plusp (length s))
+       (subseq s 0 (1- it))
+       s))
 
 (defun string-hash (str &optional (bitmask 65535))
   (let ((hash 0))
@@ -144,9 +140,7 @@
   (when (stringp str)
     (null (find-if #'not-whitespace? str))))
 
-(defun string-replace-chars-strings (str repl-alist)
-  "Replace all instances of a chars with a string. repl-alist is an assoc
-list of characters and replacement strings."
+(defun replaced-string-length (str repl-alist)
   (declare (string str))
   (let* ((orig-len (length str))
 	 (new-len orig-len))
@@ -157,32 +151,39 @@ list of characters and replacement strings."
 	     (match (assoc c repl-alist :test #'char=)))
 	(declare (character c))
 	(when match
-	  (incf new-len (length (cdr match))))))
-    (let ((new-string (make-string new-len))
-	  (i 0))
-      (declare (string new-string)
-	       (fixnum i))
-      (dotimes (i orig-len)
-	(declare (fixnum i))
-	(let* ((c (char str i))
-	       (match (assoc c repl-alist :test #'char=)))
-	  (declare (character c))
-	  (if match
-	      (let* ((subst (cdr match))
-		     (len (length match)))
-		(dotimes (j len)
-		  (setf (char new-string i) (char subst j))
-		  (incf i))
-		(decf i))
-	    (progn
-	      (setf (char new-string i) c)))))
-      new-string)))
+	  (incf new-len (1- (length (cdr match)))))))
+    new-len))
+
+(defun string-replace-chars-strings (str repl-alist)
+  "Replace all instances of a chars with a string. repl-alist is an assoc
+list of characters and replacement strings."
+  (declare (simple-string str))
+  (do* ((orig-len (length str))
+	(new-string (make-string (replaced-string-length str repl-alist)))
+	(spos 0 (1+ spos))
+	(dpos 0))
+      ((>= spos orig-len)
+       new-string)
+    (declare (fixnum spos dpos) (simple-string new-string))
+    (let* ((c (char str spos))
+	   (match (assoc c repl-alist :test #'char=)))
+      (declare (character c))
+      (if match
+	  (let* ((subst (cdr match))
+		 (len (length subst)))
+	    (declare (fixnum len))
+	    (dotimes (j len)
+	      (declare (fixnum j))
+	      (setf (char new-string dpos) (char subst j))
+	      (incf dpos)))
+	(progn
+	  (setf (char new-string dpos) c)
+	  (incf dpos))))))
 
 (defun escape-xml-string (string)
   "Escape invalid XML characters"
-  (string-replace-char-string
-   (string-replace-char-string string #\& "&amp;")
-   #\< "&lt;"))
+  (string-replace-chars-strings 
+   string '((#\& . "&amp;") (#\> . "&gt;") (#\< . "&lt;"))))
 
 (defun string-replace-char-string (string repl-char repl-str)
   "Replace all occurances of repl-char with repl-str"
diff --git a/symbols.lisp b/symbols.lisp
new file mode 100644
index 0000000..f2af14b
--- /dev/null
+++ b/symbols.lisp
@@ -0,0 +1,99 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; Name:          cl-symbols.lisp
+;;;; Purpose:       Returns all defined Common Lisp symbols
+;;;; Programmer:    Kevin M. Rosenberg
+;;;; Date Started:  Apr 2000
+;;;;
+;;;; $Id: symbols.lisp,v 1.1 2003/04/28 23:51:59 kevin Exp $
+;;;;
+;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
+;;;;
+;;;; KMRCL users are granted the rights to distribute and use this software
+;;;; as governed by the terms of the Lisp Lesser GNU Public License
+;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
+;;;; *************************************************************************
+
+(in-package :kmrcl)
+
+(defun cl-symbols ()
+  (append (cl-variables) (cl-functions)))
+
+(defun cl-variables ()
+  (let ((vars '()))
+    (do-symbols (s 'common-lisp)
+      (multiple-value-bind (sym status)
+	  (find-symbol (symbol-name s) 'common-lisp)
+	(when (and (or (eq status :external)
+		       (eq status :internal))
+		   (boundp sym))
+	  (push sym vars))))
+    (nreverse vars)))
+
+(defun cl-functions ()
+  (let ((funcs '()))
+    (do-symbols (s 'common-lisp)
+      (multiple-value-bind (sym status)
+	(find-symbol (symbol-name s) 'common-lisp)
+	(when (and (or (eq status :external)
+		       (eq status :internal))
+		   (fboundp sym))
+	  (push sym funcs))))
+    (nreverse funcs)))
+
+;;; Symbol functions
+
+(defun concat-symbol-pkg (pkg &rest args)
+  (declare (dynamic-extent args))
+  (flet ((stringify (arg)
+           (etypecase arg
+             (string
+              (string-upcase arg))
+             (symbol
+              (symbol-name arg)))))
+    (let ((str (apply #'concatenate 'string (mapcar #'stringify args))))
+      (intern #-case-sensitive (string-upcase str)
+	      #+case-sensitive str
+	      (if pkg pkg *package*)))))
+
+
+(defun concat-symbol (&rest args)
+  (apply #'concat-symbol-pkg nil args))
+
+(defun ensure-keyword (name)
+  "Returns keyword for a name"
+  (etypecase name
+    (keyword name)
+    (string (intern #-case-sensitive (string-upcase name)
+		    #+case-sensitive name
+		    :keyword))
+    (symbol (intern (symbol-name name) :keyword))))
+
+(defun show (&optional (what :variables) (package *package*))
+  (ecase what
+    (:variables (show-variables package))
+    (:functions (show-functions package))))
+
+(defun show-variables (package)
+  (do-symbols (s package)
+    (multiple-value-bind (sym status)
+	(find-symbol (symbol-name s) package)
+      (when (and (or (eq status :external)
+		     (eq status :internal))
+		 (boundp sym))
+	(format t "~&Symbol ~S~T -> ~S~%"
+		sym
+		(symbol-value sym))))))
+
+(defun show-functions (package)
+  (do-symbols (s package)
+    (multiple-value-bind (sym status)
+	(find-symbol (symbol-name s) package)
+      (when (and (or (eq status :external)
+		     (eq status :internal))
+		 (fboundp sym))
+	(format t "~&Function ~S~T -> ~S~%"
+		sym
+		(symbol-function sym))))))
diff --git a/tests.lisp b/tests.lisp
index eebaf13..467a02d 100644
--- a/tests.lisp
+++ b/tests.lisp
@@ -7,7 +7,7 @@
 ;;;; Author:        Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2003
 ;;;;
-;;;; $Id: tests.lisp,v 1.1 2003/04/28 21:12:27 kevin Exp $
+;;;; $Id: tests.lisp,v 1.2 2003/04/28 23:51:59 kevin Exp $
 ;;;;
 ;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg
 ;;;;
@@ -17,29 +17,68 @@
   (:use #:kmrcl #:cl #:rtest))
 (in-package #:kmrcl-tests)
 
+(rem-all-tests)
+
+
+(when (find-package '#:kmr-mop)
+  (pushnew :kmrtest-mop cl:*features*))
+
 (deftest p1 t t)
 
-#+kmrcl-mop
+(deftest str.0 (string-replace-chars-strings "" nil) "")
+(deftest str.1 (string-replace-chars-strings "abcd" nil) "abcd")
+(deftest str.2 (string-replace-chars-strings "abcd" nil) "abcd")
+(deftest str.3 (string-replace-chars-strings "abcd" '((#\j . "ef"))) "abcd")
+(deftest str.4 (string-replace-chars-strings "abcd" '((#\a . "ef"))) "efbcd")
+(deftest str.5
+    (string-replace-chars-strings "abcd" '((#\a . "ef") (#\j . "ghi")))
+  "efbcd")
+(deftest str.6
+    (string-replace-chars-strings "abcd" '((#\a . "ef") (#\d . "ghi")))
+  "efbcghi")
+
+(deftest str.7 (escape-xml-string "") "")
+(deftest str.8 (escape-xml-string "abcd") "abcd")
+(deftest str.9 (escape-xml-string "ab&cd") "ab&amp;cd")
+(deftest str.10 (escape-xml-string "ab&cd<") "ab&amp;cd&lt;")
+(deftest str.11 (escape-xml-string "ab&c><") "ab&amp;c&gt;&lt;")
+
+#+kmrtest-mop
 (progn
   (defclass credit-rating ()
     ((level :attributes (date-set time-set))
      (id :attributes (person-setting)))
-    (:metaclass kmrcl:attributes-class))
-  (defparameter cr (make-instance 'credit-rating))
+    (:metaclass attributes-class))
+  (defparameter cr nil)
+  
+  (defclass monitored-credit-rating (credit-rating)
+    ((level :attributes (last-checked interval date-set))
+     (cc :initarg :cc)
+     (id :attributes (verified)))
+    (:metaclass attributes-class))
+  (defparameter mcr (make-instance 'monitored-credit-rating))
+
+  (deftest attrib.mop.1
+      (progn
+	(setq cr (make-instance 'credit-rating))
+	(slot-attribute cr 'level 'date-set))
+      nil)
+
+  (deftest attrib.mop.2
+      (progn
+	(setq cr (make-instance 'credit-rating))
+	(setf (slot-attribute cr 'level 'date-set) "12/15/1990")
+	(slot-attribute cr 'level 'date-set))
+    "12/15/1990")
+
+  (deftest attrib.mop.3
+      (progn
+	(setq mcr (make-instance 'monitored-credit-rating))
+	(setf (slot-attribute mcr 'level 'date-set) "01/05/2002")
+	(slot-attribute mcr 'level 'date-set))
+    "01/05/2002")
   
-  (format t "~&date-set: ~a" (slot-attribute cr 'level 'date-set))
-  (setf (slot-attribute cr 'level 'date-set) "12/15/1990")
-(format t "~&date-set: ~a" (slot-attribute cr 'level 'date-set))
-
-(defclass monitored-credit-rating (credit-rating)
-  ((level :attributes (last-checked interval date-set))
-   (cc :initarg :cc)
-   (id :attributes (verified))
-   )
-  (:metaclass attributes-class))
-(defparameter mcr (make-instance 'monitored-credit-rating))
-
-(setf (slot-attribute mcr 'level 'date-set) "01/05/2002")
-(format t "~&date-set for mcr: ~a" (slot-attribute mcr 'level 'date-set))
-)   ;; kmrcl-mop
+  )   ;; kmrcl-mop
 
+#+kmrtest-mop
+(setq cl:*features* (delete :kmrtest-mop cl:*features*))