Skip to content
Snippets Groups Projects
Commit 38116cfe authored by dtc's avatar dtc
Browse files

Delay the generation of the type checks delayed until all the type

check decisions have been made because the generation of the type
checks creates new nodes who's derived types aren't always updated
which may lead to inappropriate template choices due to the
modification of argument types.
parent eac36a27
No related branches found
No related tags found
No related merge requests found
......@@ -5,7 +5,7 @@
;;; Carnegie Mellon University, and has been placed in the public domain.
;;;
(ext:file-comment
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/checkgen.lisp,v 1.24 1994/10/31 04:27:28 ram Exp $")
"$Header: /Volumes/share2/src/cmucl/cvs2git/cvsroot/src/compiler/checkgen.lisp,v 1.25 1998/01/06 16:51:51 dtc Exp $")
;;;
;;; **********************************************************************
;;;
......@@ -493,39 +493,48 @@
;;; the hairy case, we must indicate to LTN that it must choose a safe
;;; implementation, since IR2 conversion will choke on the check.
;;;
;;; The generation of the type checks is delayed until all the type
;;; check decisions have been made because the generation of the type
;;; checks creates new nodes who's derived types aren't always updated
;;; which may lead to inappropriate template choices due to the
;;; modification of argument types.
;;;
(defun generate-type-checks (component)
(do-blocks (block component)
(when (block-type-check block)
(do-nodes (node cont block)
(let ((type-check (continuation-type-check cont)))
(unless (member type-check '(nil :error :deleted))
(let ((atype (continuation-asserted-type cont)))
(do-uses (use cont)
(unless (values-types-intersect (node-derived-type use)
atype)
(mark-error-continuation cont)
(unless (policy node (= brevity 3))
(do-type-warning use))))))
(collect ((conts))
(do-blocks (block component)
(when (block-type-check block)
(do-nodes (node cont block)
(let ((type-check (continuation-type-check cont)))
(unless (member type-check '(nil :error :deleted))
(let ((atype (continuation-asserted-type cont)))
(do-uses (use cont)
(unless (values-types-intersect (node-derived-type use)
atype)
(mark-error-continuation cont)
(unless (policy node (= brevity 3))
(do-type-warning use))))))
(when (and (eq type-check t)
(not *byte-compiling*))
(if (probable-type-check-p cont)
(conts cont)
(setf (continuation-%type-check cont) :no-check)))))
(setf (block-type-check block) nil)))
(dolist (cont (conts))
(multiple-value-bind (check types)
(continuation-check-types cont)
(ecase check
(:simple)
(:hairy
(convert-type-check cont types))
(:too-hairy
(let* ((context (continuation-dest cont))
(*compiler-error-context* context))
(when (policy context (>= safety brevity))
(compiler-note
"Type assertion too complex to check:~% ~S."
(type-specifier (continuation-asserted-type cont)))))
(setf (continuation-%type-check cont) :deleted))))))
(when (and (eq type-check t)
(not *byte-compiling*))
(if (probable-type-check-p cont)
(multiple-value-bind (check types)
(continuation-check-types cont)
(ecase check
(:simple)
(:hairy
(convert-type-check cont types))
(:too-hairy
(let* ((context (continuation-dest cont))
(*compiler-error-context* context))
(when (policy context (>= safety brevity))
(compiler-note
"Type assertion too complex to check:~% ~S."
(type-specifier (continuation-asserted-type cont)))))
(setf (continuation-%type-check cont) :deleted))))
(setf (continuation-%type-check cont) :no-check)))))
(setf (block-type-check block) nil)))
(undefined-value))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment