Update sheet traversal

1 files changed, 19 insertions, 18 deletions

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 *)