From db627ca2cfc745bbf2e489251e64054ab2b3bff9 Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@chimrod.com>
Date: Wed, 25 Oct 2017 14:50:32 +0200
Subject: Update sheet traversal

---
 sheet.ml | 37 +++++++++++++++++++------------------
 1 file changed, 19 insertions(+), 18 deletions(-)

(limited to 'sheet.ml')

diff --git a/sheet.ml b/sheet.ml
index a17c08c..22446e5 100755
--- a/sheet.ml
+++ b/sheet.ml
@@ -79,50 +79,52 @@ module Raw = struct
         None
   end
 
-
   (** Parse all the successors from an element, apply a function to each of
       them, and return them *)
   let rec traverse (f:(cell -> content -> t -> t option)) source (init, t) = begin
 
-    let rec successors element (parents, succ, t) = begin
+    let exception Cycle of Cell.Set.t * t in
+
+    let rec successors parents element (succ, t) = begin
 
       let content = Map.find element t in
 
       if Cell.Set.mem element parents then (
+
         (* if the cell has already been visited, mark it in error, and all the
            descendant *)
         let cycle_error = Some (ScTypes.Error Errors.Cycle) in
 
-        if content.value = cycle_error then
-          (* The content has already been update, do not process it again *)
-          (parents, succ, t)
-        else
+        if content.value = cycle_error then (
+          (* The content has already been updated, do not process it again *)
+          (succ, t)
+        ) else (
           let t = Map.add element { content with value = cycle_error } t
           and set_error cell content t =
             if content.value = cycle_error then
               None
             else
-              Some (Map.add cell { content with value = cycle_error } t)
-          and succ = Cell.Set.add element succ in
-          let succ, t = traverse set_error content (succ, t) in
-          (parents, succ, t)
+              Some (Map.add cell { content with value = cycle_error } t) in
+          let succ, t = traverse set_error source (init, t) in
+          raise (Cycle (succ, t))
+        )
       ) else (
         begin match f element content t with
         | None ->
           (* The content does not change, we do not update the successors *)
-          (init, succ, t)
+          (succ, t)
         | Some t' ->
           let parents' = Cell.Set.add element parents
           and succ' = Cell.Set.add element succ in
           if (Cell.Set.is_empty content.sink) then
-            (init, succ', t')
+            (succ', t')
           else
-            Cell.Set.fold successors content.sink (parents', succ', t')
+            Cell.Set.fold (successors parents') content.sink (succ', t')
         end
       )
     end in
-    let _, succ, t = Cell.Set.fold successors source.sink (init, init, t) in
-    succ, t
+    try  Cell.Set.fold (successors init) source.sink (init, t)
+    with Cycle (succ, t) -> (succ, t)
   end
 
   (** Remove the cell from the sheet *)
@@ -219,9 +221,8 @@ module Raw = struct
     add_element id f t
   end
 
-  exception Found of (int * int)
-
   let search pattern t = begin
+    let exception Found of (int * int) in
 
     let _search key content = if content.value = pattern then raise (Found key) in
     try
@@ -246,7 +247,7 @@ module Raw = struct
 
 end
 
-type yank =cell * Raw.content
+type yank = cell * Raw.content
 
 type t = {
   selected: Selection.t;    (* The selected cell *)
-- 
cgit v1.2.3