projects
/
kmrcl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
r9707: fix declaration
[kmrcl.git]
/
lists.lisp
diff --git
a/lists.lisp
b/lists.lisp
index 77b6fa52401157e11b78451156903100a4df6775..3115dd5dbe1b99476baf576be214fe4353615686 100644
(file)
--- a/
lists.lisp
+++ b/
lists.lisp
@@
-7,7
+7,7
@@
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
;;;; Programmer: Kevin M. Rosenberg
;;;; Date Started: Apr 2000
;;;;
-;;;; $Id
: lists.lisp,v 1.9 2003/07/31 07:32:11 kevin Exp
$
+;;;; $Id$
;;;;
;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
;;;;
;;;; This file, part of KMRCL, is Copyright (c) 2002 by Kevin M. Rosenberg
;;;;
@@
-42,13
+42,15
@@
(unless (find elem l1)
(setq l1 (append l1 (list elem))))))
(unless (find elem l1)
(setq l1 (append l1 (list elem))))))
-(defun remove-
tree-if (pred tree
)
+(defun remove-
from-tree-if (pred tree &optional atom-processor
)
"Strip from tree of atoms that satistify predicate"
(if (atom tree)
(unless (funcall 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))))
+ (if atom-processor
+ (funcall atom-processor tree)
+ tree))
+ (let ((car-strip (remove-from-tree-if pred (car tree) atom-processor))
+ (cdr-strip (remove-from-tree-if pred (cdr tree) atom-processor)))
(cond
((and car-strip (atom (cadr tree)) (null cdr-strip))
(list car-strip))
(cond
((and car-strip (atom (cadr tree)) (null cdr-strip))
(list car-strip))
@@
-155,12
+157,13
@@
(progn
(setf (cdr ,elem) ,value)
,alist)
(progn
(setf (cdr ,elem) ,value)
,alist)
- (setf ,alist (acons ,akey ,value ,alist))))))
+
(setf ,alist (acons ,akey ,value ,alist))))))
(defun get-alist (key alist &key (test #'eql))
(cdr (assoc key alist :test test)))
(defun (setf get-alist) (value key alist &key (test #'eql))
(defun get-alist (key alist &key (test #'eql))
(cdr (assoc key alist :test test)))
(defun (setf get-alist) (value key alist &key (test #'eql))
+ "This doesn't work to add a field which alist value is only modified locally"
(update-alist key value alist :test test)
value)
(update-alist key value alist :test test)
value)
@@
-169,7
+172,7
@@
(defun plist-alist (plist)
(do ((alist '())
(defun plist-alist (plist)
(do ((alist '())
- (pl plist (cddr pl
ist
)))
+ (pl plist (cddr pl)))
((null pl) alist)
(setq alist (acons (car pl) (cadr pl) alist))))
((null pl) alist)
(setq alist (acons (car pl) (cadr pl) alist))))