(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
;;; possibility that new references might be converted to it.
(defun finalize-xep-definition (fun)
(let* ((leaf (functional-entry-fun fun))
;;; possibility that new references might be converted to it.
(defun finalize-xep-definition (fun)
(let* ((leaf (functional-entry-fun fun))
(let ((source-name (leaf-source-name leaf)))
(let* ((where (info :function :where-from source-name))
(*compiler-error-context* (lambda-bind (main-entry 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 ((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