;;; must be SIMPLE-BASE-STRINGs.
(macrolet ((def (name lessp equalp)
`(deftransform ,name ((string1 string2 start1 end1 start2 end2)
- (simple-base-string simple-base-string t t t t) *)
+ (simple-base-string simple-base-string t t t t) *)
`(let* ((end1 (if (not end1) (length string1) end1))
(end2 (if (not end2) (length string2) end2))
(index (sb!impl::%sp-string-compare
string1 start1 end1 string2 start2 end2)))
(if index
- (cond ((= index ,(if ',lessp 'end1 'end2)) index)
- ((= index ,(if ',lessp 'end2 'end1)) nil)
+ (cond ((= index end1)
+ ,(if ',lessp 'index nil))
+ ((= (+ index (- start2 start1)) end2)
+ ,(if ',lessp nil 'index))
((,(if ',lessp 'char< 'char>)
(schar string1 index)
(schar string2
(+ index
(truly-the fixnum
(- start2
- start1))))))
+ start1))))))
index)
- (t nil))
+ (t nil))
,(if ',equalp 'end1 nil))))))
(def string<* t nil)
(def string<=* t t)
sb!vm:n-byte-bits)))
string1))
+;;; KLUDGE: This isn't the nicest way of achieving efficient string
+;;; streams, but it does work; a more general framework for this kind
+;;; of optimization, as well as better handling of the possible
+;;; keyword arguments, would be nice.
+#!+sb-unicode
+(deftransform replace ((string1 string2 &key (start1 0) (start2 0)
+ end1 end2)
+ ((simple-array character (*))
+ (simple-array character (*))
+ &rest t)
+ *
+ ;; FIXME: consider replacing this policy test
+ ;; with some tests for the STARTx and ENDx
+ ;; indices being valid, conditional on high
+ ;; SAFETY code.
+ ;;
+ ;; FIXME: It turns out that this transform is
+ ;; critical for the performance of string
+ ;; streams. Make this more explicit.
+ :policy (< (max safety space) 3))
+ `(sb!impl::simple-character-string-replace-from-simple-character-string*
+ string1 string2 start1 end1 start2 end2))
+
+;;; FIXME: this would be a valid transform for certain excluded cases:
+;;; * :TEST 'CHAR= or :TEST #'CHAR=
+;;; * :TEST 'EQL or :TEST #'EQL
+;;; * :FROM-END NIL (or :FROM-END non-NIL, with a little ingenuity)
+(deftransform search ((pattern text &key (start1 0) (start2 0) end1 end2)
+ (simple-string simple-string &rest t)
+ *
+ :policy (> speed (max space safety)))
+ `(block search
+ (let ((end1 (or end1 (length pattern)))
+ (end2 (or end2 (length text))))
+ (do ((index2 start2 (1+ index2)))
+ ((>= index2 end2) nil)
+ (when (do ((index1 start1 (1+ index1))
+ (index2 index2 (1+ index2)))
+ ((>= index1 end1) t)
+ (when (= index2 end2)
+ (return-from search nil))
+ (when (char/= (char pattern index1) (char text index2))
+ (return nil)))
+ (return index2))))))
+
;;; FIXME: It seems as though it should be possible to make a DEFUN
;;; %CONCATENATE (with a DEFTRANSFORM to translate constant RTYPE to
;;; CTYPE before calling %CONCATENATE) which is comparably efficient,
;;; at least once DYNAMIC-EXTENT works.
;;;
;;; FIXME: currently KLUDGEed because of bug 188
+;;;
+;;; FIXME: disabled for sb-unicode: probably want it back
+#!-sb-unicode
(deftransform concatenate ((rtype &rest sequences)
(t &rest (or simple-base-string
(simple-array nil (*))))
(declare (ignore rtype))
(let* (,@lets
(res (make-string (truncate (the index (+ ,@all-lengths))
- sb!vm:n-byte-bits))))
+ sb!vm:n-byte-bits)
+ :element-type 'base-char)))
(declare (type index ,@all-lengths))
(let (,@(mapcar (lambda (name) `(,name 0)) starts))
(declare (type index ,@starts))
`(deftransform ,name ((predicate sequence from-end start end key)
(function list t t t function)
*
- :policy (> speed space)
- :important t)
+ :policy (> speed space))
"expand inline"
`(let ((index 0)
(find nil)
(deftransform %find-position ((item sequence from-end start end key test)
(t list t t t t t)
*
- :policy (> speed space)
- :important t)
+ :policy (> speed space))
"expand inline"
'(%find-position-if (let ((test-fun (%coerce-callable-to-fun test)))
;; The order of arguments for asymmetric tests
(deftransform %find-position-if ((predicate sequence from-end start end key)
(function vector t t t function)
*
- :policy (> speed space)
- :important t)
+ :policy (> speed space))
"expand inline"
(check-inlineability-of-find-position-if sequence from-end)
'(%find-position-if-vector-macro predicate sequence
(deftransform %find-position-if-not ((predicate sequence from-end start end key)
(function vector t t t function)
*
- :policy (> speed space)
- :important t)
+ :policy (> speed space))
"expand inline"
(check-inlineability-of-find-position-if sequence from-end)
'(%find-position-if-not-vector-macro predicate sequence
(deftransform %find-position ((item sequence from-end start end key test)
(t vector t t t function function)
*
- :policy (> speed space)
- :important t)
+ :policy (> speed space))
"expand inline"
(check-inlineability-of-find-position-if sequence from-end)
'(%find-position-vector-macro item sequence
;;; perhaps it's worth optimizing the -if-not versions in the same
;;; way as the others?
;;;
-;;; FIXME: Maybe remove uses of these deprecated functions (and
-;;; definitely of :TEST-NOT) within the implementation of SBCL.
+;;; FIXME: Maybe remove uses of these deprecated functions within the
+;;; implementation of SBCL.
(macrolet ((define-find-position-if-not (fun-name values-index)
`(deftransform ,fun-name ((predicate sequence &key
from-end (start 0)
projects / sbcl.git / blobdiff