diff options
Diffstat (limited to 'src/sheet.ml')
| -rwxr-xr-x | src/sheet.ml | 129 |
1 files changed, 60 insertions, 69 deletions
diff --git a/src/sheet.ml b/src/sheet.ml index 3dc83a0..6d3c34a 100755 --- a/src/sheet.ml +++ b/src/sheet.ml @@ -1,9 +1,7 @@ -module Option = Tools.Option
-
type cell = int * int
type search = [
- | `Pattern of ScTypes.result option
+ | `Pattern of ScTypes.Result.t option
| `Next
| `Previous
]
@@ -12,7 +10,7 @@ module Raw = struct type content = {
expr : Expression.t; (** The expression *)
- value : ScTypes.result option; (** The content evaluated *)
+ value : ScTypes.Result.t option; (** The content evaluated *)
sink : Cell.Set.t; (** All the cell which references this one *)
}
@@ -29,7 +27,6 @@ module Raw = struct type t = Map.t
-
(** The sheet is a map which always contains evaluated values. When a cell is
updated, all the cell which references this value are also updated.
*)
@@ -39,22 +36,12 @@ module Raw = struct let get_expr id t = (Map.find id t).expr
- (** Extract a value from a reference.
- This function is given to the evaluator for getting the values from a reference.
- *)
- let get_ref from t ref : ScTypes.result option ScTypes.Refs.range = begin
-
- ScTypes.Refs.collect ref
- |> ScTypes.Refs.map (fun coord -> get_value coord t)
-
- end
-
(** 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
*)
- let update cell content t = begin
- let new_val = Expression.eval content.expr (get_ref cell t) in
+ let update catalog cell content t = begin
+ let new_val = Expression.eval content.expr catalog (fun id -> get_value id t) in
match content.value with
| None ->
(* If the previous value wasn't defined, update the map *)
@@ -68,54 +55,54 @@ module Raw = struct None
end
+ exception Cycle of Cell.Set.t * t
+
(** Parse all the successors from an element, apply a function to each of
them, and return them.
The function is too long and should be rewriten… *)
let rec traverse (f:(cell -> content -> t -> t option)) source (init, t) = begin
+ try Cell.Set.fold (successors init f init source) source.sink (init, t)
+ with Cycle (succ, t) -> (succ, t)
+ end
- let exception Cycle of Cell.Set.t * t in
-
- let rec successors parents element (succ, t) = begin
+ and successors init f parents source element (succ, t) = begin
- let content = Map.find element t in
+ let content = Map.find element t in
- if Cell.Set.mem element parents then (
+ 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 the cell has already been visited, mark it in error, and all the
+ descendant *)
+ let cycle_error = Some (ScTypes.Result.Error Errors.Cycle) in
- 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) in
- let succ, t = traverse set_error source (init, t) in
- raise (Cycle (succ, t))
- )
+ if content.value = cycle_error then (
+ (* The content has already been updated, do not process it again *)
+ (succ, t)
) else (
- begin match f element content t with
- | None ->
- (* The content does not change, we do not update the successors *)
- (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
- (succ', t')
+ 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
- Cell.Set.fold (successors parents') content.sink (succ', t')
- end
+ 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))
)
- end in
- try Cell.Set.fold (successors init) source.sink (init, t)
- with Cycle (succ, t) -> (succ, t)
+ ) else (
+ begin match f element content t with
+ | None ->
+ (* The content does not change, we do not update the successors *)
+ (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
+ (succ', t')
+ else
+ Cell.Set.fold (successors init f parents' source) content.sink (succ', t')
+ end
+ )
end
(** Remove the cell from the sheet *)
@@ -156,15 +143,15 @@ module Raw = struct end
end
- let remove id t = begin
+ let remove id catalog t = begin
match remove_element id t with
| t, None -> Cell.Set.empty, t
| t, Some content ->
(** Update all the successors *)
- traverse update content (Cell.Set.singleton id, t)
+ traverse (update catalog) content (Cell.Set.singleton id, t)
end
- let add_element id content_builder t = begin
+ let add_element catalog id content_builder t = begin
(** Add the references in each sources.
If the sources does not exists, create it.
@@ -191,29 +178,29 @@ module Raw = struct in
(** Update the value for each sink already evaluated *)
- traverse update content (Cell.Set.singleton id, updated)
+ traverse (update catalog) content (Cell.Set.singleton id, updated)
end
- let add id expression t = begin
+ let add id expression catalog t = begin
if not (Expression.is_defined expression) then
(Cell.Set.empty, t)
else
let f cell t = begin
{ cell with
expr = expression ;
- value = Some (Expression.eval expression (get_ref id t)) }
+ value = Some (Expression.eval expression catalog (fun id -> get_value id t)) }
end in
- add_element id f t
+ add_element catalog id f t
end
- let paste id shift content t = begin
+ let paste catalog id shift content t = begin
let expr = Expression.shift shift content.expr in
let f cell t =
{ cell with
expr = expr ;
- value = Some (Expression.eval expr (get_ref id t))
+ value = Some (Expression.eval expr catalog (fun id -> get_value id t))
} in
- add_element id f t
+ add_element catalog id f t
end
let search pattern t = begin
@@ -252,7 +239,8 @@ type t = { selected: Selection.t; (* The selected cell *)
data: Raw.t;
history: history; (* Unlimited history *)
- yank: yank list
+ yank: yank list;
+ catalog: Functions.C.t;
}
let undo t = begin
@@ -262,9 +250,9 @@ let undo t = begin let data = List.fold_left (
fun data (id, expression) ->
if Expression.is_defined expression then
- snd @@ Raw.add id expression data
+ snd @@ Raw.add id expression t.catalog data
else
- snd @@ Raw.remove id data
+ snd @@ Raw.remove id t.catalog data
) t.data hd in
Some { t with data = data; history = tl}
end
@@ -284,9 +272,10 @@ let move direction t = Some {t with selected = Selection.create position'}
let delete t = begin
+ let catalog = t.catalog in
let history = Selection.fold (fun acc id -> (id, Raw.get_expr id t.data)::acc) [] t.selected in
let count, data' = Selection.fold (fun (count, c) t ->
- (count + 1, snd @@ Raw.remove t c)) (0, t.data) t.selected in
+ (count + 1, snd @@ Raw.remove t catalog c)) (0, t.data) t.selected in
let t' = { t with
data = data';
history = history::t.history
@@ -313,6 +302,7 @@ let yank t = begin end
let paste t = begin
+ let catalog = t.catalog in
(* Origin of first cell *)
let (shift_x, shift_y) as shift = Selection.extract t.selected in
@@ -321,7 +311,7 @@ let paste t = begin id, Raw.get_expr id t.data) t.yank in
let _paste (count, t) ((x, y), content) = begin
- count + 1, snd @@ Raw.paste (shift_x + x, shift_y + y) shift content t
+ count + 1, snd @@ Raw.paste catalog (shift_x + x, shift_y + y) shift content t
end in
let count, data' = List.fold_left _paste (0, t.data) t.yank in
@@ -332,7 +322,7 @@ end let add expression t = begin
let id = Selection.extract t.selected in
let prev_expression = Raw.get_expr id t.data in
- let cells, data' = Raw.add id expression t.data in
+ let cells, data' = Raw.add id expression t.catalog t.data in
cells, { t with data = data'; history = [id, prev_expression]::t.history }
end
@@ -345,9 +335,10 @@ let search action t = begin match action with | _ -> None
end
-let create data = {
+let create catalog data = {
data = data;
selected = Selection.create (1, 1);
history = [];
yank = [];
+ catalog = catalog
}
|