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

Changed DO-NODES to work even when multiple next nodes are deleted.

Added some uses of REQUIRED-ARGUMENT in slot defaults.
parent 65d6aa81
No related branches found
No related tags found
No related merge requests found
...@@ -646,7 +646,8 @@ ...@@ -646,7 +646,8 @@
;;; ;;;
;;; 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. In the backward case, we do NODE-PREV before ;;; during the iteration. If CONT gets deleted out from under us, go again
;;; 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.
;;; ;;;
...@@ -655,11 +656,15 @@ ...@@ -655,11 +656,15 @@
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."
(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)))) (,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))
(continuation-next ,cont-var)) (if (eq (continuation-kind ,cont-var) :deleted)
(continuation-next ,n-prev-cont)
(continuation-next ,cont-var)))
(,n-prev-cont nil ,cont-var)
(,cont-var (node-cont ,node-var) (node-cont ,node-var))) (,cont-var (node-cont ,node-var) (node-cont ,node-var)))
(()) (())
,@body ,@body
...@@ -958,25 +963,24 @@ ...@@ -958,25 +963,24 @@
(defstruct event-info (defstruct event-info
;; ;;
;; The name of this event. ;; The name of this event.
(name nil :type symbol) (name (required-argument) :type symbol)
;; ;;
;; The string rescribing this event. ;; The string rescribing this event.
(description nil :type string) (description (required-argument) :type string)
;; ;;
;; The name of the variable we stash this in. ;; The name of the variable we stash this in.
(var nil :type symbol) (var (required-argument) :type symbol)
;; ;;
;; The number of times this event has happened. ;; The number of times this event has happened.
(count 0 :type fixnum) (count 0 :type fixnum)
;; ;;
;; The level of significance of this event. ;; The level of significance of this event.
(level nil :type unsigned-byte) (level (required-argument) :type unsigned-byte)
;; ;;
;; If true, a function that gets called with the node that the event happened ;; If true, a function that gets called with the node that the event happened
;; to. ;; to.
(action nil :type (or function null))) (action nil :type (or function null)))
;;; A hashtable from event names to event-info structures. ;;; A hashtable from event names to event-info structures.
;;; ;;;
(defvar *event-info* (make-hash-table :test #'eq)) (defvar *event-info* (make-hash-table :test #'eq))
......
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