(n-supplied (gensym))
(temps (make-gensym-list max)))
(collect ((entries))
- (do ((eps (optional-dispatch-entry-points fun) (rest eps))
- (n min (1+ n)))
- ((null eps))
- (entries `((= ,n-supplied ,n)
- (%funcall ,(first eps) ,@(subseq temps 0 n)))))
+ ;; Force convertion of all entries
+ (optional-dispatch-entry-point-fun fun 0)
+ (loop for ep in (optional-dispatch-entry-points fun)
+ and n from min
+ do (entries `((= ,n-supplied ,n)
+ (%funcall ,(force ep) ,@(subseq temps 0 n)))))
`(lambda (,n-supplied ,@temps)
;; FIXME: Make sure that INDEX type distinguishes between
;; target and host. (Probably just make the SB!XC:DEFTYPE
;;; then associate this lambda with FUN as its XEP. After the
;;; conversion, we iterate over the function's associated lambdas,
;;; redoing local call analysis so that the XEP calls will get
-;;; converted.
+;;; converted.
;;;
;;; We set REANALYZE and REOPTIMIZE in the component, just in case we
;;; discover an XEP after the initial local call analyze pass.
(locall-analyze-fun-1 fun))
(optional-dispatch
(dolist (ep (optional-dispatch-entry-points fun))
- (locall-analyze-fun-1 ep))
+ (locall-analyze-fun-1 (force ep)))
(when (optional-dispatch-more-entry fun)
(locall-analyze-fun-1 (optional-dispatch-more-entry fun)))))
res)))
;; COMPONENT is the only one here. Let's make that explicit.
(aver (= 1 (length (functional-components clambda))))
(aver (eql component (first (functional-components clambda))))
- (when (component-new-functionals component)
+ (when (or (component-new-functionals component)
+ (component-reanalyze-functionals component))
(setf did-something t)
(locall-analyze-component component))))
(unless did-something
(>= speed compilation-speed)))
(not (eq (functional-kind (node-home-lambda call)) :external))
(inline-expansion-ok call))
- (multiple-value-bind (losing-local-functional 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 ~A"
- (leaf-debug-name
- original-functional)))))))
- (cond (losing-local-functional
- (let ((*compiler-error-context* call))
- (compiler-note "couldn't inline expand because expansion ~
- calls this LET-converted local function:~
- ~% ~S"
- (leaf-debug-name losing-local-functional)))
- original-functional)
- (t
- (change-ref-leaf ref converted-lambda)
- converted-lambda)))
+ (let* ((end (component-last-block (node-component call)))
+ (pred (block-prev end)))
+ (multiple-value-bind (losing-local-functional 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 ~A"
+ (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)))
+ (loop for block = (block-next pred) then (block-next block)
+ until (eq block end)
+ do (setf (block-delete-p block) t))
+ (loop for block = (block-next pred) then (block-next block)
+ until (eq block end)
+ do (delete-block block t))
+ original-functional)
+ (t
+ (change-ref-leaf ref converted-lambda)
+ converted-lambda))))
original-functional))
;;; Dispatch to the appropriate function to attempt to convert a call.
(not (functional-entry-fun fun))
(= (length (leaf-refs fun)) 1)
(= (length (basic-combination-args call)) 1))
- (let ((ep (car (last (optional-dispatch-entry-points fun)))))
+ (let* ((*current-component* (node-component ref))
+ (ep (optional-dispatch-entry-point-fun
+ fun (optional-dispatch-max-args fun))))
+ (aver (= (optional-dispatch-min-args fun) 0))
(setf (basic-combination-kind call) :local)
(pushnew ep (lambda-calls-or-closes (node-home-lambda call)))
(merge-tail-sets call ep)
(setf (basic-combination-kind call) :error))
((<= call-args max-args)
(convert-call ref call
- (elt (optional-dispatch-entry-points fun)
- (- call-args min-args))))
+ (let ((*current-component* (node-component ref)))
+ (optional-dispatch-entry-point-fun
+ fun (- call-args min-args)))))
((optional-dispatch-more-entry fun)
(convert-more-call ref call fun))
(t
(let ((cont (first key)))
(unless (constant-continuation-p cont)
(when flame
- (compiler-note "non-constant keyword in keyword call"))
+ (compiler-notify "non-constant keyword in keyword call"))
(setf (basic-combination-kind call) :error)
(return-from convert-more-call))
(setq allow-found t
allowp (continuation-value val)))
(t (when flame
- (compiler-note "non-constant :ALLOW-OTHER-KEYS value"))
+ (compiler-notify "non-constant :ALLOW-OTHER-KEYS value"))
(setf (basic-combination-kind call) :error)
(return-from convert-more-call)))))
(dolist (var (key-vars)
projects / sbcl.git / blobdiff