Changeset 10373


Ignore:
Timestamp:
Aug 6, 2008, 11:09:58 AM (11 years ago)
Author:
gb
Message:

Compiler-macros for case-folding.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/source/compiler/optimizers.lisp

    r10353 r10373  
    19601960  (if (null others)
    19611961    (if other-p
    1962       `(eq (%char-code (char-upcase ,ch)) (%char-code (char-upcase ,other)))
     1962      `(eq (%char-code-upcase (char-code ,ch)) (%char-code-upcase (char-code ,other)))
    19631963      `(progn (char-code ,ch) t))
    19641964    (if (null (cdr others))
     
    19671967             (code2 (gensym))
    19681968             (code3 (gensym)))
    1969         `(let* ((,code (%char-code (char-upcase ,ch)))
    1970                 (,code2 (%char-code (char-upcase ,other)))
    1971                 (,code3 (%char-code (char-upcase ,third))))
     1969        `(let* ((,code (%char-code-upcase (char-code ,ch)))
     1970                (,code2 (%char-code-upcase (char-code ,other)))
     1971                (,code3 (%char-code-upcase (char-code ,third))))
    19721972          (and (eq ,code ,code2)
    19731973           (eq ,code ,code3))))
     
    21042104        (and (integerp ,val) (not (< ,val 0)))))))
    21052105
    2106 (define-compiler-macro register-istruct-cell (&whole w arg)
    2107   (if (and (quoted-form-p arg)
    2108            (cadr arg)
    2109            (typep (cadr arg) 'symbol))
    2110     `',(register-istruct-cell (cadr arg))
    2111     w))
     2106(define-compiler-macro string-equal (&whole w s1 s2 &rest keys)
     2107  (if (null keys)
     2108    `(%fixed-string-equal ,s1 ,s2)
     2109    (let* ((s1-arg (gensym))
     2110           (s2-arg (gensym)))
     2111      `(funcall
     2112        (lambda (,s1-arg ,s2-arg &key start1 end1 start2 end2)
     2113          (%bounded-string-equal ,s1-arg ,s2-arg start1 end1 start2 end2))
     2114        ,s1 ,s2 ,@keys))))
     2115
    21122116
    21132117;;; Try to use "package-references" to speed up package lookup when
     
    21582162      w)))
    21592163
     2164
     2165
     2166(define-compiler-macro %char-code-case-fold (&whole w code vector &environment env)
     2167  (if (nx-open-code-in-line env)
     2168    (let* ((c (gensym))
     2169           (table (gensym)))
     2170      `(let* ((,c ,code)
     2171              (,table ,vector))
     2172        (declare (type (mod #x110000) ,c)
     2173                 (type (simple-array (signed-byte 16) (*)) ,table))
     2174        (if (< ,c (length ,table))
     2175          (the fixnum (+ ,c (the (signed-byte 16)
     2176                              (locally (declare (optimize (speed 3) (safety 0)))
     2177                                (aref ,table ,c)))))
     2178          ,c)))
     2179    w))
     2180       
     2181(define-compiler-macro %char-code-upcase (&whole w code &environment env)
     2182  (if (typep code '(mod #x110000))
     2183    (%char-code-upcase code)
     2184    `(%char-code-case-fold ,code *lower-to-upper*)))
     2185
     2186(define-compiler-macro %char-code-downcase (&whole w code &environment env)
     2187  (if (typep code '(mod #x110000))
     2188    (%char-code-downcase code)
     2189    `(%char-code-case-fold ,code *upper-to-lower*)))
     2190
     2191(define-compiler-macro char-upcase (char)
     2192  `(code-char (the valid-char-code (%char-code-upcase (char-code ,char)))))
     2193
     2194(define-compiler-macro char-downcase (char)
     2195  `(code-char (the valid-char-code (%char-code-downcase (char-code ,char)))))
     2196
     2197
     2198(define-compiler-macro register-istruct-cell (&whole w arg)
     2199  (if (and (quoted-form-p arg)
     2200           (cadr arg)
     2201           (typep (cadr arg) 'symbol))
     2202    `',(register-istruct-cell (cadr arg))
     2203    w))
     2204
    21602205(define-compiler-macro get-character-encoding (&whole w name)
    21612206  (or (if (typep name 'keyword) (lookup-character-encoding name))
Note: See TracChangeset for help on using the changeset viewer.