r5153: *** empty log message ***

[kmrcl.git] / lists.lisp

diff --git a/lists.lisp b/lists.lisp
index a7ae3d1655f197fd5142a335c0b093e2f91a3ec8..a1fd55cf1498367cec2e52f84520620770eda60f 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.5 2003/06/06 21:59:29 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
 ;;;;


@@ -16,8 +16,7 @@
 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 ;;;; *************************************************************************
 
 ;;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.
 ;;;; *************************************************************************
 

-(in-package :kmrcl)
-
+(in-package #:kmrcl)

 
 (defun mklist (obj)
   "Make into list if atom"
 
 (defun mklist (obj)
   "Make into list if atom"


@@ -26,19 +25,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)))
+        (when 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 +117,12 @@
   (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)))))