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

List:       sbcl-commits
Subject:    [Sbcl-commits] master: Optimize (coerce x 'list).
From:       "stassats" <stassats () users ! sourceforge ! net>
Date:       2014-04-19 16:45:53
Message-ID: E1WbYOs-00078X-Rr () sfs-ml-3 ! v29 ! ch3 ! sourceforge ! com
[Download RAW message or body]

The branch "master" has been updated in SBCL:
       via  76a10d02fef07b0162a90374979d8852afa9b0a0 (commit)
      from  151592236a4241fe8701610c7112c24e90a0583b (commit)

- Log -----------------------------------------------------------------
commit 76a10d02fef07b0162a90374979d8852afa9b0a0
Author: Stas Boukarev <stassats@gmail.com>
Date:   Sat Apr 19 20:29:01 2014 +0400

    Optimize (coerce x 'list).
    
    Transform into a call to COERCE-TO-LIST.
---
 NEWS                       |    3 ++-
 src/code/coerce.lisp       |   15 +++++++++++++--
 src/compiler/typetran.lisp |    2 ++
 tests/type.pure.lisp       |    5 +++--
 4 files changed, 20 insertions(+), 5 deletions(-)

diff --git a/NEWS b/NEWS
index 1ebca79..3d936c6 100644
--- a/NEWS
+++ b/NEWS
@@ -1,6 +1,7 @@
 ;;;; -*- coding: utf-8; fill-column: 78 -*-
 changes relative to sbcl-1.1.17:
-  * optimization: (coerce x 'complex) is now as efficient as (complex x).
+  * optimization: COERCE is now more effecient for more cases when the type is
+    known at compile-time.
     (lp#1309815)
   * bug fix: correctly inherit condition initforms. (lp#1300904)
   * bug fix: properly pprint literal functions inside nested lists.
diff --git a/src/code/coerce.lisp b/src/code/coerce.lisp
index c7cf0fb..c75c2e3 100644
--- a/src/code/coerce.lisp
+++ b/src/code/coerce.lisp
@@ -50,6 +50,15 @@
       (declare (fixnum index))
       (rplacd splice (list (aref object index))))))
 
+(defun sequence-to-list (sequence)
+  (declare (type sequence sequence))
+  (let* ((result (list nil))
+         (splice result))
+    (sb!sequence:dosequence (i sequence)
+      (rplacd splice (list i))
+      (setf splice (cdr splice)))
+    (cdr result)))
+
 ;;; These are used both by the full DEFUN function and by various
 ;;; optimization transforms in the constant-OUTPUT-TYPE-SPEC case.
 ;;;
@@ -100,8 +109,10 @@
                :format-arguments (list object)))))))
 
 (defun coerce-to-list (object)
-  (etypecase object
-    (vector (vector-to-list* object))))
+  (seq-dispatch object
+                object
+                (vector-to-list* object)
+                (sequence-to-list object)))
 
 (defun coerce-to-vector (object output-type-spec)
   (etypecase object
diff --git a/src/compiler/typetran.lisp b/src/compiler/typetran.lisp
index d8fa88d..a6327ed 100644
--- a/src/compiler/typetran.lisp
+++ b/src/compiler/typetran.lisp
@@ -791,6 +791,8 @@
                 (give-up-ir1-transform
                  "~@<~S specifies dimensions other than (*) in safe code.~:@>"
                  tval)))
+           ((type= tspec (specifier-type 'list))
+            `(coerce-to-list x))
            ((csubtypep tspec (specifier-type 'function))
             (if (csubtypep (lvar-type x) (specifier-type 'symbol))
                 `(coerce-symbol-to-fun x)
diff --git a/tests/type.pure.lisp b/tests/type.pure.lisp
index 31a7edd..2d24f9b 100644
--- a/tests/type.pure.lisp
+++ b/tests/type.pure.lisp
@@ -195,8 +195,9 @@
                                     'another-unknown-type))))
 
 ;;; bug 46c
-(dolist (fun '(and if))
-  (assert (raises-error? (coerce fun 'function) type-error)))
+(with-test (:name :coerce-function-on-macro)
+  (dolist (fun '(and if))
+    (assert (raises-error? (coerce fun 'function)))))
 
 (dotimes (i 100)
   (let ((x (make-array 0 :element-type `(unsigned-byte ,(1+ i)))))

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


hooks/post-receive
-- 
SBCL

------------------------------------------------------------------------------
Learn Graph Databases - Download FREE O'Reilly Book
"Graph Databases" is the definitive new guide to graph databases and their
applications. Written by three acclaimed leaders in the field,
this first edition is now available. Download your free book today!
http://p.sf.net/sfu/NeoTech
_______________________________________________
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]