diff options
Diffstat (limited to 'sheet.ml')
| -rwxr-xr-x | sheet.ml | 58 |
1 files changed, 37 insertions, 21 deletions
@@ -81,28 +81,44 @@ module Raw = struct None
end
- (** Parse all the successors from [init] and call [f] for each of them.
- As long as [f] return [Some _], the cell successors will also be updated.
-
- [f] is called only once for each successor.
- @return all the successors collected, and the map updated.
- *)
- let successors (f:(cell -> content -> t -> t option)) (init:content) (state:Cell.Set.t * t) = begin
- let rec fold cell (succ, t) = begin
- if (Cell.Set.mem cell succ) then
- (* The element has already been parsed, do not cycle *)
- (succ, t)
- else (
- (* Map.find cannot raise Not_found here : we look for a successor from a registered cell.
- *)
- let content = Map.find cell t in
- match f cell content t with
- | None -> (succ, t)
- | Some x -> Cell.Set.fold fold content.sink (Cell.Set.add cell succ, x)
+ (** 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 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 Cycle) in
+ 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) in
+ let succ = Cell.Set.add element succ in
+ let succ, t = traverse set_error content (succ, t) in
+ (Cell.Set.empty, succ, t)
+ ) else (
+ begin match f element content t with
+ | None ->
+ (* The content does not change, we do not update the successors *)
+ (Cell.Set.empty, succ, t)
+ | Some t' ->
+ let parents' = Cell.Set.add element parents in
+ let succ' = Cell.Set.add element succ in
+ if (Cell.Set.is_empty content.sink) then
+ (Cell.Set.empty, succ', t')
+ else
+ Cell.Set.fold successors content.sink (parents', succ', t')
+ end
)
end in
- Cell.Set.fold fold init.sink state
+ let _, succ, t = Cell.Set.fold successors source.sink (Cell.Set.empty, init, t) in
+ succ, t
end
(** Remove the cell from the sheet *)
@@ -146,7 +162,7 @@ module Raw = struct | t, None -> Cell.Set.empty, t
| t, Some content ->
(** Update all the successors *)
- successors update content (Cell.Set.singleton id, t)
+ traverse update content (Cell.Set.singleton id, t)
end
let add_element id f t = begin
@@ -175,7 +191,7 @@ module Raw = struct in
(** Update the value for each sink already evaluated *)
- successors update content (Cell.Set.singleton id, updated)
+ traverse update content (Cell.Set.singleton id, updated)
end
let add id expression t = begin
|