aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSébastien Dailly <sebastien@chimrod.com>2017-10-25 14:50:32 +0200
committerSébastien Dailly <sebastien@chimrod.com>2017-10-25 14:50:32 +0200
commitdb627ca2cfc745bbf2e489251e64054ab2b3bff9 (patch)
tree7190145bc67a8fe69683109a1c52403eb08ec7dc
parent85231845871c841089308c9bc92569d36cb548db (diff)
Update sheet traversal
-rwxr-xr-xsheet.ml37
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 *)