From 35ac289339237fcb758d1b876dcd724ddc354e16 Mon Sep 17 00:00:00 2001 From: ram <ram> Date: Thu, 23 Aug 1990 18:42:50 +0000 Subject: [PATCH] Changed ENVIRONMENT-ANALYZE so that it doesn't always give multiple "does not return" notes. --- compiler/envanal.lisp | 25 +++++++++++++------------ 1 file changed, 13 insertions(+), 12 deletions(-) diff --git a/compiler/envanal.lisp b/compiler/envanal.lisp index 2a73c1e8f..e21d840c6 100644 --- a/compiler/envanal.lisp +++ b/compiler/envanal.lisp @@ -38,18 +38,19 @@ (declare (type component component)) (assert (not (component-new-functions component))) (dolist (fun (component-lambdas component)) - (let* ((f (if (eq (functional-kind fun) :external) - (functional-entry-function fun) - fun)) - (dtype (definition-type f)) - (node (lambda-bind fun))) - (setf (leaf-type f) dtype) - (when (and (eq (function-type-returns dtype) *empty-type*) - (or (functional-entry-function f) - (null (functional-kind f))) - (policy node (>= safety brevity))) - (let ((*compiler-error-context* node)) - (compiler-note "Function does not return.")))) + (let* ((ef (functional-entry-function fun)) + (kind (functional-kind fun)) + (f (cond ((eq (functional-kind fun) :external) + (when (optional-dispatch-p ef) ef)) + ((null kind) fun)))) + (when f + (let* ((dtype (definition-type f)) + (node (lambda-bind fun))) + (setf (leaf-type f) dtype) + (when (and (eq (function-type-returns dtype) *empty-type*) + (policy node (>= safety brevity))) + (let ((*compiler-error-context* node)) + (compiler-note "Function does not return.")))))) (get-lambda-environment fun)) -- GitLab