(defun note-failed-optimization (node failures)
(declare (type combination node) (list failures))
(unless (or (node-deleted node)
(defun note-failed-optimization (node failures)
(declare (type combination node) (list failures))
(unless (or (node-deleted node)
(let ((*compiler-error-context* node))
(dolist (failure failures)
(let ((what (cdr failure))
(let ((*compiler-error-context* node))
(dolist (failure failures)
(let ((what (cdr failure))
- ((valid-function-use node what
- :argument-test #'types-equal-or-intersect
- :result-test #'values-types-equal-or-intersect)
+ ((valid-fun-use node what
+ :argument-test #'types-equal-or-intersect
+ :result-test #'values-types-equal-or-intersect)
- (valid-function-use node what
- :warning-function #'frob
- :error-function #'frob))
+ (valid-fun-use node what
+ :unwinnage-fun #'give-grief
+ :lossage-fun #'give-grief))
;;; For each named function with an XEP, note the definition of that
;;; name, and add derived type information to the INFO environment. We
;;; For each named function with an XEP, note the definition of that
;;; name, and add derived type information to the INFO environment. We
(defined-ftype (definition-type leaf)))
(setf (leaf-type leaf) defined-ftype)
(when (leaf-has-source-name-p leaf)
(let ((source-name (leaf-source-name leaf)))
(let* ((where (info :function :where-from source-name))
(*compiler-error-context* (lambda-bind (main-entry leaf)))
(defined-ftype (definition-type leaf)))
(setf (leaf-type leaf) defined-ftype)
(when (leaf-has-source-name-p leaf)
(let ((source-name (leaf-source-name leaf)))
(let* ((where (info :function :where-from source-name))
(*compiler-error-context* (lambda-bind (main-entry leaf)))
(let ((declared-ftype (info :function :type source-name)))
(unless (defined-ftype-matches-declared-ftype-p
defined-ftype declared-ftype)
(let ((declared-ftype (info :function :type source-name)))
(unless (defined-ftype-matches-declared-ftype-p
defined-ftype declared-ftype)
- (note-lossage "~@<The previously declared FTYPE~2I ~_~S~I ~_~
- conflicts with the definition type ~2I~_~S~:>"
- (type-specifier declared-ftype)
- (type-specifier defined-ftype)))))
+ (compiler-style-warn
+ "~@<The previously declared FTYPE~2I ~_~S~I ~_~
+ conflicts with the definition type ~2I~_~S~:>"
+ (type-specifier declared-ftype)
+ (type-specifier defined-ftype)))))
(let ((atype (info :function :assumed-type name)))
(dolist (ref (leaf-refs var))
(let ((dest (continuation-dest (node-cont ref))))
(let ((atype (info :function :assumed-type name)))
(dolist (ref (leaf-refs var))
(let ((dest (continuation-dest (node-cont ref))))
(setf (info :function :assumed-type name) atype))))
;;; Do miscellaneous things that we want to do once all optimization
(setf (info :function :assumed-type name) atype))))
;;; Do miscellaneous things that we want to do once all optimization