* digraph.el (digraph-saf-dfs): Use implicit control stack.

diff --git a/ChangeLog b/ChangeLog
index 6dd5e1e..958ec0e 100644 (file)
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,9 @@
 1999-03-09  Tanaka Akira      <akr@jaist.ac.jp>
 
+       * digraph.el (digraph-saf-dfs): Use implicit control stack.
+
+1999-03-09  Tanaka Akira      <akr@jaist.ac.jp>
+
        * digraph.el: Refined.
 
        * automata.el (automata): Adopted to above.

diff --git a/digraph.el b/digraph.el
index 2c80591..070886c 100644 (file)
--- a/digraph.el
+++ b/digraph.el
@@ -261,7 +261,8 @@ components in G as new nodes.
          (d-to-g (aref tmp 2))
         (mm (digraph-make-merge-map (digraph-size d)))
         )
-    (digraph-saf-dfs d mm '() (list (digraph-roots d)))
+    (digraph-saf-dfs d mm (make-vector (digraph-size d) 'unvisited)
+                    nil (digraph-roots d))
     (let* ((maps (digraph-mm-make-map mm))
           (forward-map (car maps))
           (reverse-map (cdr maps))
@@ -273,51 +274,43 @@ components in G as new nodes.
              (digraph-concat-forward-map g-to-d forward-map)
              (digraph-concat-reverse-map reverse-map d-to-g)))))
 
-(defun digraph-saf-dfs (original mm node-stack descents-stack)
-  (let ((status (make-vector (digraph-size original) 'unvisited)))
-    (while descents-stack
-      (if (null (car descents-stack))
-         (progn
-           (when node-stack
-             (aset status (car node-stack) 'visited)
-             (setq node-stack (cdr node-stack)))
-           (setq descents-stack (cdr descents-stack)))
-       (let ((node (caar descents-stack))
-             (ascent (car node-stack)))
-         (setcar descents-stack (cdr (car descents-stack)))
-         (cond
-          ((eq (aref status node) 'visiting)
-           (error "not DAG"))
-          ((eq (aref status node) 'unvisited)
-           (digraph-mm-push-info mm node ascent)
-           (aset status node 'visiting)
-           (setq node-stack (cons node node-stack)
-                 descents-stack (cons (digraph-descents original node) descents-stack)))
-          ((eq (aref status node) 'visited)
-           (let ((n node))
-             (while (and n (eq (aref status (setq n (digraph-mm-canonicalize-node mm n))) 'visited))
-               (setq n (digraph-mm-top-info mm n)))
-             (when n
-               (setq n (digraph-mm-canonicalize-node mm n)))
-             (let ((a (digraph-mm-canonicalize-node mm ascent))
-                   (b (digraph-mm-canonicalize-node mm (digraph-mm-top-info mm node))))
-               (while (and (not (eq a n)) (not (eq b n)))
-                 (let ((a1 (digraph-mm-top-info mm a))
-                       (b1 (digraph-mm-top-info mm b)))
-                   (digraph-mm-merge-node mm a b)
-                   (unless a1
-                     (digraph-mm-push-info mm a b1))
-                   (setq a (and a1 (digraph-mm-canonicalize-node mm a1))
-                         b (and b1 (digraph-mm-canonicalize-node mm b1)))))
-               (when (and n (not (and (eq a n) (eq b n))))
-                 (if (eq a n)
-                     (while (not (eq n b))
-                       (let ((b1 (digraph-mm-canonicalize-node mm (digraph-mm-top-info mm b))))
-                         (digraph-mm-merge-node mm n b)
-                         (setq b b1)))
-                   (while (not (eq n a))
-                     (let ((a1 (digraph-mm-canonicalize-node mm (digraph-mm-top-info mm a))))
-                       (digraph-mm-merge-node mm n a)
-                       (setq a a1))))))))))))))
+(defun digraph-saf-dfs (d mm status ascent descents)
+  (while descents
+    (let ((node (car descents)))
+      (setq descents (cdr descents))
+      (cond
+       ((eq (aref status node) 'visiting)
+       (error "not DAG"))
+       ((eq (aref status node) 'unvisited)
+       (digraph-mm-push-info mm node ascent)
+       (aset status node 'visiting)
+       (digraph-saf-dfs d mm status node (digraph-descents d node))
+       (aset status node 'visited))
+       ((eq (aref status node) 'visited)
+       (let ((n node))
+         (while (and n (eq (aref status (setq n (digraph-mm-canonicalize-node mm n))) 'visited))
+           (setq n (digraph-mm-top-info mm n)))
+         (when n
+           (setq n (digraph-mm-canonicalize-node mm n)))
+         (let ((a (digraph-mm-canonicalize-node mm ascent))
+               (b (digraph-mm-canonicalize-node mm (digraph-mm-top-info mm node))))
+           (while (and (not (eq a n)) (not (eq b n)))
+             (let ((a1 (digraph-mm-top-info mm a))
+                   (b1 (digraph-mm-top-info mm b)))
+               (digraph-mm-merge-node mm a b)
+               (unless a1
+                 (digraph-mm-push-info mm a b1))
+               (setq a (and a1 (digraph-mm-canonicalize-node mm a1))
+                     b (and b1 (digraph-mm-canonicalize-node mm b1)))))
+           (when (and n (not (and (eq a n) (eq b n))))
+             (if (eq a n)
+                 (while (not (eq n b))
+                   (let ((b1 (digraph-mm-canonicalize-node mm (digraph-mm-top-info mm b))))
+                     (digraph-mm-merge-node mm n b)
+                     (setq b b1)))
+               (while (not (eq n a))
+                 (let ((a1 (digraph-mm-canonicalize-node mm (digraph-mm-top-info mm a))))
+                   (digraph-mm-merge-node mm n a)
+                   (setq a a1))))))))))))
 
 (provide 'digraph)