From db627ca2cfc745bbf2e489251e64054ab2b3bff9 Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Wed, 25 Oct 2017 14:50:32 +0200 Subject: Update sheet traversal --- sheet.ml | 37 +++++++++++++++++++------------------ 1 file 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 *) -- cgit v1.2.3