Changeset 15404


Ignore:
Timestamp:
May 31, 2012, 8:15:45 PM (7 years ago)
Author:
gb
Message:

STRING-COMPARE case-folds non-standard-chars.
(In case you were wondering: it's 2012, and CCL has nominally supported
Unicode since ~2006.)

File:
1 edited

Legend:

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

    r13067 r15404  
    473473      (multiple-value-setq (string2 start2 end2)(string-start-end string2 start2 end2)))
    474474    (setq istart1 (%i- start1 istart1))
    475     (let* ((val t))
    476       (declare (optimize (speed 3)(safety 0)))
    477       (do* ((i start1 (%i+ 1 i))
    478             (j start2 (%i+ 1 j)))
     475    (let* ((val t)
     476           (to-upper *lower-to-upper*)
     477           (n (length to-upper)))
     478      (declare (optimize (speed 3)(safety 0))
     479               (type (simple-array (signed-byte 16) (*)) to-upper)
     480               (fixnum n))
     481      (do* ((i start1 (+ 1 i))
     482            (j start2 (+ 1 j)))
    479483           ()
     484        (declare (fixnum i j))
    480485        (when (eq i end1)
    481486          (when (neq j end2)
     
    486491          (setq val 1)
    487492          (return))
    488         (let ((code1 (%scharcode string1 i))
    489               (code2 (%scharcode string2 j)))
    490           (declare (fixnum code1 code2))
    491           (if (and (>= code1 (char-code #\a))
    492                    (<= code1 (char-code #\z)))
    493             (setq code1 (- code1 (- (char-code #\a) (char-code #\A)))))
    494           (if (and (>= code2 (char-code #\a))
    495                    (<= code2 (char-code #\z)))
    496             (setq code2 (- code2 (- (char-code #\a) (char-code #\A)))))
     493        (let* ((code1 (%scharcode string1 i))
     494               (code2 (%scharcode string2 j)))
     495          (declare (type (mod #x11000) code1 code2))
     496          (if (< code1 n)
     497            (setq code1 (+ (aref to-upper code1) code1)))
     498          (if (< code2 n)
     499            (setq code2 (+ (aref to-upper code2) code2)))
    497500          (unless (= code1 code2)           
    498             (setq val (if (%i< code1 code2) -1 1))
     501            (setq val (if (< code1 code2) -1 1))
    499502            (setq end1 i)
    500503            (return))))
Note: See TracChangeset for help on using the changeset viewer.