X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=src%2Fcompiler%2Fir1final.lisp;h=d2888c5f79bf91522d141c9a34a1b5168a881802;hb=02b6f6dfb38d99bcc3181035eb0681e6bb96b939;hp=94240a0f4b0b7866d1d871a1d93faf0eb42a87f2;hpb=96b310113978665980a8d65ad5dd83deab05c28b;p=sbcl.git diff --git a/src/compiler/ir1final.lisp b/src/compiler/ir1final.lisp index 94240a0..d2888c5 100644 --- a/src/compiler/ir1final.lisp +++ b/src/compiler/ir1final.lisp @@ -27,8 +27,8 @@ (note (transform-note (car failure)))) (cond ((consp what) - (compiler-note "~@" - note (first what) (rest what))) + (compiler-notify "~@" + note (first what) (rest what))) ((valid-fun-use node what :argument-test #'types-equal-or-intersect :result-test #'values-types-equal-or-intersect) @@ -39,10 +39,10 @@ (valid-fun-use node what :unwinnage-fun #'give-grief :lossage-fun #'give-grief)) - (compiler-note "~@" + (compiler-notify "~@" note (messages)))) ;; As best I can guess, it's OK to fall off the end here ;; because if it's not a VALID-FUNCTION-USE, the user @@ -59,7 +59,8 @@ (let* ((leaf (functional-entry-fun fun)) (defined-ftype (definition-type leaf))) (setf (leaf-type leaf) defined-ftype) - (when (leaf-has-source-name-p leaf) + (when (and (leaf-has-source-name-p leaf) + (eq (leaf-source-name leaf) (functional-debug-name leaf))) (let ((source-name (leaf-source-name leaf))) (let* ((where (info :function :where-from source-name)) (*compiler-error-context* (lambda-bind (main-entry leaf))) @@ -86,8 +87,13 @@ (type-specifier declared-ftype) (type-specifier defined-ftype))))) (:defined - (when global-p - (setf (info :function :type source-name) defined-ftype)))))))) + (setf (info :function :type source-name) defined-ftype))) + (when (fasl-output-p *compile-object*) + (if (member source-name *fun-names-in-this-file* :test #'equal) + (compiler-warn "~@" + source-name) + (push source-name *fun-names-in-this-file*))))))) (values)) ;;; Find all calls in COMPONENT to assumed functions and update the @@ -102,10 +108,10 @@ (eq (info :function :kind name) :function)) (let ((atype (info :function :assumed-type name))) (dolist (ref (leaf-refs var)) - (let ((dest (continuation-dest (node-cont ref)))) + (let ((dest (node-dest ref))) (when (and (eq (node-component ref) component) (combination-p dest) - (eq (continuation-use (basic-combination-fun dest)) ref)) + (eq (lvar-uses (basic-combination-fun dest)) ref)) (setq atype (note-fun-use dest atype))))) (setf (info :function :assumed-type name) atype))))