diff options
Diffstat (limited to 'sheet.ml')
| -rwxr-xr-x | sheet.ml | 334 |
1 files changed, 0 insertions, 334 deletions
diff --git a/sheet.ml b/sheet.ml deleted file mode 100755 index 67b1ee1..0000000 --- a/sheet.ml +++ /dev/null @@ -1,334 +0,0 @@ -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 = [];
-}
|