/[cmucl]/src/compiler/ir1opt.lisp
ViewVC logotype

Diff of /src/compiler/ir1opt.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.42 by ram, Wed Apr 1 13:38:17 1992 UTC revision 1.43 by ram, Thu Apr 2 15:25:38 1992 UTC
# Line 1130  Line 1130 
1130  ;;; -- CONT receives multiple values, or  ;;; -- CONT receives multiple values, or
1131  ;;; -- the reference is in a different environment from the variable, or  ;;; -- the reference is in a different environment from the variable, or
1132  ;;; -- either continuation has a funky TYPE-CHECK annotation.  ;;; -- either continuation has a funky TYPE-CHECK annotation.
1133    ;;; -- the continuations have incompatible assertions, so the new asserted type
1134    ;;;    would be NIL.
1135  ;;; -- the var's DEST has a different policy than the ARG's (think safety).  ;;; -- the var's DEST has a different policy than the ARG's (think safety).
1136  ;;;  ;;;
1137  ;;;    We change the Ref to be a reference to NIL with unused value, and let it  ;;;    We change the Ref to be a reference to NIL with unused value, and let it
# Line 1140  Line 1142 
1142    (declare (type continuation arg) (type lambda-var var))    (declare (type continuation arg) (type lambda-var var))
1143    (let* ((ref (first (leaf-refs var)))    (let* ((ref (first (leaf-refs var)))
1144           (cont (node-cont ref))           (cont (node-cont ref))
1145             (cont-atype (continuation-asserted-type cont))
1146           (dest (continuation-dest cont)))           (dest (continuation-dest cont)))
1147      (when (and (eq (continuation-use cont) ref)      (when (and (eq (continuation-use cont) ref)
1148                 dest                 dest
# Line 1148  Line 1151 
1151                     (lambda-home (lambda-var-home var)))                     (lambda-home (lambda-var-home var)))
1152                 (member (continuation-type-check arg) '(t nil))                 (member (continuation-type-check arg) '(t nil))
1153                 (member (continuation-type-check cont) '(t nil))                 (member (continuation-type-check cont) '(t nil))
1154                   (not (eq (values-type-intersection
1155                             cont-atype
1156                             (continuation-asserted-type arg))
1157                            *empty-type*))
1158                 (eq (lexenv-cookie (node-lexenv dest))                 (eq (lexenv-cookie (node-lexenv dest))
1159                     (lexenv-cookie (node-lexenv (continuation-dest arg)))))                     (lexenv-cookie (node-lexenv (continuation-dest arg)))))
1160        (assert (member (continuation-kind arg)        (assert (member (continuation-kind arg)
1161                        '(:block-start :deleted-block-start :inside-block)))                        '(:block-start :deleted-block-start :inside-block)))
1162        (assert-continuation-type arg (continuation-asserted-type cont))        (assert-continuation-type arg cont-atype)
1163        (setf (node-derived-type ref) *wild-type*)        (setf (node-derived-type ref) *wild-type*)
1164        (change-ref-leaf ref (find-constant nil))        (change-ref-leaf ref (find-constant nil))
1165        (substitute-continuation arg cont)        (substitute-continuation arg cont)

Legend:
Removed from v.1.42  
changed lines
  Added in v.1.43

  ViewVC Help
Powered by ViewVC 1.1.5