(declare (type combination call) (type clambda fun))
(loop for arg in (basic-combination-args call)
and var in (lambda-vars fun)
- when (and (lambda-var-dynamic-extent var)
+ when (and arg
+ (lambda-var-dynamic-extent var)
(not (lvar-dynamic-extent arg)))
collect arg into dx-lvars
and do (let ((use (lvar-uses arg)))
(aver (null (functional-entry-fun fun)))
(with-ir1-environment-from-node (lambda-bind (main-entry fun))
(let ((res (ir1-convert-lambda (make-xep-lambda-expression fun)
- :debug-name (debug-namify
- "XEP for "
- (leaf-debug-name fun)))))
+ :debug-name (debug-name
+ 'xep (leaf-debug-name fun)))))
(setf (functional-kind res) :external
(leaf-ever-used res) t
(functional-entry-fun res) fun
(functional-entry-fun fun) res
- (component-reanalyze *current-component*) t
- (component-reoptimize *current-component*) t)
+ (component-reanalyze *current-component*) t)
+ (reoptimize-component *current-component* :maybe)
(etypecase fun
(clambda
(locall-analyze-fun-1 fun))
(inline-expansion-ok call))
(let* ((end (component-last-block (node-component call)))
(pred (block-prev end)))
- (multiple-value-bind (losing-local-functional converted-lambda)
+ (multiple-value-bind (losing-local-object converted-lambda)
(catch 'locall-already-let-converted
(with-ir1-environment-from-node call
(let ((*lexenv* (functional-lexenv original-functional)))
(values nil
(ir1-convert-lambda
(functional-inline-expansion original-functional)
- :debug-name (debug-namify
- "local inline "
- (leaf-debug-name
- original-functional)))))))
- (cond (losing-local-functional
- (let ((*compiler-error-context* call))
- (compiler-notify "couldn't inline expand because expansion ~
- calls this LET-converted local function:~
- ~% ~S"
- (leaf-debug-name losing-local-functional)))
+ :debug-name (debug-name 'local-inline
+ (leaf-debug-name
+ original-functional)))))))
+ (cond (losing-local-object
+ (if (functional-p losing-local-object)
+ (let ((*compiler-error-context* call))
+ (compiler-notify "couldn't inline expand because expansion ~
+ calls this LET-converted local function:~
+ ~% ~S"
+ (leaf-debug-name losing-local-object)))
+ (let ((*compiler-error-context* call))
+ (compiler-notify "implementation limitation: couldn't inline ~
+ expand because expansion refers to ~
+ the optimized away object ~S."
+ losing-local-object)))
(loop for block = (block-next pred) then (block-next block)
until (eq block end)
do (setf (block-delete-p block) t))
`(lambda ,vars
(declare (ignorable ,@ignores))
(%funcall ,entry ,@args))
- :debug-name (debug-namify "hairy function entry "
- (lvar-fun-name
- (basic-combination-fun call)))))))
+ :debug-name (debug-name 'hairy-function-entry
+ (lvar-fun-name
+ (basic-combination-fun call)))))))
(convert-call ref call new-fun)
(dolist (ref (leaf-refs entry))
(convert-call-if-possible ref (lvar-dest (node-lvar ref))))))
(when (optional-dispatch-keyp fun)
(when (oddp (length more))
(compiler-warn "function called with odd number of ~
- arguments in keyword portion")
-
+ arguments in keyword portion")
(setf (basic-combination-kind call) :error)
(return-from convert-more-call))
(let ((name (lvar-value lvar))
(dummy (first temp))
(val (second temp)))
- ;; FIXME: check whether KEY was supplied earlier
(when (and (eq name :allow-other-keys) (not allow-found))
(let ((val (second key)))
(cond ((constant-lvar-p val)
(setq loser (list name)))))
(let ((info (lambda-var-arg-info var)))
(when (eq (arg-info-key info) name)
- (ignores dummy)
- (supplied (cons var val))
- (return)))))))
+ (ignores dummy)
+ (if (member var (supplied) :key #'car)
+ (ignores val)
+ (supplied (cons var val)))
+ (return)))))))
(when (and loser (not (optional-dispatch-allowp fun)) (not allowp))
(compiler-warn "function called with unknown argument keyword ~S"