(temps (make-gensym-list (length (lambda-vars fun)))))
`(lambda (,n-supplied ,@temps)
(declare (type index ,n-supplied))
- ,(if (policy nil (zerop safety))
+ ,(if (policy *lexenv* (zerop safety))
`(declare (ignore ,n-supplied))
`(%verify-argument-count ,n-supplied ,nargs))
(%funcall ,fun ,@temps))))
(cond
,@(if more (butlast (entries)) (entries))
,@(when more
- `((,(if (zerop min) 't `(>= ,n-supplied ,max))
+ `((,(if (zerop min) t `(>= ,n-supplied ,max))
,(let ((n-context (gensym))
(n-count (gensym)))
`(multiple-value-bind (,n-context ,n-count)
;;; 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. We also bind *LEXENV* to change the compilation policy
-;;; over to the interface policy.
+;;; converted.
;;;
;;; We set REANALYZE and REOPTIMIZE in the component, just in case we
;;; discover an XEP after the initial local call analyze pass.
(declare (type functional fun))
(aver (not (functional-entry-function fun)))
(with-ir1-environment (lambda-bind (main-entry fun))
- (let* ((*lexenv* (make-lexenv :policy (make-interface-policy *lexenv*)))
- (res (ir1-convert-lambda (make-xep-lambda fun))))
- (setf (functional-kind res) :external)
- (setf (leaf-ever-used res) t)
- (setf (functional-entry-function res) fun)
- (setf (functional-entry-function fun) res)
- (setf (component-reanalyze *current-component*) t)
- (setf (component-reoptimize *current-component*) t)
+ (let ((res (ir1-convert-lambda (make-xep-lambda fun))))
+ (setf (functional-kind res) :external
+ (leaf-ever-used res) t
+ (functional-entry-function res) fun
+ (functional-entry-function fun) res
+ (component-reanalyze *current-component*) t
+ (component-reoptimize *current-component*) t)
(etypecase fun
(clambda (local-call-analyze-1 fun))
(optional-dispatch
(if (and (policy call
(and (>= speed space) (>= speed compilation-speed)))
(not (eq (functional-kind (node-home-lambda call)) :external))
- (not *converting-for-interpreter*)
(inline-expansion-ok call))
(with-ir1-environment call
(let* ((*lexenv* (functional-lexenv fun))
(won nil)
(res (catch 'local-call-lossage
(prog1
- (ir1-convert-lambda (functional-inline-expansion fun))
+ (ir1-convert-lambda (functional-inline-expansion
+ fun))
(setq won t)))))
(cond (won
(change-ref-leaf ref res)
\f
;;;; LET conversion
;;;;
-;;;; Converting to a LET has differing significance to various parts of the
-;;;; compiler:
-;;;; -- The body of a LET is spliced in immediately after the corresponding
-;;;; combination node, making the control transfer explicit and allowing
-;;;; LETs to be mashed together into a single block. The value of the LET is
-;;;; delivered directly to the original continuation for the call,
-;;;; eliminating the need to propagate information from the dummy result
-;;;; continuation.
-;;;; -- As far as IR1 optimization is concerned, it is interesting in that
-;;;; there is only one expression that the variable can be bound to, and
-;;;; this is easily substitited for.
-;;;; -- LETs are interesting to environment analysis and to the back end
-;;;; because in most ways a LET can be considered to be "the same function"
-;;;; as its home function.
-;;;; -- LET conversion has dynamic scope implications, since control transfers
-;;;; within the same environment are local. In a local control transfer,
-;;;; cleanup code must be emitted to remove dynamic bindings that are no
-;;;; longer in effect.
-
-;;; Set up the control transfer to the called lambda. We split the call
-;;; block immediately after the call, and link the head of FUN to the call
-;;; block. The successor block after splitting (where we return to) is
-;;; returned.
-;;;
-;;; If the lambda is is a different component than the call, then we call
-;;; JOIN-COMPONENTS. This only happens in block compilation before
-;;; FIND-INITIAL-DFO.
+;;;; Converting to a LET has differing significance to various parts
+;;;; of the compiler:
+;;;; -- The body of a LET is spliced in immediately after the
+;;;; corresponding combination node, making the control transfer
+;;;; explicit and allowing LETs to be mashed together into a single
+;;;; block. The value of the LET is delivered directly to the
+;;;; original continuation for the call,eliminating the need to
+;;;; propagate information from the dummy result continuation.
+;;;; -- As far as IR1 optimization is concerned, it is interesting in
+;;;; that there is only one expression that the variable can be bound
+;;;; to, and this is easily substitited for.
+;;;; -- LETs are interesting to environment analysis and to the back
+;;;; end because in most ways a LET can be considered to be "the
+;;;; same function" as its home function.
+;;;; -- LET conversion has dynamic scope implications, since control
+;;;; transfers within the same environment are local. In a local
+;;;; control transfer, cleanup code must be emitted to remove
+;;;; dynamic bindings that are no longer in effect.
+
+;;; Set up the control transfer to the called lambda. We split the
+;;; call block immediately after the call, and link the head of FUN to
+;;; the call block. The successor block after splitting (where we
+;;; return to) is returned.
+;;;
+;;; If the lambda is is a different component than the call, then we
+;;; call JOIN-COMPONENTS. This only happens in block compilation
+;;; before FIND-INITIAL-DFO.
(defun insert-let-body (fun call)
(declare (type clambda fun) (type basic-combination call))
(let* ((call-block (node-block call))
(not (functional-entry-function fun)))
(let* ((ref-cont (node-cont (first refs)))
(dest (continuation-dest ref-cont)))
- (when (and (basic-combination-p dest)
+ (when (and dest
+ (basic-combination-p dest)
(eq (basic-combination-fun dest) ref-cont)
(eq (basic-combination-kind dest) :local)
(not (block-delete-p (node-block dest)))
(call-fun nil))
(when (and (dolist (ref (leaf-refs fun) t)
(let ((dest (continuation-dest (node-cont ref))))
- (when (block-delete-p (node-block dest)) (return nil))
+ (when (or (not dest)
+ (block-delete-p (node-block dest)))
+ (return nil))
(let ((home (node-home-lambda ref)))
(unless (eq home fun)
(when call-fun (return nil))