1.0.31.7: transform %FIND-POSITION for strings

 * Based on patch by Karol Swietlicki.

   https://bugs.launchpad.net/sbcl/+bug/410122

diff --git a/NEWS b/NEWS
index b8a9c2b..aa19086 100644 (file)
--- a/NEWS
+++ b/NEWS
@@ -1,13 +1,15 @@
 ;;;; -*- coding: utf-8; fill-column: 78 -*-
 changes relative to sbcl-1.0.31
+  * optimization: faster FIND and POSITION on strings of unknown element type
+    in high SPEED policies. (thanks to Karol Swietlicki)
+  * improvement: better error signalling for bogus parameter specializer names
+    in DEFMETHOD forms (reported by Pluijzer)
   * bug fix: SAVE-LISP-AND-DIE option :SAVE-RUNTIME-OPTIONS did not work
     correctly when starting from an executable core without saved runtime
     options (reported by Faré Rideau, thanks to Zach Beane)
   * bug fix: (SETF SLOT-VALUE) signalled a warning which should have been
     an optimization note instead. (reported by Martin Cracauer)
   * bug fix: WITH-SLOTS did not work with THE forms. (thanks to David Tolpin)
-  * improvement: better error signalling for bogus parameter specializer names
-    in DEFMETHOD forms (reported by Pluijzer)
 
 changes in sbcl-1.0.31 relative to sbcl-1.0.30:
   * improvement: stack allocation is should now be possible in all nested

diff --git a/src/code/primordial-extensions.lisp b/src/code/primordial-extensions.lisp
index e25ed15..2677f6c 100644 (file)
--- a/src/code/primordial-extensions.lisp
+++ b/src/code/primordial-extensions.lisp
@@ -145,7 +145,9 @@
        (declare (inline ,fun))
        (etypecase ,var
          ,@(loop for type in types
-                 collect `(,type (,fun (the ,type ,var))))))))
+                 ;; TRULY-THE allows transforms to take advantage of the type
+                 ;; information without need for constraint propagation.
+                 collect `(,type (,fun (truly-the ,type ,var))))))))
 
 ;;; Automate an idiom often found in macros:
 ;;;   (LET ((FOO (GENSYM "FOO"))

diff --git a/src/compiler/array-tran.lisp b/src/compiler/array-tran.lisp
index 7db2e7f..5aaf16a 100644 (file)
--- a/src/compiler/array-tran.lisp
+++ b/src/compiler/array-tran.lisp
@@ -17,13 +17,15 @@
 ;;; GIVE-UP-IR1-TRANSFORM if the upgraded element type can't be
 ;;; determined.
 (defun upgraded-element-type-specifier-or-give-up (lvar)
-  (let* ((element-ctype (extract-upgraded-element-type lvar))
-         (element-type-specifier (type-specifier element-ctype)))
+  (let ((element-type-specifier (upgraded-element-type-specifier lvar)))
     (if (eq element-type-specifier '*)
         (give-up-ir1-transform
          "upgraded array element type not known at compile time")
         element-type-specifier)))
 
+(defun upgraded-element-type-specifier (lvar)
+  (type-specifier (extract-upgraded-element-type lvar)))
+
 ;;; Array access functions return an object from the array, hence its type is
 ;;; going to be the array upgraded element type. Secondary return value is the
 ;;; known supertype of the upgraded-array-element-type, if if the exact

diff --git a/src/compiler/seqtran.lisp b/src/compiler/seqtran.lisp
index 4ff8a4d..8d14f18 100644 (file)
--- a/src/compiler/seqtran.lisp
+++ b/src/compiler/seqtran.lisp
@@ -1351,6 +1351,30 @@
   '(%find-position-vector-macro item sequence
     from-end start end key test))
 
+(deftransform %find-position ((item sequence from-end start end key test)
+                              (character string t t t function function)
+                              *
+                              :policy (> speed space))
+  (if (eq '* (upgraded-element-type-specifier sequence))
+      (let ((form
+             `(sb!impl::string-dispatch ((simple-array character (*))
+                                         (simple-array base-char (*))
+                                         (simple-array nil (*)))
+                  sequence
+                (%find-position item sequence from-end start end key test))))
+        (if (csubtypep (lvar-type sequence) (specifier-type 'simple-string))
+            form
+            ;; Otherwise we'd get three instances of WITH-ARRAY-DATA from
+            ;; %FIND-POSITION.
+            `(with-array-data ((sequence sequence :offset-var offset)
+                               (start start)
+                               (end end)
+                               :check-fill-pointer t)
+               (multiple-value-bind (elt index) ,form
+                 (values elt (when (fixnump index) (- index offset)))))))
+      ;; The type is known exactly, other transforms will take care of it.
+      (give-up-ir1-transform)))
+
 ;;; logic to unravel :TEST, :TEST-NOT, and :KEY options in FIND,
 ;;; POSITION-IF, etc.
 (define-source-transform effective-find-position-test (test test-not)

diff --git a/version.lisp-expr b/version.lisp-expr
index 901f8dc..1444b9f 100644 (file)
--- 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.31.6"
+"1.0.31.7"