[prev in list] [next in list] [prev in thread] [next in thread] 

List:       sbcl-commits
Subject:    [Sbcl-commits] master: teach NODE-CONSERVATIVE-TYPE about union types
From:       "Nikodemus Siivola" <demoss () users ! sourceforge ! net>
Date:       2012-10-07 11:49:33
Message-ID: E1TKpMW-0006NO-9D () sfs-ml-2 ! v29 ! ch3 ! sourceforge ! com
[Download RAW message or body]

The branch "master" has been updated in SBCL:
       via  7374cac4bf6ad3b9f109e4a4d0558325b2cad230 (commit)
      from  99440adb9fc66f2713c4c4ba7b00ae278d9bc1eb (commit)

- Log -----------------------------------------------------------------
commit 7374cac4bf6ad3b9f109e4a4d0558325b2cad230
Author: Nikodemus Siivola <nikodemus@random-state.net>
Date:   Sun Oct 7 14:12:59 2012 +0300

    teach NODE-CONSERVATIVE-TYPE about union types
    
      Conservative type of STRING is STRING -- and this makes it so.
    
      Fixes lp#1050768 (but also future-proof ARRAY-IN-BOUNDS-P against
      '*) explicitly.
---
 NEWS                         |    2 ++
 src/compiler/array-tran.lisp |    5 +++++
 src/compiler/ir1opt.lisp     |    7 +++++++
 tests/compiler.pure.lisp     |   16 ++++++++++++++++
 4 files changed, 30 insertions(+), 0 deletions(-)

diff --git a/NEWS b/NEWS
index 29bfc32..9057028 100644
--- a/NEWS
+++ b/NEWS
@@ -10,6 +10,8 @@ changes relative to sbcl-1.1.0:
     (thanks to SANO Masatoshi)
   * bug fix: PARSE-NATIVE-NAMESTRING performed non-native parsing when
     :JUNK-ALLOWED was true.
+  * bug fix: type derivation inferred overly conservative types for
+    unions of array types. (lp#1050768)
 
 changes in sbcl-1.1.0 relative to sbcl-1.0.58:
   * enhancement: New variable, sb-ext:*disassemble-annotate* for controlling
diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp
index 0cf9279..baf1b98 100644
--- a/src/compiler/array-tran.lisp
+++ b/src/compiler/array-tran.lisp
@@ -169,6 +169,11 @@
     (block nil
       (let ((dimensions (array-type-dimensions-or-give-up
                          (lvar-conservative-type array))))
+        ;; Might be *. (Note: currently this is never true, because the type
+        ;; derivation infers the rank from the call to ARRAY-IN-BOUNDS-P, but
+        ;; let's keep this future proof.)
+        (when (eq '* dimensions)
+          (give-up-ir1-transform "array bounds unknown"))
         ;; shortcut for zero dimensions
         (when (some (lambda (dim)
                       (and (bound-known-p dim) (zerop dim)))
diff --git a/src/compiler/ir1opt.lisp b/src/compiler/ir1opt.lisp
index 7d4fdd2..dc6769b 100644
--- a/src/compiler/ir1opt.lisp
+++ b/src/compiler/ir1opt.lisp
@@ -166,7 +166,14 @@
               :specialized-element-type (array-type-specialized-element-type type))
              ;; Simple arrays cannot change at all.
              type))
+        ((union-type-p type)
+         ;; Conservative union type is an union of conservative types.
+         (let ((res *empty-type*))
+           (dolist (part (union-type-types type) res)
+             (setf res (type-union res (conservative-type part))))))
         (t
+         ;; Catch-all.
+         ;;
          ;; If the type contains some CONS types, the conservative type contains all
          ;; of them.
          (when (types-equal-or-intersect type (specifier-type 'cons))
diff --git a/tests/compiler.pure.lisp b/tests/compiler.pure.lisp
index 85d4d1c..7d8faf1 100644
--- a/tests/compiler.pure.lisp
+++ b/tests/compiler.pure.lisp
@@ -4341,3 +4341,19 @@
                                 (cons (or (car x) (meh)))
                                 (t (meh)))))))
                    (funcall (eh x)))) t t)))
+
+(with-test (:name (:bug-1050768 :symptom))
+  ;; Used to signal an error.
+  (compile nil
+           `(lambda (string position)
+              (char string position)
+              (array-in-bounds-p string (1+ position)))))
+
+(with-test (:name (:bug-1050768 :cause))
+  (let ((types `((string string)
+                 ((or (simple-array character 24) (vector t 24))
+                  (or (simple-array character 24) (vector t))))))
+    (dolist (pair types)
+      (destructuring-bind (orig conservative) pair
+        (assert sb-c::(type= (specifier-type cl-user::conservative)
+                             (conservative-type (specifier-type cl-user::orig))))))))

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL

------------------------------------------------------------------------------
Don't let slow site performance ruin your business. Deploy New Relic APM
Deploy New Relic app performance management and know exactly
what is happening inside your Ruby, Python, PHP, Java, and .NET app
Try New Relic at no cost today and get our sweet Data Nerd shirt too!
http://p.sf.net/sfu/newrelic-dev2dev
_______________________________________________
Sbcl-commits mailing list
Sbcl-commits@lists.sourceforge.net
https://lists.sourceforge.net/lists/listinfo/sbcl-commits
[prev in list] [next in list] [prev in thread] [next in thread]