- (unless (eq (continuation-block this-cont) block)
- (barf "BLOCK in ~S should be ~S." this-cont block))
-
- (let ((dest (continuation-dest this-cont)))
- (when dest
- (check-node-reached dest)))
-
- (let ((node (continuation-next this-cont)))
- (unless (node-p node)
- (barf "~S has strange NEXT." this-cont))
- (unless (eq (node-prev node) this-cont)
- (barf "PREV in ~S should be ~S." node this-cont))
-
- (unless fun-deleted
- (check-node-consistency node))
-
- (let ((cont (node-cont node)))
- (when (not cont)
- (barf "~S has no CONT." node))
- (when (eq node last) (return))
- (unless (eq (continuation-kind cont) :inside-block)
- (barf "The interior continuation ~S in ~S has the wrong kind."
- cont
- block))
- (unless (continuation-next cont)
- (barf "~S has no NEXT." cont))
- (unless (eq (continuation-use cont) node)
- (barf "USE in ~S should be ~S." cont node))
- (setq this-cont cont))))
+ (unless (eq (ctran-block this-ctran) block)
+ (barf "BLOCK of ~S should be ~S." this-ctran block))
+
+ (let ((node (ctran-next this-ctran)))
+ (unless (node-p node)
+ (barf "~S has strange NEXT." this-ctran))
+ (unless (eq (node-prev node) this-ctran)
+ (barf "PREV in ~S should be ~S." node this-ctran))
+
+ (when (valued-node-p node)
+ (binding* ((lvar (node-lvar node) :exit-if-null))
+ (unless (memq node (find-uses lvar))
+ (barf "~S is not used by its LVAR ~S." node lvar))
+ (when (singleton-p (lvar-uses lvar))
+ (barf "~S has exactly 1 use, but LVAR-USES is a list."
+ lvar))
+ (unless (lvar-dest lvar)
+ (barf "~S does not have dest." lvar))))
+
+ (check-node-reached node)
+ (unless fun-deleted
+ (check-node-consistency node))
+
+ (let ((next (node-next node)))
+ (when (and (not next) (not (eq node last)))
+ (barf "~S has no NEXT." node))
+ (when (eq node last) (return))
+ (unless (eq (ctran-kind next) :inside-block)
+ (barf "The interior ctran ~S in ~S has the wrong kind."
+ next
+ block))
+ (unless (ctran-next next)
+ (barf "~S has no NEXT." next))
+ (unless (eq (ctran-use next) node)
+ (barf "USE in ~S should be ~S." next node))
+ (setq this-ctran next))))