r4900: *** empty log message ***

diff --git a/debian/changelog b/debian/changelog
index 217e08554f17721527fac894d30fb2665277777a..578b3d0c6779d7afa420cbcd6ceb754ca625c9ba 100644 (file)
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,9 @@
+cl-kmrcl (1.44-1) unstable; urgency=low
+
+  * New upstream
+
+ -- Kevin M. Rosenberg <kmr@debian.org>  Sun, 11 May 2003 15:52:08 -0600
+

 cl-kmrcl (1.43a-1) unstable; urgency=low
 
   * Remove .fasl files
 cl-kmrcl (1.43a-1) unstable; urgency=low
 
   * Remove .fasl files

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

 
 

diff --git a/strings.lisp b/strings.lisp
index f382fe9221dc0e1b48433bcfc15c7fb51ee5a5fa..6348eecdc4cbbc30cd4aa04adbb7beadf7b5916c 100644 (file)
--- a/strings.lisp
+++ b/strings.lisp
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Apr 2000
 ;;;;

-;;;; $Id: strings.lisp,v 1.25 2003/05/09 00:05:13 kevin Exp $
+;;;; $Id: strings.lisp,v 1.26 2003/05/11 21:51:44 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
 ;;;;


@@ -86,8 +86,10 @@
   (let ((up nil) (down nil))
     (block skip
       (loop for char of-type character across str do
   (let ((up nil) (down nil))
     (block skip
       (loop for char of-type character across str do

-           (cond ((upper-case-p char) (if down (return-from skip str) (setf up t)))
-                 ((lower-case-p char) (if up   (return-from skip str) (setf down t)))))
+           (cond ((upper-case-p char)
+                  (if down (return-from skip str) (setf up t)))
+                 ((lower-case-p char)
+                  (if up   (return-from skip str) (setf down t)))))

       (if up (string-downcase str) (string-upcase str)))))
 
 (defun add-sql-quotes (s)
       (if up (string-downcase str) (string-upcase str)))))
 
 (defun add-sql-quotes (s)

diff --git a/tests.lisp b/tests.lisp
index b68cecfe2dba87599ad5c1f106eb7c66982562a6..bdeaa27885a29e1e64864c8edfd655bc231955c5 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.13 2003/05/08 19:19:08 kevin Exp $
+;;;; $Id: tests.lisp,v 1.14 2003/05/11 21:51:44 kevin Exp $

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


@@ -94,6 +94,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))
+                    '(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))
+

 (eval-when (:compile-toplevel :load-toplevel :execute)
   (when (find-package '#:kmr-mop)
     (pushnew :kmrtest-mop cl:*features*)))
 (eval-when (:compile-toplevel :load-toplevel :execute)
   (when (find-package '#:kmr-mop)
     (pushnew :kmrtest-mop cl:*features*)))