(lvar-dynamic-extent it)))
(defun flushable-combination-p (call)
- (declare (combination call))
+ (declare (type combination call))
(let ((kind (combination-kind call))
(info (combination-fun-info call)))
(when (and (eq kind :known) (fun-info-p info))
(handled-conditions (lexenv-handled-conditions default))
(disabled-package-locks
(lexenv-disabled-package-locks default))
- (policy (lexenv-policy default)))
+ (policy (lexenv-policy default))
+ (user-data (lexenv-user-data default)))
(macrolet ((frob (var slot)
`(let ((old (,slot default)))
(if ,var
(frob blocks lexenv-blocks)
(frob tags lexenv-tags)
(frob type-restrictions lexenv-type-restrictions)
- lambda cleanup handled-conditions
- disabled-package-locks policy)))
+ lambda
+ cleanup handled-conditions disabled-package-locks
+ policy
+ user-data)))
;;; Makes a LEXENV, suitable for using in a MACROLET introduced
;;; macroexpander
nil
(lexenv-handled-conditions lexenv)
(lexenv-disabled-package-locks lexenv)
- (lexenv-policy lexenv))))
+ (lexenv-policy lexenv)
+ (lexenv-user-data lexenv))))
\f
;;;; flow/DFO/component hackery
(defun delete-lambda-var (leaf)
(declare (type lambda-var leaf))
+ (setf (lambda-var-deleted leaf) t)
;; Iterate over all local calls flushing the corresponding argument,
;; allowing the computation of the argument to be deleted. We also
;; mark the LET for reoptimization, since it may be that we have
;;; Return functional for DEFINED-FUN which has been converted in policy
;;; corresponding to the current one, or NIL if no such functional exists.
+;;;
+;;; Also check that the parent of the functional is visible in the current
+;;; environment.
(defun defined-fun-functional (defined-fun)
- (let ((policy (lexenv-%policy *lexenv*)))
- (dolist (functional (defined-fun-functionals defined-fun))
- (when (equal policy (lexenv-%policy (functional-lexenv functional)))
- (return functional)))))
+ (let ((functionals (defined-fun-functionals defined-fun)))
+ (when functionals
+ (let* ((sample (car functionals))
+ (there (lambda-parent (if (lambda-p sample)
+ sample
+ (optional-dispatch-main-entry sample)))))
+ (when there
+ (labels ((lookup (here)
+ (unless (eq here there)
+ (if here
+ (lookup (lambda-parent here))
+ ;; We looked up all the way up, and didn't find the parent
+ ;; of the functional -- therefore it is nested in a lambda
+ ;; we don't see, so return nil.
+ (return-from defined-fun-functional nil)))))
+ (lookup (lexenv-lambda *lexenv*)))))
+ ;; Now find a functional whose policy matches the current one, if we already
+ ;; have one.
+ (let ((policy (lexenv-%policy *lexenv*)))
+ (dolist (functional functionals)
+ (when (equal policy (lexenv-%policy (functional-lexenv functional)))
+ (return functional)))))))
;;; Do stuff to delete the semantic attachments of a REF node. When
;;; this leaves zero or one reference, we do a type dispatch off of
(aver (null (functional-entry-fun leaf)))
(delete-lambda leaf))
(:external
- (delete-lambda leaf))
+ (unless (functional-has-external-references-p leaf)
+ (delete-lambda leaf)))
((:deleted :zombie :optional))))
(optional-dispatch
(unless (eq (functional-kind leaf) :deleted)
(name1 uses)
(mapcar #'name1 uses)))))
-;;; Return the source name of a combination. (This is an idiom
-;;; which was used in CMU CL. I gather it always works. -- WHN)
+;;; Return the source name of a combination -- or signals an error
+;;; if the function leaf is anonymous.
(defun combination-fun-source-name (combination &optional (errorp t))
(let ((leaf (ref-leaf (lvar-uses (combination-fun combination)))))
- (when (or errorp (leaf-has-source-name-p leaf))
- (leaf-source-name leaf))))
+ (if (or errorp (leaf-has-source-name-p leaf))
+ (values (leaf-source-name leaf) t)
+ (values nil nil))))
;;; Return the COMBINATION node that is the call to the LET FUN.
(defun let-combination (fun)
(memq (functional-kind functional) '(:deleted :zombie))))
(throw 'locall-already-let-converted functional)))
+(defun assure-leaf-live-p (leaf)
+ (typecase leaf
+ (lambda-var
+ (when (lambda-var-deleted leaf)
+ (throw 'locall-already-let-converted leaf)))
+ (functional
+ (assure-functional-live-p leaf))))
+
+
(defun call-full-like-p (call)
(declare (type combination call))
(let ((kind (basic-combination-kind call)))
(not (null (member (leaf-source-name leaf) names
:test #'equal))))))))
+;;; Return true if LVAR's only use is a call to one of the named functions
+;;; (or any function if none are specified) with the specified number of
+;;; of arguments (or any number if number is not specified)
(defun lvar-matches (lvar &key fun-names arg-count)
- (let ((use (lvar-use lvar)))
+ (let ((use (lvar-uses lvar)))
(and (combination-p use)
(or (not fun-names)
- (member (combination-fun-source-name use)
- fun-names :test #'eq))
+ (multiple-value-bind (name ok)
+ (combination-fun-source-name use nil)
+ (and ok (member name fun-names :test #'eq))))
(or (not arg-count)
(= arg-count (length (combination-args use)))))))