Fix POP

[jscl.git] / src / list.lisp

diff --git a/src/list.lisp b/src/list.lisp
index b59cfb2..15a433f 100644 (file)
--- a/src/list.lisp
+++ b/src/list.lisp
@@ -38,3 +38,30 @@
 (defun cddadr (x) (cdr (cdadr x)))
 (defun cdddar (x) (cdr (cddar x)))
 (defun cddddr (x) (cdr (cdddr x)))
+
+
+(defun copy-tree (tree)
+  (if (consp tree)
+    (cons (copy-tree (car tree))
+          (copy-tree (cdr tree)))
+    tree))
+
+(defun subst (new old tree &key (key #'identity) (test #'eql))
+  (cond 
+    ((funcall test (funcall key tree) (funcall key old))
+     new) 
+    ((consp tree)
+     (cons (subst new old (car tree) :key key :test test)
+           (subst new old (cdr tree) :key key :test test))) 
+    (t tree)))
+
+(defmacro pop (place)
+  (multiple-value-bind (dummies vals newval setter getter)
+    (get-setf-expansion place)
+    (let ((head (gensym)))
+      `(let* (,@(mapcar #'list dummies vals) 
+              (,head ,getter)
+              (,(car newval) (cdr ,head))
+              ,@(cdr newval)) 
+         ,setter
+         (car ,head)))))