X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fsrctran.lisp;h=c808988499c711bd19b13aba32bafd4761a24a64;hb=debae3c18d31b5222be4d5de8dcb2601336e24a4;hp=7384efa89bf1ba8acbf3a04c2d07275ebea4168b;hpb=5c52e958cbff33e64084bc165813c90ca0e39085;p=sbcl.git

diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index 7384efa..c808988 100644
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -242,7 +242,7 @@
    (t (values nil t))))
 (define-source-transform get (&rest args)
   (case (length args)
-   (2 `(sb!impl::get2 ,@args))
+   (2 `(sb!impl::get3 ,@args nil))
    (3 `(sb!impl::get3 ,@args))
    (t (values nil t))))
 
@@ -2522,7 +2522,7 @@
             `(mod ,base-char-code-limit)))
           (t
            (specifier-type
-            `(mod ,char-code-limit))))))
+            `(mod ,sb!xc:char-code-limit))))))
 
 (defoptimizer (code-char derive-type) ((code))
   (let ((type (lvar-type code)))
@@ -3185,7 +3185,7 @@
         ,(lvar-value x))
       (give-up-ir1-transform)))
 
-(dolist (x '(= char= + * logior logand logxor logtest))
+(dolist (x '(= char= two-arg-char-equal + * logior logand logxor logtest))
   (%deftransform x '(function * *) #'commutative-arg-swap
                  "place constant arg last"))
 
@@ -3707,7 +3707,8 @@
 
 ;;;; character operations
 
-(deftransform char-equal ((a b) (base-char base-char))
+(deftransform two-arg-char-equal ((a b) (base-char base-char) *
+                                  :policy (> speed space))
   "open code"
   '(let* ((ac (char-code a))
           (bc (char-code b))
@@ -3719,6 +3720,19 @@
                  (and (> sum 415) (< sum 461))
                  (and (> sum 463) (< sum 477))))))))
 
+(deftransform two-arg-char-equal ((a b) (* (constant-arg character)) *
+                                  :node node)
+  (let ((char (lvar-value b)))
+    (if (both-case-p char)
+        (let ((reverse (if (upper-case-p char)
+                           (char-downcase char)
+                           (char-upcase char))))
+          (if (policy node (> speed space))
+              `(or (char= a ,char)
+                   (char= a ,reverse))
+              `(char-equal-constant a ,char ,reverse)))
+        '(char= a b))))
+
 (deftransform char-upcase ((x) (base-char))
   "open code"
   '(let ((n-code (char-code x)))
@@ -4054,15 +4068,15 @@
                                                             'character))
 
 (define-source-transform char-equal (&rest args)
-  (multi-compare 'sb!impl::two-arg-char-equal args nil 'character t))
+  (multi-compare 'two-arg-char-equal args nil 'character t))
 (define-source-transform char-lessp (&rest args)
-  (multi-compare 'sb!impl::two-arg-char-lessp args nil 'character t))
+  (multi-compare 'two-arg-char-lessp args nil 'character t))
 (define-source-transform char-greaterp (&rest args)
-  (multi-compare 'sb!impl::two-arg-char-greaterp args nil 'character t))
+  (multi-compare 'two-arg-char-greaterp args nil 'character t))
 (define-source-transform char-not-greaterp (&rest args)
-  (multi-compare 'sb!impl::two-arg-char-greaterp args t 'character t))
+  (multi-compare 'two-arg-char-greaterp args t 'character t))
 (define-source-transform char-not-lessp (&rest args)
-  (multi-compare 'sb!impl::two-arg-char-lessp args t 'character t))
+  (multi-compare 'two-arg-char-lessp args t 'character t))
 
 ;;; This function does source transformation of N-arg inequality
 ;;; functions such as /=. This is similar to MULTI-COMPARE in the <3