(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))))
(specifier-type 'function)))
(when (policy *compiler-error-context*
(> speed inhibit-warnings))
- (compiler-note
+ (compiler-notify
"~S may not be a function, so must coerce at run-time."
n-fun))
(once-only ((n-fun `(if (functionp ,n-fun)
;;; Return a form that tests the free variables STRING1 and STRING2
;;; for the ordering relationship specified by LESSP and EQUALP. The
;;; start and end are also gotten from the environment. Both strings
-;;; must be SIMPLE-STRINGs.
+;;; must be SIMPLE-BASE-STRINGs.
(macrolet ((def (name lessp equalp)
`(deftransform ,name ((string1 string2 start1 end1 start2 end2)
- (simple-string simple-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
(macrolet ((def (name result-fun)
`(deftransform ,name ((string1 string2 start1 end1 start2 end2)
- (simple-string simple-string t t t t) *)
+ (simple-base-string simple-base-string t t t t) *)
`(,',result-fun
(sb!impl::%sp-string-compare
string1 start1 (or end1 (length string1))
(deftransform replace ((string1 string2 &key (start1 0) (start2 0)
end1 end2)
- (simple-string simple-string &rest t)
+ (simple-base-string simple-base-string &rest t)
*
;; FIXME: consider replacing this policy test
;; with some tests for the STARTx and ENDx
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,
;;;
;;; FIXME: currently KLUDGEed because of bug 188
(deftransform concatenate ((rtype &rest sequences)
- (t &rest simple-string)
- simple-string
+ (t &rest (or simple-base-string
+ (simple-array nil (*))))
+ simple-base-string
:policy (< safety 3))
(loop for rest-seqs on sequences
for n-seq = (gensym "N-SEQ")
collect `(,n-length (* (length ,n-seq) sb!vm:n-byte-bits)) into lets
collect n-length into all-lengths
collect next-start into starts
- collect `(bit-bash-copy ,n-seq ,vector-data-bit-offset
- res ,start ,n-length)
+ collect `(if (and (typep ,n-seq '(simple-array nil (*)))
+ (> ,n-length 0))
+ (error 'nil-array-accessed-error)
+ (bit-bash-copy ,n-seq ,vector-data-bit-offset
+ res ,start ,n-length))
into forms
collect `(setq ,next-start (+ ,start ,n-length)) into forms
finally
;;;; 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))
(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.)