(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))
(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))
;; 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
;; 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
-;;; 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.
;;; 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)))
(bindings `(index 0 (1+ index)))
(declarations `(type index index)))
(vector-lengths length)))
do (cond ((csubtypep type (specifier-type 'list))
(with-unique-names (index)
(bindings `(,index ,seq-name (cdr ,index)))
do (cond ((csubtypep type (specifier-type 'list))
(with-unique-names (index)
(bindings `(,index ,seq-name (cdr ,index)))
(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 "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)))
(give-up-ir1-transform
"can't analyze sequence type relationship"))))
(1subtypep (x y) (fn-1subtypep #'sb!xc:subtypep x y)))
;; if ITEM is not a NUMBER or is a FIXNUM, apply
;; transform, else give up on transform.
(cond (test
;; if ITEM is not a NUMBER or is a FIXNUM, apply
;; transform, else give up on transform.
(cond (test
(specifier-type 'number))
(give-up-ir1-transform "Item might be a number.")))
`(,',eq-fun item list))))
(specifier-type 'number))
(give-up-ir1-transform "Item might be a number.")))
`(,',eq-fun item list))))
-(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)))
-;;; 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.
-(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))
;;; %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)
;;; %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)
(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)
(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)
;;; %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.)
;;; %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.)