diff options
Diffstat (limited to 'src/sheet.ml')
| -rwxr-xr-x | src/sheet.ml | 334 |
1 files changed, 334 insertions, 0 deletions
diff --git a/src/sheet.ml b/src/sheet.ml new file mode 100755 index 0000000..67b1ee1 --- /dev/null +++ b/src/sheet.ml @@ -0,0 +1,334 @@ +module Option = Tools.Option
+
+type cell = int * int
+
+type search = [
+ | `Pattern of ScTypes.result option
+ | `Next
+ | `Previous
+]
+
+module Raw = struct
+
+ module Map = Map.Make(struct
+ type t = cell
+ let compare (x1, y1) (x2, y2) = Pervasives.compare (y1, x1) (y2, x2)
+ end)
+
+ type content = {
+ expr : Expression.t; (** The expression *)
+ value : ScTypes.result option; (** The content evaluated *)
+ sink : Cell.Set.t; (** All the cell which references this one *)
+ }
+
+ (** 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.
+ *)
+ and t = content Map.t
+
+ (** An empty cell which does contains nothing *)
+ let empty_cell = {
+ expr = Expression.Undefined;
+ value = None;
+ sink = Cell.Set.empty;
+ }
+
+ let empty = Map.empty
+
+ let get_value id t = begin
+ try (Map.find id t).value
+ with Not_found -> None
+ end
+
+ let get_expr id t = begin
+ try (Map.find id t).expr
+ with Not_found -> empty_cell.expr
+ end
+
+ (** 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
+ 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)
+ | 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)
+ else
+ (* If there is no changes, do not update the map *)
+ 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 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 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))
+ )
+ ) 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 parents') content.sink (succ', t')
+ end
+ )
+ end in
+ try Cell.Set.fold (successors init) source.sink (init, t)
+ with Cycle (succ, t) -> (succ, t)
+ end
+
+ (** Remove the cell from the sheet *)
+ let remove_element (id:cell) t : t * content option = begin
+
+ (** Remove the references from each sources.
+ 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
+
+ (* 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 )
+ else
+ Map.add cell {c with sink = sink'} t
+ with Not_found -> t
+ end in
+
+ begin try
+ let c = Map.find id t in
+ let t' =
+ (** Remove the references from each sources *)
+ let sources = Expression.collect_sources c.expr in
+ Cell.Set.fold remove_ref sources t in
+
+ (** If there is no references on the cell, remove it *)
+ if Cell.Set.is_empty c.sink then (
+ Map.remove id t', None)
+ else (
+ let c = { empty_cell with sink = c.sink } in
+ Map.add id c t', (Some c)
+ )
+ with Not_found -> t, None
+ end
+ end
+
+ let remove id 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)
+ end
+
+ let add_element id f t = begin
+
+ (** Add the references in each sources.
+ If the sources does not exists, create it.
+ *)
+ let add_ref cell t = begin
+ let c =
+ try Map.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
+ end in
+
+ let t', cell = remove_element id t in
+ let cell' = match cell with
+ | None -> empty_cell
+ | Some x -> x in
+
+ let content = f cell' t' in
+
+ let sources = Expression.collect_sources content.expr in
+ let updated = Map.add id content t'
+ |> Cell.Set.fold add_ref sources
+ in
+
+ (** Update the value for each sink already evaluated *)
+ traverse update content (Cell.Set.singleton id, updated)
+ end
+
+ let add id expression t = begin
+ if not (Expression.is_defined expression) then
+ (Cell.Set.empty, t)
+ else
+ let f cell t = { cell with
+ expr = expression ;
+ value = Some (Expression.eval expression (get_ref id t))
+ } in
+ add_element id f t
+ end
+
+ let paste 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))
+ } in
+ add_element id f t
+ end
+
+ 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
+ Map.iter _search t;
+ None
+ with Found key -> Some key
+ end
+
+ let get_sink id t =
+ try (Map.find id t).sink
+ with Not_found -> Cell.Set.empty
+
+ (** Fold over each defined value *)
+ let fold f a t = begin
+ Map.fold (fun key content a ->
+ match content.value with
+ | None -> a
+ | Some x ->
+ f a key (content.expr, x)
+ ) t a
+ end
+
+end
+
+type yank = cell * Raw.content
+
+type t = {
+ selected: Selection.t; (* The selected cell *)
+ data: Raw.t;
+ history: t list; (* Unlimited history *)
+ yank: (cell * Raw.content) list
+}
+
+let undo t = begin match t.history with
+ | [] -> None
+ | hd::tl -> Some { hd with selected = t.selected }
+end
+
+let move direction t =
+ let position = Selection.extract t.selected in
+ let position' = begin match direction with
+ | Actions.Left quant -> Tools.Tuple2.replace1 (max 1 ((fst position) - quant)) position
+ | Actions.Right quant -> Tools.Tuple2.replace1 ((fst position) + quant) position
+ | Actions.Up quant -> Tools.Tuple2.replace2 (max 1 ((snd position) - quant)) position
+ | Actions.Down quant -> Tools.Tuple2.replace2 ((snd position) + quant) position
+ | Actions.Absolute (x, y)-> (x, y)
+ end in
+ if position = position' then
+ None
+ else
+ Some {t with selected = Selection.create position'}
+
+let delete t = begin
+ let count, data' = Selection.fold (fun (count, c) t ->
+ (count + 1, snd @@ Raw.remove t c)) (0, t.data) t.selected in
+ let t' = { t with
+ data = data';
+ history = t::t.history
+ } in
+ t', count
+end
+
+let yank t = begin
+
+ let shift = Selection.shift t.selected in
+ let origin = shift (0, 0) in
+ let _yank (count, extracted) cell = begin
+ let content =
+ try let content = (Raw.Map.find cell t.data) in
+ { content with Raw.expr = Expression.shift origin content.Raw.expr }
+ with Not_found -> Raw.empty_cell in
+
+ count + 1, (shift cell,content)::extracted
+ end in
+
+ let count, yanked = Selection.fold _yank (0, []) t.selected in
+ let t' = { t with yank = List.rev yanked; } in
+ t', count
+end
+
+let paste t = begin
+ (* Origin of first cell *)
+ let (shift_x, shift_y) as shift = Selection.extract t.selected in
+
+ let _paste (count, t) ((x, y), content) = begin
+ count + 1, snd @@ Raw.paste (shift_x + x, shift_y + y) shift content t
+ end in
+
+ let count, data' = List.fold_left _paste (0, t.data) t.yank in
+ let t' = { t with data = data'; history = t::t.history } in
+ t', count
+end
+
+let add expression t = begin
+ let id = Selection.extract t.selected in
+ let cells, data' = Raw.add id expression t.data in
+ cells, { t with data = data'; history = t::t.history}
+end
+
+let search action t = begin match action with
+ | `Pattern pattern ->
+ begin match Raw.search pattern t.data with
+ | None -> None
+ | Some x -> Some {t with selected = Selection.create x}
+ end
+ | _ -> None
+end
+
+let create data = {
+ data = data;
+ selected = Selection.create (1, 1);
+ history = [];
+ yank = [];
+}
|