Changeset 11226


Ignore:
Timestamp:
Oct 26, 2008, 8:51:21 AM (11 years ago)
Author:
gb
Message:

Use the new (bitmap) scheme to determine the ALPHA part of ALPHANUMERICP.

Use the newer (year-old ...) scheme to determine UPPER-CASE-P, LOWER-CASE-P.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/lib/chars.lisp

    r10372 r11226  
    8888  "The argument must be a character object; UPPER-CASE-P returns T if the
    8989   argument is an upper-case character, NIL otherwise."
    90   (let* ((code (char-code c)))
    91     (declare (type (mod #x110000) code))
    92     (or (and (>= code (char-code #\A))
    93              (<= code (char-code #\Z)))
    94         (and (>= code #x80)
    95              (not (null (%non-standard-lower-case-equivalent c)))))))
     90  (let* ((code (char-code c))
     91         (to-lower *upper-to-lower*))
     92    (declare (type (mod #x110000) code)
     93             (type (simple-array (signed-byte 16) *to-lower)))
     94    (and (< code (length to-lower))
     95         (not (zerop (aref to-lower code))))))
    9696
    9797
     
    102102  argument is an alphabetic character and if the character exists in
    103103  both upper and lower case. For ASCII, this is the same as ALPHA-CHAR-P."
    104   (let* ((code (char-code c)))
    105     (declare (type (mod #x110000) code))
    106     (or (and (>= code (char-code #\A))
    107              (<= code (char-code #\Z)))
    108         (and (>= code (char-code #\a))
    109              (<= code (char-code #\z)))
    110         (and (>= code #x80)
    111              (or (not (null (%non-standard-upper-case-equivalent c)))
    112                  (not (null (%non-standard-lower-case-equivalent c))))))))
     104  (let* ((code (char-code c))
     105         (to-upper *lower-to-upper*)
     106         (to-lower *upper-to-lower*))
     107    (declare (type (mod #x110000) code)
     108             (type (simple-array (signed-byte 16) (*)) to-lower to-upper))
     109    (or (and (< code (length to-upper))
     110             (not (zerop (aref to-upper code))))
     111        (and (< code (length to-lower))
     112             (not (zerop (aref to-lower code)))))))
    113113 
    114114(defun alphanumericp (c)
     
    120120     (and (>= code (char-code #\0))
    121121          (<= code (char-code #\9)))
    122      (and (>= code (char-code #\a))
    123           (<= code (char-code #\z)))
    124      (and (>= code (char-code #\A))
    125           (<= code (char-code #\Z)))
    126      (and (> code #x80)
    127           (or (not (null (%non-standard-upper-case-equivalent c)))
    128               (not (null (%non-standard-lower-case-equivalent c))))))))
     122     (let* ((bits *alpha-char-bits*))
     123       (declare (simple-bit-vector bits))
     124       (and (< code (length bits))
     125            (not (eql 0 (sbit bits code))))))))
    129126
    130127(defun char= (ch &rest others)
     
    313310  (unless (typep string 'simple-string)
    314311    (check-type string simple-string))
    315   (do* ((i start (1+ i)))
     312  (do* ((i start (1+ i))
     313        (to-lower *upper-to-lower*)
     314        (n (length to-lower)))
    316315       ((>= i end) string)
    317     (declare (fixnum i))
     316    (declare (fixnum i n) (type (simple-array (signed-byte 16) (*)) to-lower))
    318317    (let* ((ch (schar string i))
    319318           (code (char-code ch))
    320            (lower (if (and (char<= ch #\Z)
    321                            (char>= ch #\A))
    322                     (%code-char (the (unsigned-byte 8)
    323                                   (+ code (- (char-code #\a)(char-code #\A)))))
    324                     (if (>= code #x80)
    325                       (%non-standard-lower-case-equivalent ch)))))
    326       (declare (character ch) (type (mod #x110000) code))
    327       (when lower
    328         (setf (schar string i) lower)))))
     319           (delta (if (< code n) (aref to-lower code) 0)))
     320      (declare (character ch)
     321               (type (mod #x110000) code)
     322               (type (signed-byte 16) delta))
     323      (unless (zerop delta)
     324        (setf (schar string i)
     325              (code-char (the valid-char-code (+ code delta))))))))
    329326
    330327
     
    354351  (unless (typep string 'simple-string)
    355352    (check-type string simple-string))
    356   (do* ((i start (1+ i)))
     353  (do* ((i start (1+ i))
     354        (to-upper *lower-to-upper*)
     355        (n (length to-upper)))
    357356       ((>= i end) string)
    358     (declare (fixnum i))
     357    (declare (fixnum i n) (type (simple-array (signed-byte 16) (*)) to-upper))
    359358    (let* ((ch (schar string i))
    360359           (code (char-code ch))
    361            (upper (if (and (char<= ch #\z)
    362                            (char>= ch #\a))
    363                     (%code-char (the (unsigned-byte 8)
    364                                   (- code (- (char-code #\a)(char-code #\A)))))
    365                     (if (>= code #x80)
    366                       (%non-standard-upper-case-equivalent ch)))))
    367       (declare (character ch) (type (mod #x110000) code))
    368       (when upper
    369         (setf (schar string i) upper)))))
     360           (delta (if (< code n) (aref to-upper code) 0)))
     361      (declare (character ch)
     362               (type (mod #x110000) code)
     363               (type (signed-byte 16) delta))
     364      (unless (zerop delta)
     365        (setf (schar string i) (code-char (the valid-char-code (+ code delta))))))))
    370366
    371367
Note: See TracChangeset for help on using the changeset viewer.