From 70b392926636cc0d870a6e4e7dd8b574f998633d Mon Sep 17 00:00:00 2001 From: Nikodemus Siivola Date: Sun, 13 Sep 2009 09:53:58 +0000 Subject: [PATCH] 1.0.31.7: transform %FIND-POSITION for strings * Based on patch by Karol Swietlicki. https://bugs.launchpad.net/sbcl/+bug/410122 --- NEWS | 6 ++++-- src/code/primordial-extensions.lisp | 4 +++- src/compiler/array-tran.lisp | 6 ++++-- src/compiler/seqtran.lisp | 24 ++++++++++++++++++++++++ version.lisp-expr | 2 +- 5 files changed, 36 insertions(+), 6 deletions(-) diff --git a/NEWS b/NEWS index b8a9c2b..aa19086 100644 --- 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 --- 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 --- 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 --- 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 --- 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" -- 1.7.10.4