diff options
Diffstat (limited to 'src')
| -rwxr-xr-x | src/sheet.ml | 164 | ||||
| -rw-r--r-- | src/tree/splay.ml | 5 | ||||
| -rwxr-xr-x | src/tree/splay.mli | 5 |
3 files changed, 118 insertions, 56 deletions
diff --git a/src/sheet.ml b/src/sheet.ml index b72786e..4984bde 100755 --- a/src/sheet.ml +++ b/src/sheet.ml @@ -34,70 +34,122 @@ module Raw = struct (** Internaly, we use an array to store the data. Each array as a fixed size
of 8×8 cells, and each array is stored in a tree. *)
- module Map = PageMap.SplayMap(struct type t = content let default = empty_cell end)
+ module PageMap = PageMap.SplayMap(struct type t = content let default = empty_cell end)
- (** The sheet is a map which always contains evaluated values. When a cell is
+ (** The sheet is a PageMap which always contains evaluated values. When a cell is
updated, all the cell which references this value are also updated.
*)
- type t = Map.t
+ type t = PageMap.t
- let get_expr id t = (Map.find id t).expr
+ let get_expr id t = (PageMap.find id t).expr
(** Update the value for the given cell.
Evaluate the new expression and compare it with the previous value.
- @return Some map if the map has been updated
+ @return Some PageMap if the PageMap has been updated
*)
let update catalog cell content t = begin
- let new_val = Expression.eval content.expr catalog (fun id -> (Map.find id t).value) in
+ let new_val = Expression.eval content.expr catalog (fun id -> (PageMap.find id t).value) in
match content.value with
| None ->
- (* If the previous value wasn't defined, update the map *)
- Some (Map.add cell { content with value = Some new_val } t)
+ (* If the previous value wasn't defined, update the PageMap *)
+ Some (PageMap.add cell { content with value = Some new_val } t)
| Some old_value ->
(* If the previous value was defined, update only if result differs *)
if not (ScTypes.Result.(=) new_val old_value) then
- Some (Map.add cell { content with value = Some new_val } t)
+ Some (PageMap.add cell { content with value = Some new_val } t)
else
- (* If there is no changes, do not update the map *)
+ (* If there is no changes, do not update the PageMap *)
None
end
- let traverse (f:(cell -> content -> t -> t option)) content (init, t) = begin
+ let traverse (f:(cell -> content -> t -> t option)) content (id, t) = begin
- let rec ts visited t next = begin
- if Cell.Set.is_empty next then
- Ok (visited, t)
+ let module M = Hashtbl.Make(struct
+ type t = cell
+ let equal c1 c2 = c1 = c2
+ let hash (x, y) = (lnot x) + y
+ end) in
+
+ (* Create a table with each cell and it evaluation order.
+ Detect cycles and return None if there is any.
+ *)
+ let rec _order cache level next : cell array option =
+ begin match (Cell.Set.is_empty next) with
+ | true ->
+ (* Nothing more to do, store the values in an array, and return it. *)
+ let arr = Array.make (M.length cache) (0, (0, 0)) in
+ let i = ref 0 in
+ M.iter (fun id (idx, _) -> Array.set arr (!i) (idx, id); incr i ) cache;
+ Array.sort (fun ((v1:int), _) ((v2:int), _) -> compare v1 v2) arr;
+ Some (Array.map (fun (_, cell) -> cell) arr)
+
+ | false ->
+ let id = Cell.Set.choose next in
+
+ let content = PageMap.find id t in
+
+ let update k = function
+ | None -> None
+ | Some level ->
+ let level' = level + 1 in
+ begin match M.find_opt cache k with
+ | None -> M.add cache k (level', Cell.Set.singleton id);
+ Some level'
+ | Some (depth, pred) ->
+ if (Cell.Set.mem id pred) then
+ (* There is a cycle, break the loop *)
+ None
+ else
+ let pred' = Cell.Set.add id pred in
+ M.replace cache k (level', pred');
+ Some level'
+ end
+ in
+
+ (* Update the cache for each sink in the cell *)
+ match Cell.Set.fold update content.sink level with
+ | None -> None (* There is a cylce, juste stop *)
+ | level' ->
+ (* Then add all the cell to be next set *)
+ Cell.Set.remove id next
+ |> Cell.Set.union content.sink
+ |> _order cache level'
+
+ end in
+
+ let eval (to_update, t) (id) = begin
+ if not (Cell.Set.mem id to_update) then
+ (to_update, t)
else
- let (id:cell) = Cell.Set.choose next in
+ let content = PageMap.find id t in
+ match f id content t with
+ | None -> (to_update, t)
+ | Some t' -> (Cell.Set.union content.sink to_update, t')
+ end in
- if Cell.Set.mem id init then
- Error (visited, t)
+ (** Traverse all the cells to mark them with an error *)
+ let cycle_error = Some (ScTypes.Result.Error Errors.Cycle) in
+ let rec set_error t next = begin
+ if Cell.Set.is_empty next then
+ (* Nothing more to do, just return the sheet updated *)
+ t
+ else
+ let id = Cell.Set.choose next in
+ let content = PageMap.find id t in
+ let next' = Cell.Set.remove id next in
+ if content.value = cycle_error then
+ set_error t next'
else
- let content = Map.find id t in
- let next' = Cell.Set.remove id next
- and visited' = Cell.Set.add id visited in
-
- begin match f id content t with
- | None ->
- (* The content does not change, we do not update the successors *)
- (ts[@tailcall]) visited' t next'
- | Some t' ->
- let delta = Cell.Set.diff content.sink init in
- let next'' = Cell.Set.union next' delta in
-
- (ts[@tailcall]) visited' t' next''
- end
+ let t' = PageMap.add id { content with value = cycle_error } t in
+ set_error t' (Cell.Set.union next' content.sink)
end in
- begin match ts init t content.sink with
- | Ok (visited, t) -> (visited, t)
- | Error (visited, t) ->
- let cycle_error = Some (ScTypes.Result.Error Errors.Cycle) in
- let setErr cell t : t= Map.add cell { content with value = cycle_error } t in
- visited, Cell.Set.fold setErr visited t
- end
+ match _order (M.create 16) (Some 0) (Cell.Set.singleton id) with
+ | None -> Cell.Set.empty, (set_error t (Cell.Set.singleton id))
+ | Some arr -> Array.fold_left eval ((Cell.Set.add id content.sink), t) arr
end
+
(** Remove the cell from the sheet *)
let remove_element (id:cell) t : t * content option = begin
@@ -105,18 +157,18 @@ module Raw = struct If the sources is not referenced anywhere, and is Undefined, remove it
*)
let remove_ref cell t = begin
- try let c = Map.find cell t in
+ try let c = PageMap.find cell t in
(* Remove all the refs which points to the removed cell *)
let sink' = Cell.Set.filter ((<>) id) c.sink in
if Cell.Set.is_empty sink' && not (Expression.is_defined c.expr) then (
- Map.remove cell t )
+ PageMap.remove cell t )
else
- Map.add cell {c with sink = sink'} t
+ PageMap.add cell {c with sink = sink'} t
with Not_found -> t
end in
begin try
- let c = Map.find id t in
+ let c = PageMap.find id t in
let t' =
(** Remove the references from each cell pointed by the expression *)
let sources = Expression.collect_sources c.expr in
@@ -127,10 +179,10 @@ module Raw = struct let sink' = Cell.Set.filter ((<>) id) c.sink in
(** If there is no more references on the cell, remove it *)
if Cell.Set.is_empty sink' then
- Map.remove id t', None
+ PageMap.remove id t', None
else (
let c = { empty_cell with sink = sink' } in
- Map.add id c t', (Some c)
+ PageMap.add id c t', (Some c)
)
with Not_found -> t, None
end
@@ -141,7 +193,7 @@ module Raw = struct | t, None -> Cell.Set.empty, t
| t, Some content ->
(** Update all the successors *)
- traverse (update catalog) content (Cell.Set.singleton id, t)
+ traverse (update catalog) content (id, t)
end
let add_element catalog id content_builder t = begin
@@ -151,10 +203,10 @@ module Raw = struct *)
let add_ref cell t = begin
let c =
- try Map.find cell t
+ try PageMap.find cell t
with Not_found -> empty_cell in
let c' = { c with sink = Cell.Set.add id c.sink} in
- Map.add cell c' t
+ PageMap.add cell c' t
end in
(* Remove the cell and update all the sink. *)
@@ -166,12 +218,12 @@ module Raw = struct let content = content_builder cell' t' in
let sources = Expression.collect_sources content.expr in
- let updated = Map.add id content t'
+ let updated = PageMap.add id content t'
|> Cell.Set.fold add_ref sources
in
(** Update the value for each sink already evaluated *)
- traverse (update catalog) content (Cell.Set.singleton id, updated)
+ traverse (update catalog) content (id, updated)
end
let add id expression catalog t = begin
@@ -181,7 +233,7 @@ module Raw = struct let f cell t = begin
{ cell with
expr = expression ;
- value = Some (Expression.eval expression catalog (fun id -> (Map.find id t).value)) }
+ value = Some (Expression.eval expression catalog (fun id -> (PageMap.find id t).value)) }
end in
add_element catalog id f t
end
@@ -191,13 +243,13 @@ module Raw = struct let f cell t =
{ cell with
expr = expr ;
- value = Some (Expression.eval expr catalog (fun id -> (Map.find id t).value))
+ value = Some (Expression.eval expr catalog (fun id -> (PageMap.find id t).value))
} in
add_element catalog id f t
end
let get_sink id t =
- try (Map.find id t).sink
+ try (PageMap.find id t).sink
with Not_found -> Cell.Set.empty
end
@@ -245,7 +297,7 @@ let yank selected t = begin let origin = shift (0, 0) in
let _yank (count, extracted) cell = begin
let content =
- try let content = (Raw.Map.find cell (!t).data) in
+ try let content = (Raw.PageMap.find cell (!t).data) in
{ content with Raw.expr = Expression.shift origin content.Raw.expr }
with Not_found -> Raw.empty_cell in
@@ -288,7 +340,7 @@ let add ~history expression id t = begin end
let create catalog = ref {
- data = Raw.Map.empty;
+ data = Raw.PageMap.empty;
history = [];
yank = [];
catalog = catalog
@@ -296,7 +348,7 @@ let create catalog = ref { (** Fold over each defined value *)
let fold f a t = begin
- Raw.Map.fold (fun key content a ->
+ Raw.PageMap.fold (fun key content a ->
match content.Raw.value with
| None -> a
| Some x ->
@@ -305,6 +357,6 @@ let fold f a t = begin end
let get_cell id t = begin
- let cell = Raw.Map.find id (!t).data in
+ let cell = Raw.PageMap.find id (!t).data in
cell.expr, cell.value, cell.sink
end
diff --git a/src/tree/splay.ml b/src/tree/splay.ml index de7d441..dd1f65d 100644 --- a/src/tree/splay.ml +++ b/src/tree/splay.ml @@ -180,6 +180,11 @@ module Make (El : KEY) = struct _fold [] init !t end + let choose (T tree) = begin match (_subtree_minimum !tree) with + | Leaf -> raise Not_found + | Node (left, (key, value), right) -> C (key, value) + end + let repr formatter (T t) = begin let repr_edge from formatter dest = begin diff --git a/src/tree/splay.mli b/src/tree/splay.mli index a640075..60d067b 100755 --- a/src/tree/splay.mli +++ b/src/tree/splay.mli @@ -48,6 +48,11 @@ module Make (El : KEY) : sig val fold: ('a -> container -> 'a) -> 'a -> t -> 'a
+ (** Return one element of the given tree, or raise Not_found if the tree is
+ empty. Which element is chosen is unspecified, but equal elements will be
+ chosen for equal trees. *)
+ val choose: t -> container
+
(** Represent the content in dot syntax *)
val repr: Format.formatter -> t -> unit
|