(defun note-failed-optimization (node failures)
(declare (type combination node) (list failures))
(unless (or (node-deleted node)
- (not (fun-info-p (combination-kind node))))
+ (not (eq :known (combination-kind node))))
(let ((*compiler-error-context* node))
(dolist (failure failures)
(let ((what (cdr failure))
(compiler-notify "~@<unable to ~
~2I~_~A ~
~I~_due to type uncertainty: ~
- ~2I~_~{~?~^~@:_~}~:>"
+ ~2I~_~{~?~^~@:_~}~:>"
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
(type-specifier declared-ftype)
(type-specifier defined-ftype)))))
(:defined
- (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 "~@<Duplicate definition for ~S found in ~
- one static unit (usually a file).~@:>"
- source-name)
- (push source-name *fun-names-in-this-file*)))))))
+ (setf (info :function :type source-name) defined-ftype)))))))
(values))
;;; Find all calls in COMPONENT to assumed functions and update the
(setq atype (note-fun-use dest atype)))))
(setf (info :function :assumed-type name) atype))))
+;;; Merge CASTs with preceding/following nodes.
+(defun ir1-merge-casts (component)
+ (do-blocks-backwards (block component)
+ (do-nodes-backwards (node lvar block)
+ (let ((dest (when lvar (lvar-dest lvar))))
+ (cond ((and (cast-p dest)
+ (not (cast-type-check dest))
+ (immediately-used-p lvar node))
+ (let ((dtype (node-derived-type node))
+ (atype (node-derived-type dest)))
+ (when (values-types-equal-or-intersect
+ dtype atype)
+ ;; FIXME: We do not perform pathwise CAST->type-error
+ ;; conversion, and type errors can later cause
+ ;; backend failures. On the other hand, this version
+ ;; produces less efficient code.
+ ;;
+ ;; This is sorta DERIVE-NODE-TYPE, but does not try
+ ;; to optimize the node.
+ (setf (node-derived-type node)
+ (values-type-intersection dtype atype)))))
+ ((and (cast-p node)
+ (eq (cast-type-check node) :external))
+ (aver (basic-combination-p dest))
+ (delete-filter node lvar (cast-value node))))))))
+
;;; Do miscellaneous things that we want to do once all optimization
;;; has been done:
;;; -- Record the derived result type before the back-end trashes the
(maphash (lambda (k v)
(note-assumed-types component k v))
*free-funs*)
+
+ (ir1-merge-casts component)
+
(values))