(deftransform map ((result-type-arg fun seq &rest seqs) * * :node node)
(let* ((seq-names (make-gensym-list (1+ (length seqs))))
(bare `(%map result-type-arg fun ,@seq-names))
- (constant-result-type-arg-p (constant-continuation-p result-type-arg))
+ (constant-result-type-arg-p (constant-lvar-p result-type-arg))
;; what we know about the type of the result. (Note that the
;; "result type" argument is not necessarily the type of the
;; result, since NIL means the result has NULL type.)
(result-type (if (not constant-result-type-arg-p)
'consed-sequence
(let ((result-type-arg-value
- (continuation-value result-type-arg)))
+ (lvar-value result-type-arg)))
(if (null result-type-arg-value)
'null
result-type-arg-value)))))
bare))))))))
;;; Return a DO loop, mapping a function FUN to elements of
-;;; sequences. SEQS is a list of continuations, SEQ-NAMES - list of
-;;; variables, bound to sequences, INTO - a variable, which is used in
+;;; sequences. SEQS is a list of lvars, SEQ-NAMES - list of variables,
+;;; bound to sequences, INTO - a variable, which is used in
;;; MAP-INTO. RESULT and BODY are forms, which can use variables
;;; FUNCALL-RESULT, containing the result of application of FUN, and
;;; INDEX, containing the current position in sequences.
(bindings `(index 0 (1+ index)))
(declarations `(type index index)))
(vector-lengths length)))
- (loop for seq of-type continuation in seqs
+ (loop for seq of-type lvar in seqs
for seq-name in seq-names
- for type = (continuation-type seq)
+ for type = (lvar-type seq)
do (cond ((csubtypep type (specifier-type 'list))
(with-unique-names (index)
(bindings `(,index ,seq-name (cdr ,index)))
(deftransform %map ((result-type fun seq &rest seqs) * *
:policy (>= speed space))
"open code"
- (unless (constant-continuation-p result-type)
+ (unless (constant-lvar-p result-type)
(give-up-ir1-transform "RESULT-TYPE argument not constant"))
(labels ( ;; 1-valued SUBTYPEP, fails unless second value of SUBTYPEP is true
(fn-1subtypep (fn x y)
(give-up-ir1-transform
"can't analyze sequence type relationship"))))
(1subtypep (x y) (fn-1subtypep #'sb!xc:subtypep x y)))
- (let* ((result-type-value (continuation-value result-type))
+ (let* ((result-type-value (lvar-value result-type))
(result-supertype (cond ((null result-type-value) 'null)
((1subtypep result-type-value 'vector)
'vector)
(macrolet ((def (name)
`(deftransform ,name ((e l &key (test #'eql)) * *
:node node)
- (unless (constant-continuation-p l)
+ (unless (constant-lvar-p l)
(give-up-ir1-transform))
- (let ((val (continuation-value l)))
+ (let ((val (lvar-value l)))
(unless (policy node
(or (= speed 3)
(and (>= speed space)
;; if ITEM is not a NUMBER or is a FIXNUM, apply
;; transform, else give up on transform.
(cond (test
- (unless (continuation-fun-is test '(eq))
+ (unless (lvar-fun-is test '(eq))
(give-up-ir1-transform)))
- ((types-equal-or-intersect (continuation-type item)
+ ((types-equal-or-intersect (lvar-type item)
(specifier-type 'number))
(give-up-ir1-transform "Item might be a number.")))
`(,',eq-fun item list))))
\f
;;;; utilities
-;;; Return true if CONT's only use is a non-NOTINLINE reference to a
+;;; Return true if LVAR's only use is a non-NOTINLINE reference to a
;;; global function with one of the specified NAMES.
-(defun continuation-fun-is (cont names)
- (declare (type continuation cont) (list names))
- (let ((use (continuation-use cont)))
+(defun lvar-fun-is (lvar names)
+ (declare (type lvar lvar) (list names))
+ (let ((use (lvar-uses lvar)))
(and (ref-p use)
(let ((leaf (ref-leaf use)))
(and (global-var-p leaf)
(not (null (member (leaf-source-name leaf) names
:test #'equal))))))))
-;;; If CONT is a constant continuation, the return the constant value.
-;;; If it is null, then return default, otherwise quietly give up the
-;;; IR1 transform.
+;;; If LVAR is a constant lvar, the return the constant value. If it
+;;; is null, then return default, otherwise quietly give up the IR1
+;;; transform.
;;;
;;; ### Probably should take an ARG and flame using the NAME.
-(defun constant-value-or-lose (cont &optional default)
- (declare (type (or continuation null) cont))
- (cond ((not cont) default)
- ((constant-continuation-p cont)
- (continuation-value cont))
+(defun constant-value-or-lose (lvar &optional default)
+ (declare (type (or lvar null) lvar))
+ (cond ((not lvar) default)
+ ((constant-lvar-p lvar)
+ (lvar-value lvar))
(t
(give-up-ir1-transform))))
sb!vm:n-byte-bits)))
string1))
+;;; 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)
+;;;
+;;; also, it should be noted that there's nothing much in this
+;;; transform (as opposed to the ones for REPLACE and CONCATENATE)
+;;; that particularly limits it to SIMPLE-BASE-STRINGs.
+(deftransform search ((pattern text &key (start1 0) (start2 0) end1 end2)
+ (simple-base-string simple-base-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,
(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))
;;;; CONS accessor DERIVE-TYPE optimizers
(defoptimizer (car derive-type) ((cons))
- (let ((type (continuation-type cons))
+ (let ((type (lvar-type cons))
(null-type (specifier-type 'null)))
(cond ((eq type null-type)
null-type)
(cons-type-car-type type)))))
(defoptimizer (cdr derive-type) ((cons))
- (let ((type (continuation-type cons))
+ (let ((type (lvar-type cons))
(null-type (specifier-type 'null)))
(cond ((eq type null-type)
null-type)
;;; %FIND-POSITION-IF only when %FIND-POSITION-IF has an inline
;;; expansion, so we factor out the condition into this function.
(defun check-inlineability-of-find-position-if (sequence from-end)
- (let ((ctype (continuation-type sequence)))
+ (let ((ctype (lvar-type sequence)))
(cond ((csubtypep ctype (specifier-type 'vector))
;; It's not worth trying to inline vector code unless we
;; know a fair amount about it at compile time.
(upgraded-element-type-specifier-or-give-up sequence)
- (unless (constant-continuation-p from-end)
+ (unless (constant-lvar-p from-end)
(give-up-ir1-transform
"FROM-END argument value not known at compile time")))
((csubtypep ctype (specifier-type 'list))
`(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)
(incf index))))))
(def %find-position-if when)
(def %find-position-if-not unless))
-
+
;;; %FIND-POSITION for LIST data can be expanded into %FIND-POSITION-IF
;;; without loss of efficiency. (I.e., the optimizer should be able
;;; to straighten everything out.)
(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