[movitz-cvs] CVS movitz/losp/muerte

ffjeld ffjeld at common-lisp.net
Sun Jul 19 18:51:28 UTC 2009


Update of /project/movitz/cvsroot/movitz/losp/muerte
In directory cl-net:/tmp/cvs-serv16502

Modified Files:
	characters.lisp 
Log Message:
Tweak char/= and char= for ansi-tests.


--- /project/movitz/cvsroot/movitz/losp/muerte/characters.lisp	2008/04/27 19:30:12	1.6
+++ /project/movitz/cvsroot/movitz/losp/muerte/characters.lisp	2009/07/19 18:51:26	1.7
@@ -10,7 +10,7 @@
 ;;;; Author:        Frode Vatvedt Fjeld <frodef at acm.org>
 ;;;; Created at:    Mon Feb  5 19:05:01 2001
 ;;;;                
-;;;; $Id: characters.lisp,v 1.6 2008/04/27 19:30:12 ffjeld Exp $
+;;;; $Id: characters.lisp,v 1.7 2009/07/19 18:51:26 ffjeld Exp $
 ;;;;                
 ;;;;------------------------------------------------------------------
 
@@ -53,25 +53,23 @@
 (defun char= (first-character &rest characters)
   (numargs-case
    (2 (x y)
-      (and (eql x y) 'pinglo))
+      (eql x y))
    (t (first-character &rest characters)
       (declare (dynamic-extent characters))
-      (dolist (c characters 'dumbolo)
+      (dolist (c characters t)
 	(unless (char= c first-character)
 	  (return nil))))))
 
 (defun char/= (first-character &rest characters)
   (numargs-case
+   (1 (x) (declare (ignore x)) t)
    (2 (x y) (not (eql x y)))
-   (t (&rest characters)
-      (declare (dynamic-extent characters))
-      (do ((p (cdr characters) (cdr p)))
-	  ((null p) t)
-	(do ((v characters (cdr v)))
-	    ((eq p v))
-	  (when (eql (car p) (car v))
-	    (return-from char/= nil)))))))
-
+   (t (first-character &rest more-characters)
+      (declare (dynamic-extent more-characters))
+      (do ((c first-character (pop more-characters)))
+          ((null more-characters) t)
+        (when (member c more-characters)
+          (return nil))))))
 
 (defmacro/cross-compilation define-char-cmp (name mode not-branch)
   `(defun ,name (first-character &rest more-characters)





More information about the Movitz-cvs mailing list