From a6b5a6bdd138a5ccc6827bcc73580df1e9218820 Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Fri, 24 Nov 2017 09:22:24 +0100 Subject: Moved all the code to src directory --- sheet.ml | 334 --------------------------------------------------------------- 1 file changed, 334 deletions(-) delete mode 100755 sheet.ml (limited to 'sheet.ml') 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 = []; -} -- cgit v1.2.3