use))))
(plu lvar)))
+(defun principal-lvar-dest (lvar)
+ (labels ((pld (lvar)
+ (declare (type lvar lvar))
+ (let ((dest (lvar-dest lvar)))
+ (if (cast-p dest)
+ (pld (cast-lvar dest))
+ dest))))
+ (pld lvar)))
+
;;; Update lvar use information so that NODE is no longer a use of its
;;; LVAR.
;;;
(when (lambda-p clambda1)
(dolist (var (lambda-vars clambda1) t)
(dolist (var-ref (lambda-var-refs var))
- (let ((dest (lvar-dest (ref-lvar var-ref))))
+ (let ((dest (principal-lvar-dest (ref-lvar var-ref))))
(unless (and (combination-p dest) (recurse dest))
(return-from combination-args-flow-cleanly-p nil)))))))))))
(recurse combination1)))
+(defun ref-good-for-dx-p (ref)
+ (let* ((lvar (ref-lvar ref))
+ (dest (when lvar (lvar-dest lvar))))
+ (and (combination-p dest)
+ (eq :known (combination-kind dest))
+ (awhen (combination-fun-info dest)
+ (or (ir1-attributep (fun-info-attributes it) dx-safe)
+ (and (not (combination-lvar dest))
+ (awhen (fun-info-result-arg it)
+ (eql lvar (nth it (combination-args dest))))))))))
+
(defun trivial-lambda-var-ref-p (use)
(and (ref-p use)
(let ((var (ref-leaf use)))
(neq :indefinite (lambda-var-extent var)))
(let ((home (lambda-var-home var))
(refs (lambda-var-refs var)))
- ;; bound by a non-XEP system lambda, no other REFS
+ ;; bound by a non-XEP system lambda, no other REFS that aren't
+ ;; DX-SAFE, or are result-args when the result is discarded.
(when (and (lambda-system-lambda-p home)
(neq :external (lambda-kind home))
- (eq use (car refs)) (not (cdr refs)))
+ (dolist (ref refs t)
+ (unless (or (eq use ref) (ref-good-for-dx-p ref))
+ (return nil))))
;; the LAMBDA this var is bound by has only a single REF, going
;; to a combination
(let* ((lambda-refs (lambda-refs home))
(reoptimize-lvar prev)))
\f
;;; Return a new LEXENV just like DEFAULT except for the specified
-;;; slot values. Values for the alist slots are NCONCed to the
+;;; slot values. Values for the alist slots are APPENDed to the
;;; beginning of the current value, rather than replacing it entirely.
(defun make-lexenv (&key (default *lexenv*)
funs vars blocks tags
(macrolet ((frob (var slot)
`(let ((old (,slot default)))
(if ,var
- (nconc ,var old)
+ (append ,var old)
old))))
(internal-make-lexenv
(frob funs lexenv-funs)
(and ok (member name fun-names :test #'eq))))
(or (not arg-count)
(= arg-count (length (combination-args use)))))))
+
+;;; True if the optional has a rest-argument.
+(defun optional-rest-p (opt)
+ (dolist (var (optional-dispatch-arglist opt) nil)
+ (let* ((info (when (lambda-var-p var)
+ (lambda-var-arg-info var)))
+ (kind (when info
+ (arg-info-kind info))))
+ (when (eq :rest kind)
+ (return t)))))
+
+;;; Don't substitute single-ref variables on high-debug / low speed, to
+;;; improve the debugging experience. ...but don't bother keeping those
+;;; from system lambdas.
+(defun preserve-single-use-debug-var-p (call var)
+ (and (policy call (eql preserve-single-use-debug-variables 3))
+ (or (not (lambda-var-p var))
+ (not (lambda-system-lambda-p (lambda-var-home var))))))