Diff for /mmondor/mmsoftware/cl/server/character.lisp between versions 1.4 and 1.5

--- /home/data/anoncvs/cvsroot/mmondor/mmsoftware/cl/server/character.lisp	2012/09/13 13:01:22	1.4
+++ /home/data/anoncvs/cvsroot/mmondor/mmsoftware/cl/server/character.lisp	2012/09/15 01:52:24	1.5
@@ -1,4 +1,4 @@
-;;; $Id: character.lisp,v 1.4 2012/09/13 13:01:22 mmondor Exp $
+;;; $Id: character.lisp,v 1.5 2012/09/15 01:52:24 mmondor Exp $
 
 #|
 
@@ -40,12 +40,13 @@ THIS SOFTWARE, EVEN IF ADVISED OF THE PO
 	   #:character-intervals
 	   #:make-valid-character-table
 	   #:character-valid-p
-	   #:string-valid-p))
+	   #:string-valid-p
+	   #:member-character-intervals-p))
 
 (in-package :character)
 
 (defparameter *rcsid*
-  "$Id: character.lisp,v 1.4 2012/09/13 13:01:22 mmondor Exp $")
+  "$Id: character.lisp,v 1.5 2012/09/15 01:52:24 mmondor Exp $")
 
 
 ;;; UTF-8
@@ -298,3 +299,29 @@ all characters of STRING are valid, or N
 		  nil))
      do (return nil)
      finally (return t)))
+
+(defmacro member-character-intervals-p (char &rest list)
+  "Utility macro to generate a test for character CHAR matching the
+character interval(s) specified by LIST, using the same syntax which
+CHARACTER-INTERVALS expects.  This may be more optimized than calling
+a function or referencing to dynamic symbols bound to tables.
+CHAR is compared to the specified ranges from largest to shortest range,
+then to individual characters, if any."
+  (flet ((range-weight (range)
+	   (if (listp range)
+	       (destructuring-bind (from-char to-char) range
+		 (- (char-code to-char) (char-code from-char)))
+	       0)))
+    (let ((intervals (sort list #'> :key #'range-weight))
+	  (s-code (gensym)))
+      `(let ((,s-code (char-code ,char)))
+	 (declare (optimize (speed 3) (safety 0) (debug 0))
+		  (type fixnum ,s-code))
+	 (or ,@(mapcar #'(lambda (range)
+			   (if (listp range)
+			       (destructuring-bind (from-char to-char) range
+				 `(<= ,(char-code from-char)
+				      ,s-code
+				      ,(char-code to-char)))
+			       `(= ,(char-code range) ,s-code)))
+		       intervals))))))

Diff format: