module Option = Tools.Option type cell = int * int type search = [ | `Pattern of ScTypes.result option | `Next | `Previous ] module Raw = struct exception Cycle 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.load @@ UTF8.empty; value = None; sink = Cell.Set.empty; } let create = 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.types option ScTypes.Refs.range = begin let extract_values = begin function | ScTypes.Result v -> v | ScTypes.Error e -> raise e end in ScTypes.Refs.collect ref |> ScTypes.Refs.map (fun coord -> Option.map extract_values (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 both 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 [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) ) end in Cell.Set.fold fold init.sink state 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 *) successors 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 *) successors 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 exception Found of (int * int) let search pattern t = begin 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 = []; }