From: Nikodemus Siivola <nikodemus@random-state.net>
Date: Fri, 2 Jan 2009 16:05:28 +0000 (+0000)
Subject: 1.0.24.7: CHAR-CODE type derivation
X-Git-Url: http://repo.macrolet.net/gitweb/?a=commitdiff_plain;h=35ec0bb705547bffbbd8032898f47135de8f40d8;p=sbcl.git

1.0.24.7: CHAR-CODE type derivation

 * Patch by Paul Khuong.
---

diff --git a/NEWS b/NEWS
index e1ac562..4aec9ca 100644
--- a/NEWS
+++ b/NEWS
@@ -10,6 +10,9 @@ changes in sbcl-1.0.25 relative to 1.0.24:
   * improvement: GET-SETF-EXPANDER avoids adding bindings for constant
     arguments, making compiler-macros for SETF-functions able to inspect
     their constant arguments.
+  * optimization: CHAR-CODE type derivation has been improved, making
+    TYPEP elimination on subtypes of CHARACTER work better. (reported
+    by Tobias Rittweiler, patch by Paul Khuong)
 
 changes in sbcl-1.0.24 relative to 1.0.23:
   * new feature: ARRAY-STORAGE-VECTOR provides access to the underlying data
diff --git a/OPTIMIZATIONS b/OPTIMIZATIONS
index de7e3c3..55f86c4 100644
--- a/OPTIMIZATIONS
+++ b/OPTIMIZATIONS
@@ -173,8 +173,7 @@ NULL-TN directly.
       (declare (dynamic-extent l))
       (mapc #'print l))))
 
-Result of MAKE is not stack allocated, which means that
-stack-allocation of structures is impossible.
+Result of MAKE is not stack allocated.
 --------------------------------------------------------------------------------
 #22
 IR2 does not perform unused code flushing.
diff --git a/src/compiler/srctran.lisp b/src/compiler/srctran.lisp
index eca0cc2..623683e 100644
--- a/src/compiler/srctran.lisp
+++ b/src/compiler/srctran.lisp
@@ -2616,6 +2616,27 @@
              (hi-res (if hi (isqrt hi) '*)))
         (specifier-type `(integer ,lo-res ,hi-res))))))
 
+(defoptimizer (char-code derive-type) ((char))
+  (let ((type (type-intersection (lvar-type char) (specifier-type 'character))))
+    (cond ((member-type-p type)
+           (specifier-type
+            `(member
+              ,@(loop for member in (member-type-members type)
+                      when (characterp member)
+                      collect (char-code member)))))
+          ((sb!kernel::character-set-type-p type)
+           (specifier-type
+            `(or
+              ,@(loop for (low . high)
+                      in (character-set-type-pairs type)
+                      collect `(integer ,low ,high)))))
+          ((csubtypep type (specifier-type 'base-char))
+           (specifier-type
+            `(mod ,base-char-code-limit)))
+          (t
+           (specifier-type
+            `(mod ,char-code-limit))))))
+
 (defoptimizer (code-char derive-type) ((code))
   (let ((type (lvar-type code)))
     ;; FIXME: unions of integral ranges?  It ought to be easier to do
diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index e913df3..7dcc183 100644
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -2683,3 +2683,10 @@
                nil)
     (assert (eq 'list type))
     (assert derivedp)))
+
+(with-test (:name :base-char-typep-elimination)
+  (assert (eq (funcall (lambda (ch)
+                         (declare (type base-char ch) (optimize (speed 3) (safety 0)))
+                         (typep ch 'base-char))
+                       t)
+              t)))
diff --git a/version.lisp-expr b/version.lisp-expr
index 8f1f978..b1214b4 100644
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.24.6"
+"1.0.24.7"