[Sbcl-commits] master: Transform and derive types of set functions.

[stassats <sta...@us...>]

The branch "master" has been updated in SBCL:
       via  e6a1a0b2f7230eaa6ef8d6890a0113b4cbe0dfe8 (commit)
      from  93cc5e2c7a3c1e3380c7baa0983fdce9b07626b7 (commit)

- Log -----------------------------------------------------------------
commit e6a1a0b2f7230eaa6ef8d6890a0113b4cbe0dfe8
Author: Stas Boukarev <sta...@gm...>
Date:   Fri Jun 17 19:15:19 2016 +0300

    Transform and derive types of set functions.
    
    If one of the arguments is NIL or non-NIL INTERSECTION/UNION/etc. can
    either derive a better type or be transformed.
    
    Closes lp#1592152.
---
 NEWS                      |    5 ++++
 src/compiler/seqtran.lisp |   53 +++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 58 insertions(+), 0 deletions(-)

diff --git a/NEWS b/NEWS
index dec464e..915688d 100644
--- a/NEWS
+++ b/NEWS
@@ -1,5 +1,10 @@
 ;;;; -*- coding: utf-8; fill-column: 78 -*-
 
+changes relative to sbcl-1.3.6:
+  * optimization: faster operations on list-sets.
+  * optimization: better type derivition of set functions.
+    (lp#1592152)
+
 changes in sbcl-1.3.6 relative to sbcl-1.3.5:
   * bug fix: do not insert conditional newlines in print-unreadable-object
     (lp#1398290). This reverses a change made in lp#488979 which reversed
diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp
index 78f3819..ef85967 100644
--- a/src/compiler/seqtran.lisp
+++ b/src/compiler/seqtran.lisp
@@ -1996,3 +1996,56 @@
 
 (deftransform nreverse ((sequence) (list) * :important nil)
   `(sb!impl::list-nreverse sequence))
+
+(deftransform nintersection ((list1 list2 &rest args))
+  (let ((null-type (specifier-type 'null)))
+    (if (or (csubtypep (lvar-type list1) null-type)
+            (csubtypep (lvar-type list2) null-type))
+        nil
+        (give-up-ir1-transform))))
+
+(deftransform intersection ((list1 list2 &rest args))
+  (let ((null-type (specifier-type 'null)))
+    (if (or (csubtypep (lvar-type list1) null-type)
+            (csubtypep (lvar-type list2) null-type))
+        nil
+        (give-up-ir1-transform))))
+
+(defoptimizer (union derive-type) ((list1 list2 &rest args))
+  (declare (ignore args))
+  (let ((cons-type (specifier-type 'cons)))
+    (if (or (csubtypep (lvar-type list1) cons-type)
+            (csubtypep (lvar-type list2) cons-type))
+        cons-type
+        (specifier-type 'list))))
+
+(defoptimizer (nunion derive-type) ((list1 list2 &rest args))
+  (declare (ignore args))
+  (let ((cons-type (specifier-type 'cons)))
+    (if (or (csubtypep (lvar-type list1) cons-type)
+            (csubtypep (lvar-type list2) cons-type))
+        cons-type
+        (specifier-type 'list))))
+
+(deftransform set-difference ((list1 list2 &rest args))
+  (let ((null-type (specifier-type 'null)))
+    (cond ((csubtypep (lvar-type list1) null-type)
+           nil)
+          ((csubtypep (lvar-type list2) null-type)
+           'list1)
+          (t
+           (give-up-ir1-transform)))))
+
+(deftransform nset-difference ((list1 list2 &rest args))
+  (let ((null-type (specifier-type 'null)))
+    (cond ((csubtypep (lvar-type list1) null-type)
+           nil)
+          ((csubtypep (lvar-type list2) null-type)
+           'list1)
+          (t
+           (give-up-ir1-transform)))))
+
+(deftransform subsetp ((list1 list2 &rest args))
+  (if (csubtypep (lvar-type list1) (specifier-type 'null))
+      t
+      (give-up-ir1-transform)))

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


hooks/post-receive
-- 
SBCL