r5417: *** empty log message ***

diff --git a/lists.lisp b/lists.lisp
index 285bb397f426333f8b3eac243144c8704d08eb05..77b6fa52401157e11b78451156903100a4df6775 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.8 2003/07/05 02:32:08 kevin Exp $
+;;;; $Id: lists.lisp,v 1.9 2003/07/31 07:32:11 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
 ;;;;


@@ -22,13 +22,20 @@
   "Make into list if atom"
   (if (listp obj) obj (list obj)))
 
   "Make into list if atom"
   (if (listp obj) obj (list obj)))
 

-(defun filter (fn lst)
-  "Filter a list by function, eliminate elements where fn returns nil"
+(defun map-and-remove-nils (fn lst)
+  "mao a list by function, eliminate elements where fn returns nil"

   (let ((acc nil))
     (dolist (x lst (nreverse acc))
       (let ((val (funcall fn x)))
         (when val (push val acc))))))
 
   (let ((acc nil))
     (dolist (x lst (nreverse acc))
       (let ((val (funcall fn x)))
         (when val (push val acc))))))
 

+(defun filter (fn lst)
+  "Filter a list by function, eliminate elements where fn returns nil"
+  (let ((acc nil))
+    (dolist (x lst (nreverse acc))
+      (when (funcall fn x)
+        (push x acc)))))
+

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

diff --git a/package.lisp b/package.lisp
index 735662aa05dfc66d5003e40a68c151ac5a4b7657..961bcb7c82b39e0380179fd18e5295e481978aff 100644 (file)
--- a/package.lisp
+++ b/package.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;

-;;;; $Id: package.lisp,v 1.54 2003/07/23 22:07:48 kevin Exp $
+;;;; $Id: package.lisp,v 1.55 2003/07/31 07:32:11 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
 ;;;;


@@ -25,6 +25,7 @@
    #:ensure-integer
    #:mklist
    #:filter
    #:ensure-integer
    #:mklist
    #:filter

+   #:map-and-remove-nils

    #:appendnew
    #:memo-proc
    #:memoize
    #:appendnew
    #:memo-proc
    #:memoize

diff --git a/tests.lisp b/tests.lisp
index c917615b40b0030ea1bfa72a42c9f95998136dee..dc5053fbfd549c5053d6d76c71848160899681b9 100644 (file)
--- a/tests.lisp
+++ b/tests.lisp
@@ -7,7 +7,7 @@
 ;;;; Author:        Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2003
 ;;;;
 ;;;; Author:        Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2003
 ;;;;

-;;;; $Id: tests.lisp,v 1.22 2003/07/16 16:01:37 kevin Exp $
+;;;; $Id: tests.lisp,v 1.23 2003/07/31 07:36:55 kevin Exp $

 ;;;;
 ;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg
 ;;;;
 ;;;;
 ;;;; This file is Copyright (c) 2000-2002 by Kevin M. Rosenberg
 ;;;;


@@ -102,8 +102,10 @@
 (deftest css.4 (concat-separated-strings "|" '("ab" "cd") nil) "ab|cd")
 (deftest css.5 (concat-separated-strings "|" '("ab" "cd") nil '("ef")) "ab|cd|ef")
 
 (deftest css.4 (concat-separated-strings "|" '("ab" "cd") nil) "ab|cd")
 (deftest css.5 (concat-separated-strings "|" '("ab" "cd") nil '("ef")) "ab|cd|ef")
 

-(deftest f.1 (filter #'(lambda (x) (when (oddp x) (* x x)))
+(deftest f.1 (map-and-remove-nils #'(lambda (x) (when (oddp x) (* x x)))

                     '(0 1 2 3 4 5 6 7 8 9)) (1 9 25 49 81))
                     '(0 1 2 3 4 5 6 7 8 9)) (1 9 25 49 81))

+(deftest f.2 (filter #'(lambda (x) (when (oddp x) (* x x)))
+                    '(0 1 2 3 4 5 6 7 8 9)) (1 3 5 7 9))

 (deftest an.1 (appendnew '(a b c d) '(c c e f)) (a b c d e f))
 
 
 (deftest an.1 (appendnew '(a b c d) '(c c e f)) (a b c d e f))