Skip to content
Snippets Groups Projects
Commit 6f71d2c9 authored by ram's avatar ram
Browse files

Added :RESTART-P key to DO-NODES that provides for robust iteration in

the presence of arbitrary destructive modifications of the block.
Fixed a broken declaration.
parent bbf5c1fe
No related branches found
No related tags found
No related merge requests found
...@@ -648,34 +648,52 @@ ...@@ -648,34 +648,52 @@
;;; ;;;
;;; In the forward case, we terminate on Last-Cont so that we don't have to ;;; In the forward case, we terminate on Last-Cont so that we don't have to
;;; worry about our termination condition being changed when new code is added ;;; worry about our termination condition being changed when new code is added
;;; during the iteration. If CONT gets deleted out from under us, go again ;;; during the iteration. In the backward case, we do NODE-PREV before
;;; from the previous CONT. In the backward case, we do NODE-PREV before
;;; evaluating the body so that we can keep going when the current node is ;;; evaluating the body so that we can keep going when the current node is
;;; deleted. ;;; deleted.
;;; ;;;
(defmacro do-nodes ((node-var cont-var block &optional result) &body body) ;;; When Restart-P is supplied to DO-NODES, we start iterating over again at
"Do-Nodes (Node-Var Cont-Var Block [Result]) {Declaration}* {Form}* ;;; the beginning of the block when we run into a continuation whose block
;;; differs from the one we are trying to iterate over, either beacuse the
;;; block was split, or because a node was deleted out from under us (hence its
;;; block is NIL.) If the block start is deleted, we just punt. With
;;; Restart-P, we are also more careful about termination, re-indirecting the
;;; BLOCK-LAST each time.
;;;
(defmacro do-nodes ((node-var cont-var block &key restart-p) &body body)
"Do-Nodes (Node-Var Cont-Var Block {Key Value}*) {Declaration}* {Form}*
Iterate over the nodes in Block, binding Node-Var to the each node and Iterate over the nodes in Block, binding Node-Var to the each node and
Cont-Var to the node's Cont." Cont-Var to the node's Cont. The only keyword option is Restart-P, which
causes iteration to be restarted when a node is deleted out from under us (if
not supplied, this is an error.)"
(let ((n-block (gensym)) (let ((n-block (gensym))
(n-last-cont (gensym)) (n-last-cont (gensym)))
(n-prev-cont (gensym)))
`(let* ((,n-block ,block) `(let* ((,n-block ,block)
(,n-last-cont (node-cont (block-last ,n-block)))) ,@(unless restart-p
`((,n-last-cont (node-cont (block-last ,n-block))))))
(do* ((,node-var (continuation-next (block-start ,n-block)) (do* ((,node-var (continuation-next (block-start ,n-block))
(if (eq (continuation-kind ,cont-var) :deleted) ,(if restart-p
(continuation-next ,n-prev-cont) `(cond
(continuation-next ,cont-var))) ((eq (continuation-block ,cont-var) ,n-block)
(,n-prev-cont nil ,cont-var) (assert (continuation-next ,cont-var))
(continuation-next ,cont-var))
(t
(let ((start (block-start ,n-block)))
(unless (eq (continuation-kind start)
:block-start)
(return nil))
(continuation-next start))))
`(continuation-next ,cont-var)))
(,cont-var (node-cont ,node-var) (node-cont ,node-var))) (,cont-var (node-cont ,node-var) (node-cont ,node-var)))
(()) (())
,@body ,@body
(when (eq ,cont-var ,n-last-cont) (when ,(if restart-p
(return ,result)))))) `(eq ,node-var (block-last ,n-block))
`(eq ,cont-var ,n-last-cont))
(return nil))))))
;;; ;;;
(defmacro do-nodes-backwards ((node-var cont-var block &optional result) (defmacro do-nodes-backwards ((node-var cont-var block) &body body)
&body body) "Do-Nodes-Backwards (Node-Var Cont-Var Block) {Declaration}* {Form}*
"Do-Nodes-Backwards (Node-Var Cont-Var Block [Result]) {Declaration}* {Form}*
Like Do-Nodes, only iterates in reverse order." Like Do-Nodes, only iterates in reverse order."
(let ((n-block (gensym)) (let ((n-block (gensym))
(n-start (gensym)) (n-start (gensym))
...@@ -690,7 +708,7 @@ ...@@ -690,7 +708,7 @@
(()) (())
,@body ,@body
(when (eq ,n-next ,n-start) (when (eq ,n-next ,n-start)
(return ,result)))))) (return nil))))))
;;; With-IR1-Environment -- Interface ;;; With-IR1-Environment -- Interface
...@@ -749,7 +767,7 @@ ...@@ -749,7 +767,7 @@
;;; These functions are called by the expansion of the Defprinter ;;; These functions are called by the expansion of the Defprinter
;;; macro to do the actual printing. ;;; macro to do the actual printing.
;;; ;;;
(proclaim '(ftype (function (symbol t stream) void) (proclaim '(ftype (function (symbol t stream &optional t) void)
defprinter-prin1 defprinter-princ)) defprinter-prin1 defprinter-princ))
(defun defprinter-prin1 (name value stream &optional indent) (defun defprinter-prin1 (name value stream &optional indent)
(declare (ignore indent)) (declare (ignore indent))
......
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