r5491: *** empty log message ***

diff --git a/lists.lisp b/lists.lisp
index 77b6fa52401157e11b78451156903100a4df6775..674a5d76b22d9977aff797b61e0d71d1b55d73bd 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.9 2003/07/31 07:32:11 kevin Exp $
+;;;; $Id: lists.lisp,v 1.10 2003/08/12 06:37:53 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
 ;;;;


@@ -42,13 +42,13 @@
     (unless (find elem l1)
       (setq l1 (append l1 (list elem))))))
 
     (unless (find elem l1)
       (setq l1 (append l1 (list elem))))))
 

-(defun remove-tree-if (pred tree)
+(defun remove-from-tree-if (pred tree)

   "Strip from tree of atoms that satistify predicate"
   (if (atom tree)
       (unless (funcall pred tree)
        tree)
   "Strip from tree of atoms that satistify predicate"
   (if (atom tree)
       (unless (funcall pred tree)
        tree)

-    (let ((car-strip (remove-tree-if pred (car tree)))
-         (cdr-strip (remove-tree-if pred (cdr tree))))
+    (let ((car-strip (remove-from-tree-if pred (car tree)))
+         (cdr-strip (remove-from-tree-if pred (cdr tree))))

       (cond
        ((and car-strip (atom (cadr tree)) (null cdr-strip))
        (list car-strip))
       (cond
        ((and car-strip (atom (cadr tree)) (null cdr-strip))
        (list car-strip))

diff --git a/package.lisp b/package.lisp
index f42dec56f13d339b57fb78b7b2a7316bbb03a1a5..1816cbafbbf40e121b7c1684fa4aa0ded8b8f1e1 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.57 2003/08/09 21:42:43 kevin Exp $
+;;;; $Id: package.lisp,v 1.58 2003/08/12 06:37:53 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
 ;;;;


@@ -80,7 +80,7 @@
    #:null-output-stream
    
    ;; lists.lisp
    #:null-output-stream
    
    ;; lists.lisp

-   #:remove-tree-if
+   #:remove-from-tree-if

    #:find-tree
    #:with-each-file-line
    #:with-each-stream-line
    #:find-tree
    #:with-each-file-line
    #:with-each-stream-line


@@ -132,10 +132,10 @@
    #:string-trim-last-character
    #:nstring-trim-last-character
    #:string-hash
    #:string-trim-last-character
    #:nstring-trim-last-character
    #:string-hash

-   #:string-not-null?
-   #:whitespace?
-   #:not-whitespace?
-   #:string-ws?
+   #:is-string-empty
+   #:is-char-whitespace
+   #:not-whitespace-char
+   #:is-string-whitespace

    #:string-invert
    #:escape-xml-string
    #:make-usb8-array
    #:string-invert
    #:escape-xml-string
    #:make-usb8-array

diff --git a/strings.lisp b/strings.lisp
index 4d999544d0983c9023b54cddac9e1f7136a5781a..7310bef870c744d9e4bf2a662e8f0f0a3ca50da0 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.51 2003/08/09 21:42:43 kevin Exp $
+;;;; $Id: strings.lisp,v 1.52 2003/08/12 06:37:53 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
 ;;;;


@@ -150,22 +150,17 @@
       (setq hash (+ hash (char-code (char str i)))))
     (logand hash bitmask)))
 
       (setq hash (+ hash (char-code (char str i)))))
     (logand hash bitmask)))
 

-(defun string-not-null? (str)
-  (and str (not (zerop (length str)))))
-  
-(defun whitespace? (c) 
-  (declare (character c))
-  (locally (declare (optimize (speed 3) (safety 0)))
-    (or (char= c #\Space) (char= c #\Tab) (char= c #\Return)
-       (char= c #\Linefeed))))
+(defun is-string-empty (str)
+  (zerop (length str)))

 
 

-(defun not-whitespace? (c)
-  (not (whitespace? c)))
+(defun is-char-whitespace (c) 
+  (declare (character c) (optimize (speed 3) (safety 0)))
+  (or (char= c #\Space) (char= c #\Tab) (char= c #\Return)
+      (char= c #\Linefeed)))

 
 

-(defun string-ws? (str)
+(defun is-string-whitespace (str)

   "Return t if string is all whitespace"
   "Return t if string is all whitespace"

-  (when (stringp str)
-    (null (find-if #'not-whitespace? str))))
+  (every #'is-char-whitespace str))

 
 (defun replaced-string-length (str repl-alist)
   (declare (simple-string str)
 
 (defun replaced-string-length (str repl-alist)
   (declare (simple-string str)


@@ -565,33 +560,33 @@ for characters in a string"
 
 (defun lex-string (string &key (whitespace '(#\space #\newline)))
   "Separates a string at whitespace and returns a list of strings"
 
 (defun lex-string (string &key (whitespace '(#\space #\newline)))
   "Separates a string at whitespace and returns a list of strings"

-  (flet ((whitespace? (char) (member char whitespace :test #'char=)))
+  (flet ((is-sep (char) (member char whitespace :test #'char=)))

     (let ((tokens nil))
       (do* ((token-start
     (let ((tokens nil))
       (do* ((token-start

-             (position-if-not #'whitespace? string) 
+             (position-if-not #'is-sep string) 

              (when token-end
              (when token-end

-               (position-if-not #'whitespace? string :start (1+ token-end))))
+               (position-if-not #'is-sep string :start (1+ token-end))))

             (token-end
              (when token-start
             (token-end
              (when token-start

-               (position-if #'whitespace? string :start token-start))
+               (position-if #'is-sep string :start token-start))

              (when token-start
              (when token-start

-               (position-if #'whitespace? string :start token-start))))
+               (position-if #'is-sep string :start token-start))))

            ((null token-start) (nreverse tokens))
         (push (subseq string token-start token-end) tokens)))))
 
 (defun split-alphanumeric-string (string)
   "Separates a string at any non-alphanumeric chararacter"
            ((null token-start) (nreverse tokens))
         (push (subseq string token-start token-end) tokens)))))
 
 (defun split-alphanumeric-string (string)
   "Separates a string at any non-alphanumeric chararacter"

-  (flet ((whitespace? (char) (non-alphanumericp char)))
+  (flet ((is-sep (char) (non-alphanumericp char)))

     (let ((tokens nil))
       (do* ((token-start
     (let ((tokens nil))
       (do* ((token-start

-             (position-if-not #'whitespace? string) 
+             (position-if-not #'is-sep string) 

              (when token-end
              (when token-end

-               (position-if-not #'whitespace? string :start (1+ token-end))))
+               (position-if-not #'is-sep string :start (1+ token-end))))

             (token-end
              (when token-start
             (token-end
              (when token-start

-               (position-if #'whitespace? string :start token-start))
+               (position-if #'is-sep string :start token-start))

              (when token-start
              (when token-start

-               (position-if #'whitespace? string :start token-start))))
+               (position-if #'is-sep string :start token-start))))

            ((null token-start) (nreverse tokens))
         (push (subseq string token-start token-end) tokens)))))
 
            ((null token-start) (nreverse tokens))
         (push (subseq string token-start token-end) tokens)))))