GitLab

at 2024-06-03T16:55:26-07:00

Use inclusive range for character ranges

First, make the range checks be inclusive instead of exclusive to make
it easier to reason about.  Second, replace the character codes with
the corresponding character so 64 becomes `(char-code #\A)`, which is
much more obvious what the character is.

@@ -258,7 +258,7 @@
    (declare (character char))
    (and (typep char 'base-char)
         (let ((m (char-code (the base-char char))))
 -	 (or (< 31 m 127)
 +	 (or (<= (char-code #\space ) m (char-code #\~))
  	     #+(and unicode (not unicode-bootstrap))
  	     (and (> m +ascii-limit+)
  		  (>= (unicode-category m) +unicode-category-graphic+))))))
@@ -269,7 +269,8 @@
    argument is an alphabetic character; otherwise NIL."
    (declare (character char))
    (let ((m (char-code char)))
 -    (or (< 64 m 91) (< 96 m 123)
 +    (or (<= (char-code #\A) m (char-code #\Z))
 +        (<= (char-code #\a) m (char-code #\z))
  	#+(and unicode (not unicode-bootstrap))
  	(and (> m +ascii-limit+)
  	     (<= +unicode-category-letter+ (unicode-category m)
@@ -281,7 +282,7 @@
    argument is an upper-case character, NIL otherwise."
    (declare (character char))
    (let ((m (char-code char)))
 -    (or (< 64 m 91)
 +    (or (<= (char-code #\A) m (char-code #\Z))
  	#+(and unicode (not unicode-bootstrap))
  	(and (> m +ascii-limit+)
               (not (zerop (ldb +lower-case-entry+ (case-mapping-entry m))))))))
@@ -292,7 +293,7 @@
    argument is a lower-case character, NIL otherwise."
    (declare (character char))
    (let ((m (char-code char)))
 -    (or (< 96 m 123)
 +    (or (<= (char-code #\a) m (char-code #\z))
  	#+(and unicode (not unicode-bootstrap))
  	(and (> m +ascii-limit+)
               (not (zerop (ldb +upper-case-entry+ (case-mapping-entry m))))))))
@@ -303,7 +304,8 @@
    both upper and lower case.  For ASCII, this is the same as Alpha-char-p."
    (declare (character char))
    (let ((m (char-code char)))
 -    (or (< 64 m 91) (< 96 m 123)
 +    (or (<= (char-code #\A) m (char-code #\Z))
 +        (<= (char-code #\a) m (char-code #\z))
  	#+(and unicode (not unicode-bootstrap))
  	(and (> m +ascii-limit+)
               (not (zerop (case-mapping-entry m)))))))
@@ -335,7 +337,9 @@
    (declare (character char))
    (let ((m (char-code char)))
      ;; Shortcut for ASCII digits and upper and lower case ASCII letters
 -    (or (< 47 m 58) (< 64 m 91) (< 96 m 123)
 +    (or (<= (char-code #\0) m (char-code #\9))
 +        (<= (char-code #\A) m (char-code #\Z))
 +        (<= (char-code #\a) m (char-code #\z))
  	#+(and unicode (not unicode-bootstrap))
  	(and (> m +ascii-limit+)
  	     (<= +unicode-category-letter+ (unicode-category m)

@@ -3343,7 +3343,7 @@
         x)
    #+(and unicode (not unicode-bootstrap))
    '(let ((m (char-code x)))
 -    (cond ((< (char-code #\`) m (char-code #\{))
 +    (cond ((<= (char-code #\a) m (char-code #\z))
             (code-char (logxor m #x20)))
            ((> m lisp::+ascii-limit+)
             (code-char (lisp::case-mapping-upper-case m)))
@@ -3357,7 +3357,7 @@
         x)
    #+(and unicode (not unicode-bootstrap))
    '(let ((m (char-code x)))
 -    (cond ((< (char-code #\@) m (char-code #\[))
 +    (cond ((<= (char-code #\A) m (char-code #\Z))
             (code-char (logxor m #x20)))
            ((> m lisp::+ascii-limit+)
             (code-char (lisp::case-mapping-lower-case m)))

Raymond Toy pushed to branch issue-326-char-casing-cleanup at cmucl / cmucl

Commits:

2 changed files:

Changes: