[cells-cvs] CVS cells/utils-kt

[ktilton]

Update of /project/cells/cvsroot/cells/utils-kt
In directory clnet:/tmp/cvs-serv30831/utils-kt

Modified Files:
	flow-control.lisp 
Log Message:
md-value -> value

--- /project/cells/cvsroot/cells/utils-kt/flow-control.lisp	2006/10/02 02:38:32	1.7
+++ /project/cells/cvsroot/cells/utils-kt/flow-control.lisp	2006/11/04 20:52:02	1.8
@@ -31,7 +31,7 @@
 (defun min-if (v1 v2)
      (if v1 (if v2 (min v1 v2) v1) v2))
 
-(export! list-flatten! tree-flatten)
+(export! list-flatten! tree-flatten list-insertf subseq-contiguous-p)
 
 (defun list-flatten! (&rest list)
   (if (consp list)
@@ -67,6 +67,22 @@
      (declare (dynamic-extent ,fn-name))
      , at body))
 
+(defmacro list-insertf (place item &key after)
+  (let ((list (gensym))
+        (afterv (gensym))
+        (afters (gensym)))
+    `(let* ((,list ,place)
+            (,afterv ,after)
+            (,afters (when ,afterv (member ,after ,list))))
+       (assert (or (null ,afterv) ,afters) () "list-insertf after ~a not in list ~a" ,afterv ,list)
+       (setf ,place
+         (if ,afterv
+             (append (ldiff ,list ,afters)
+               (list ,afterv)
+               (list ,item)
+               (cdr ,afters))
+           (append ,list (list ,item)))))))
+
 (defun intern$ (&rest strings)
   (intern  (apply #'concatenate 'string strings)))