From d3a88acfecf83fc695ca7b6e247ec735c85625bf Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Sun, 11 May 2003 21:54:47 +0000 Subject: [PATCH] r4900: *** empty log message *** --- debian/changelog | 6 ++++++ lists.lisp | 26 +++++++++----------------- strings.lisp | 8 +++++--- tests.lisp | 6 +++++- 4 files changed, 25 insertions(+), 21 deletions(-) diff --git a/debian/changelog b/debian/changelog index 217e085..578b3d0 100644 --- a/debian/changelog +++ b/debian/changelog @@ -1,3 +1,9 @@ +cl-kmrcl (1.44-1) unstable; urgency=low + + * New upstream + + -- Kevin M. Rosenberg Sun, 11 May 2003 15:52:08 -0600 + cl-kmrcl (1.43a-1) unstable; urgency=low * Remove .fasl files diff --git a/lists.lisp b/lists.lisp index a7ae3d1..6b0edb2 100644 --- a/lists.lisp +++ b/lists.lisp @@ -7,7 +7,7 @@ ;;;; 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 ;;;; @@ -26,19 +26,15 @@ (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))) - (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" - (dolist (elem l2) + (dolist (elem l2 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" @@ -122,17 +118,13 @@ (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))) - (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 f382fe9..6348eec 100644 --- a/strings.lisp +++ b/strings.lisp @@ -7,7 +7,7 @@ ;;;; 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 ;;;; @@ -86,8 +86,10 @@ (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) diff --git a/tests.lisp b/tests.lisp index b68cecf..bdeaa27 100644 --- a/tests.lisp +++ b/tests.lisp @@ -7,7 +7,7 @@ ;;;; 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 ;;;; @@ -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 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*))) -- 2.34.1