r4900: *** empty log message ***

[kmrcl.git] / lists.lisp

diff --git a/lists.lisp b/lists.lisp
index a7ae3d1655f197fd5142a335c0b093e2f91a3ec8..6b0edb27b7550344f33ed1826fc70d4b531936cf 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.3 2003/05/06 01:43:14 kevin Exp $
+;;;; $Id: lists.lisp,v 1.4 2003/05/11 21:51:43 kevin Exp $

 ;;;;
 ;;;; 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
 ;;;;


@@ -26,19 +26,15 @@
 (defun filter (fn lst)
   "Filter a list by function, eliminate elements where fn returns nil"
   (let ((acc nil))
 (defun filter (fn lst)
   "Filter a list by function, eliminate elements where fn returns nil"
   (let ((acc nil))

-    (dolist (x lst)
+    (dolist (x lst (nreverse acc))

       (let ((val (funcall fn x)))
       (let ((val (funcall fn x)))

-        (if val (push val acc))))
-    (nreverse acc)))
+        (if val (push val acc))))))

 
 (defun appendnew (l1 l2)
   "Append two lists, filtering out elem from second list that are already in first list"
 
 (defun appendnew (l1 l2)
   "Append two lists, filtering out elem from second list that are already in first list"

-  (dolist (elem l2)
+  (dolist (elem l2 l1)

     (unless (find elem l1)
     (unless (find elem l1)

-      (setq l1 (append l1 (list elem)))))
-  l1)
-
-
+      (setq l1 (append l1 (list elem))))))

 
 (defun remove-tree-if (pred tree)
   "Strip from tree of atoms that satistify predicate"
 
 (defun remove-tree-if (pred tree)
   "Strip from tree of atoms that satistify predicate"


@@ -122,17 +118,13 @@
   (let ((a (car la))
        (b (car lb)))
     (if (and a b)
   (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)))
+       (mapcar2-append-string func (cdr la)  (cdr lb)
+                              (concatenate 'string accum (funcall func a b)))

       accum)))
 
 (defun append-sublists (list)
   "Takes a list of lists and appends all sublists"
   (let ((results (car list)))
       accum)))
 
 (defun append-sublists (list)
   "Takes a list of lists and appends all sublists"
   (let ((results (car list)))

-    (dolist (elem (cdr list))
-      (setq results (append results elem)))
-    results))
+    (dolist (elem (cdr list) results)
+      (setq results (append results elem)))))