diff options
| -rwxr-xr-x | sheet.ml | 37 |
1 files changed, 19 insertions, 18 deletions
@@ -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 *)
|