From c20b6dd7533775eaed045950e04175b020ac52c4 Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Thu, 2 Aug 2018 19:44:49 +0200 Subject: Update expression evaluation --- src/expression.ml | 7 +-- src/expressions/collect_sources.ml | 29 ++++++------ src/expressions/evaluate.ml | 80 ++++++++++++++++++---------------- src/expressions/id_type.ml | 15 +++++++ src/expressions/shift_expr.ml | 67 ++++++++++++++++++++++++++++ src/expressions/show_expr.ml | 19 ++++---- src/expressions/sym_expr.ml | 20 ++++----- src/odf/odf.ml | 2 +- src/scTypes.ml | 37 ++++------------ src/scTypes.mli | 6 +-- src/sheet.ml | 7 +-- tests/odf/odf_ExpressionParser_test.ml | 4 +- tests/selection_test.ml | 78 +++++++++++++++++++++++++++++++++ tests/test.ml | 1 + 14 files changed, 253 insertions(+), 119 deletions(-) mode change 100755 => 100644 src/expression.ml mode change 100755 => 100644 src/expressions/collect_sources.ml mode change 100755 => 100644 src/expressions/evaluate.ml create mode 100644 src/expressions/id_type.ml create mode 100644 src/expressions/shift_expr.ml mode change 100755 => 100644 src/expressions/show_expr.ml mode change 100755 => 100644 src/expressions/sym_expr.ml mode change 100755 => 100644 src/odf/odf.ml mode change 100755 => 100644 src/scTypes.mli mode change 100755 => 100644 src/sheet.ml mode change 100755 => 100644 tests/odf/odf_ExpressionParser_test.ml create mode 100644 tests/selection_test.ml mode change 100755 => 100644 tests/test.ml diff --git a/src/expression.ml b/src/expression.ml old mode 100755 new mode 100644 index 7a38a49..c2e4ec8 --- a/src/expression.ml +++ b/src/expression.ml @@ -87,10 +87,11 @@ end module EvalSources = ScTypes.Expr.Eval(Collect_sources) let collect_sources = begin function - | Formula (Expression f) -> EvalSources.eval f () Cell.Set.empty + | Formula (Expression f) -> EvalSources.eval f Cell.Set.empty | _ -> Cell.Set.empty end +module Shifter = ScTypes.Expr.Eval(Shift_expr) module Printer = ScTypes.Expr.Eval(Show_expr.Show_Expr(Show_ref)(Show_type)) (** Inherit the default representation, but print the float with all decimals *) @@ -117,7 +118,7 @@ let show e = begin match e with | Formula (Expression f) -> UTF8.Buffer.add_char buffer '='; - Printer.eval f () buffer + Printer.eval f buffer | Basic b -> LongPrinter.eval b buffer | Formula (Error (i,s)) -> UTF8.Buffer.add_string buffer s | Undefined -> () @@ -125,7 +126,7 @@ let show e = UTF8.Buffer.contents buffer let shift vector = function - | Formula (Expression f) -> Formula (Expression (ScTypes.Expr.shift_exp vector f)) + | Formula (Expression f) -> Formula (Expression (Shifter.eval f vector)) | other -> other let (=) t1 t2 = match t1, t2 with diff --git a/src/expressions/collect_sources.ml b/src/expressions/collect_sources.ml old mode 100755 new mode 100644 index 32b40be..9698057 --- a/src/expressions/collect_sources.ml +++ b/src/expressions/collect_sources.ml @@ -29,7 +29,7 @@ module T = struct let bool b = () - let observe () x = x + let observe : unit -> 'a -> 'a = fun () x -> x end @@ -39,7 +39,8 @@ module R = struct type 'a t = 'a obs - let cell (c:Cell.t) set = Cell.Set.add (Cell.to_pair c) set + let cell : Cell.t -> Cell.Set.t -> Cell.Set.t = + fun c set -> Cell.Set.add (Cell.to_pair c) set let range c1 c2 set = begin @@ -60,27 +61,25 @@ module R = struct end -let observe f value = f value - -let value v () = T.observe v +type obs = Cell.Set.t -> Cell.Set.t -let ref r () = R.observe r +type t = obs -let call0 ident () acc = acc +let observe (f:obs) (value :Cell.Set.t) = f value -let call1 ident p1 () acc = observe p1 acc +let value v acc = T.observe v acc -let call2 ident p1 p2 () acc = observe p2 (observe p1 acc) +let ref r acc = R.observe r acc -let call3 ident p1 p2 p3 () acc = observe p3 (observe p2 (observe p1 acc)) +let call0 ident acc = acc -let callN ident params () acc = List.fold_left (fun acc p -> observe p acc) acc params +let call1 ident p1 acc = observe p1 acc -let expression e () = e +let call2 ident p1 p2 acc = observe p2 (observe p1 acc) -type obs = Cell.Set.t -> Cell.Set.t +let call3 ident p1 p2 p3 acc = observe p3 (observe p2 (observe p1 acc)) -type t = unit +let callN ident params acc = List.fold_left (fun acc p -> observe p acc) acc params -type repr = obs +let expression e acc = e acc diff --git a/src/expressions/evaluate.ml b/src/expressions/evaluate.ml old mode 100755 new mode 100644 index ff44097..fbf2a18 --- a/src/expressions/evaluate.ml +++ b/src/expressions/evaluate.ml @@ -26,12 +26,6 @@ type 'a value = type existencialResult = | Result : 'a value -> existencialResult [@@unboxed] -type t = (Functions.C.t * (int * int -> ScTypes.Result.t option)) - -type repr = existencialResult - -type obs = ScTypes.Result.t - module T:Sym_type.SYM_TYPE with type 'a obs = existencialResult = struct type 'a t = 'a value @@ -50,6 +44,12 @@ module T:Sym_type.SYM_TYPE with type 'a obs = existencialResult = struct end +type dic = (Functions.C.t * (int * int -> ScTypes.Result.t option)) + +type t = dic -> existencialResult + +type obs = dic -> ScTypes.Result.t + module R = Eval_ref (** Extract the type and the content from a value *) @@ -97,63 +97,67 @@ let ref r (_, mapper) = begin | R.Matrix (t, l) -> Result (Matrix(t, l)) end +let observe repr catalog = begin + let Result r = repr catalog in match r with + | Bool b -> ScTypes.Result.Ok (ScTypes.Type.boolean b) + | String s -> ScTypes.Result.Ok (ScTypes.Type.string s) + | Num (format, n) -> + begin match format with + (* We can only match numeric formats here *) + | ScTypes.DataFormat.Date -> ScTypes.Result.Ok (ScTypes.Type.date n) + | ScTypes.DataFormat.Number -> ScTypes.Result.Ok (ScTypes.Type.number n) + end + | _ -> raise Errors.TypeError +end + +let expression e = e + let call0 ident (catalog, _) = let name' = UTF8.to_utf8string ident in - let arg1 = (Functions.t_unit, ()) in + let (arg1:(unit Functions.C.argument * unit)) = (Functions.t_unit, ()) in wrap_call (Functions.C.eval1 catalog name' arg1) (fun () -> raise Errors.TypeError) -let call1 ident p1 (catalog, _) = +let call1 ident p1 ((catalog, _) as c) = let name' = UTF8.to_utf8string ident in - let (Result r1) = p1 in + (* Evaluate here p1 expression *) + let (Result r1) = p1 c in let arg1 = get_argument r1 in wrap_call (Functions.C.eval1 catalog name' arg1) - (fun () -> build_format_list [p1]) + (fun () -> build_format_list [Result r1]) -let call2 ident p1 p2 (catalog, _) = +let call2 ident p1 p2 ((catalog, _) as c) = let name' = UTF8.to_utf8string ident in - let (Result r1) = p1 in - let (Result r2) = p2 in + let (Result r1) = p1 c in + let (Result r2) = p2 c in let arg1 = get_argument r1 and arg2 = get_argument r2 in wrap_call (Functions.C.eval2 catalog name' arg1 arg2) - (fun () -> build_format_list [p1; p2]) + (fun () -> build_format_list [Result r1; Result r2]) -let call3 ident p1 p2 p3 (catalog, _) = +let call3 ident p1 p2 p3 ((catalog, _) as c) = let name' = UTF8.to_utf8string ident in - let (Result r1) = p1 in - let (Result r2) = p2 in - let (Result r3) = p3 in + let (Result r1) = p1 c in + let (Result r2) = p2 c in + let (Result r3) = p3 c in let arg1 = get_argument r1 and arg2 = get_argument r2 and arg3 = get_argument r3 in wrap_call (Functions.C.eval3 catalog name' arg1 arg2 arg3) - (fun () -> build_format_list [p1; p2 ; p3]) + (fun () -> build_format_list [Result r1; Result r2; Result r3]) -let callN ident params (catalog, _) = - let signature = List.map (fun (Result r) -> +let callN ident params ((catalog, _) as c) = + + let map_params expression = begin + let (Result r) = expression c in let formatter = Format.str_formatter in Functions.repr formatter (fst @@ get_argument r); - Format.flush_str_formatter ()) params in + Format.flush_str_formatter () + end in + let signature = List.map map_params params in raise (Errors.Undefined (ident, signature)) -let expression e _ = e - -let observe repr = begin - let Result r = repr in match r with - | Bool b -> ScTypes.Result.Ok (ScTypes.Type.boolean b) - | String s -> ScTypes.Result.Ok (ScTypes.Type.string s) - | Num (format, n) -> - begin match format with - (* We can only match numeric formats here *) - | ScTypes.DataFormat.Date -> ScTypes.Result.Ok (ScTypes.Type.date n) - | ScTypes.DataFormat.Number -> ScTypes.Result.Ok (ScTypes.Type.number n) - end - | _ -> raise Errors.TypeError - -end - diff --git a/src/expressions/id_type.ml b/src/expressions/id_type.ml new file mode 100644 index 0000000..d84ddfa --- /dev/null +++ b/src/expressions/id_type.ml @@ -0,0 +1,15 @@ +type 'a t = 'a ScTypes.Type.t + +type 'a obs = 'a ScTypes.Type.t + +let str s = ScTypes.Type.string s + +let num n = ScTypes.Type.number n + +let date d = ScTypes.Type.date d + +let bool b = ScTypes.Type.boolean b + +let observe x = x + + diff --git a/src/expressions/shift_expr.ml b/src/expressions/shift_expr.ml new file mode 100644 index 0000000..17cce95 --- /dev/null +++ b/src/expressions/shift_expr.ml @@ -0,0 +1,67 @@ +(* +This file is part of licht. + +licht is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or +(at your option) any later version. + +licht is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with licht. If not, see . +*) + +module Shift_Ref = struct + + type 'a t = (int * int) -> ScTypes.Refs.t + type 'a obs = (int * int) -> ScTypes.Refs.t + + let _shift (vector_x, vector_y) ((x, y), (fixed_x, fixed_y)) = + let x' = if fixed_x then x else x + vector_x + and y' = if fixed_y then y else y + vector_y in + (x', y'), (fixed_x, fixed_y) + + let cell t shift = + ScTypes.Refs.cell (_shift shift t) + + + let range c1 c2 shift = + ScTypes.Refs.range (_shift shift c1) (_shift shift c2) + + let observe elem shift = elem shift + +end + +module Shift_Expr = struct + + type t = (int * int) -> ScTypes.Expr.t + type obs = (int * int) -> ScTypes.Expr.t + + module R = Shift_Ref + module T = Id_type + + let observe f x = f x + + let value t vector = ScTypes.Expr.value (T.observe t) + + let ref r vector = ScTypes.Expr.ref (R.observe r vector) + + let call0 ident vector = ScTypes.Expr.call0 ident + + let call1 ident p1 vector = ScTypes.Expr.call1 ident (observe p1 vector) + + let call2 ident p1 p2 vector = ScTypes.Expr.call2 ident (observe p1 vector) (observe p2 vector) + + let call3 ident p1 p2 p3 vector = ScTypes.Expr.call3 ident (observe p1 vector) (observe p2 vector) (observe p3 vector) + + let expression e vector = ScTypes.Expr.expression (observe e vector) + + let callN ident (params: t list) vector = ScTypes.Expr.callN ident (List.map (fun x -> observe x vector) params) + +end + +include Shift_Expr diff --git a/src/expressions/show_expr.ml b/src/expressions/show_expr.ml old mode 100755 new mode 100644 index c283162..a191d2d --- a/src/expressions/show_expr.ml +++ b/src/expressions/show_expr.ml @@ -24,27 +24,26 @@ module Show_Expr module T = T module R = R - type t = unit - type repr = UTF8.Buffer.buffer -> unit + type t = UTF8.Buffer.buffer -> unit type obs = UTF8.Buffer.buffer -> unit let observe buffer value = buffer value - let value v () buffer = T.observe v buffer + let value v buffer = T.observe v buffer - let ref r () buffer = R.observe r buffer + let ref r buffer = R.observe r buffer - let call0 ident () buffer = + let call0 ident buffer = let utf8ident = UTF8.to_utf8string ident in UTF8.Printf.bprintf buffer "%s()" utf8ident - let call1 ident p1 () buffer = + let call1 ident p1 buffer = let utf8ident = UTF8.to_utf8string ident in UTF8.Printf.bprintf buffer "%s(%a)" utf8ident (fun x b -> observe b x) p1 - let call2 ident p1 p2 () buffer = + let call2 ident p1 p2 buffer = let utf8ident = UTF8.to_utf8string ident in begin match utf8ident with | "+" | "*" | "-" | "/" | "^" | "=" @@ -60,7 +59,7 @@ module Show_Expr (fun x b -> observe b x) p2 end - let call3 ident p1 p2 p3 () buffer = + let call3 ident p1 p2 p3 buffer = let utf8ident = UTF8.to_utf8string ident in UTF8.Printf.bprintf buffer "%s(%a;%a;%a)" utf8ident @@ -68,11 +67,11 @@ module Show_Expr (fun x b -> observe b x) p2 (fun x b -> observe b x) p3 - let callN ident (params: repr list) () buffer = + let callN ident (params: t list) buffer = UTF8.Buffer.add_string buffer ident; Tools.List.printb ~sep:(u";") (fun buffer value -> value buffer) buffer params - let expression e () buffer = + let expression e buffer = UTF8.Printf.bprintf buffer "(%a)" (fun x b -> b x) e diff --git a/src/expressions/sym_expr.ml b/src/expressions/sym_expr.ml old mode 100755 new mode 100644 index 4f5d6a6..843b8a4 --- a/src/expressions/sym_expr.ml +++ b/src/expressions/sym_expr.ml @@ -23,26 +23,24 @@ module type SYM_EXPR = sig type t - type repr - type obs - val value : 'a T.t -> t -> repr + val value : 'a T.t -> t - val ref : 'a R.t -> t -> repr + val ref : 'a R.t -> t - val call0 : UTF8.t -> t -> repr + val call0 : UTF8.t -> t - val call1 : UTF8.t -> repr -> t -> repr + val call1 : UTF8.t -> t -> t - val call2 : UTF8.t -> repr -> repr -> t -> repr + val call2 : UTF8.t -> t -> t -> t - val call3 : UTF8.t -> repr -> repr -> repr -> t -> repr + val call3 : UTF8.t -> t -> t -> t -> t - val callN: UTF8.t -> repr list -> t -> repr + val callN: UTF8.t -> t list -> t - val expression : repr -> t -> repr + val expression : t -> t - val observe : repr -> obs + val observe : t -> obs end diff --git a/src/odf/odf.ml b/src/odf/odf.ml old mode 100755 new mode 100644 index 68add32..0091d8b --- a/src/odf/odf.ml +++ b/src/odf/odf.ml @@ -145,7 +145,7 @@ let write_cell output value = begin function | Expression.Basic b -> write_basic [] output b | Expression.Formula (Expression.Expression f) -> let buffer = UTF8.Buffer.create 10 in - ExpressionPrinter.eval f () buffer; + ExpressionPrinter.eval f buffer; let formula = UTF8.Buffer.contents buffer |> UTF8.to_utf8string in write_formula output [(NS.formula_attr, ("of:=" ^formula))] f value diff --git a/src/scTypes.ml b/src/scTypes.ml index e85b2f1..f0a42d4 100644 --- a/src/scTypes.ml +++ b/src/scTypes.ml @@ -105,15 +105,6 @@ module Refs = struct | Cell of Cell.t (** A cell *) | Range of Cell.t * Cell.t (** An area of cells *) - let shift (vector_x, vector_y) ref = - let _shift ((x, y), (fixed_x, fixed_y)) = - let x' = if fixed_x then x else x + vector_x - and y' = if fixed_y then y else y + vector_y in - (x', y'), (fixed_x, fixed_y) - in match ref with - | Cell x -> Cell (_shift x) - | Range (fst, snd) -> Range (_shift fst, _shift snd) - let cell c = Cell c let range c1 c2 = Range (c1, c2) @@ -152,44 +143,34 @@ module Expr = struct let callN ident params = CallN(ident, params) let expression e = Expression e - let rec shift_exp vector = function - | Value v -> Value v - | Call0 ident -> Call0 ident - | Call1 (ident, p1) -> Call1 (ident, shift_exp vector p1) - | Call2 (ident, p1, p2) -> Call2 (ident, shift_exp vector p1, shift_exp vector p2) - | Call3 (ident, p1, p2, p3) -> Call3 (ident, shift_exp vector p1, shift_exp vector p2, shift_exp vector p3) - | CallN (ident, params) -> CallN (ident, List.map (shift_exp vector) params) - | Ref r -> Ref (Refs.shift vector r) - | Expression expr -> Expression (shift_exp vector expr) - module Eval(E:Sym_expr.SYM_EXPR) = struct module T = Type.Eval(E.T) module R = Refs.Eval(E.R) - let eval e t = begin + let eval e = begin let rec _eval v k = begin match v with - | Ref r -> k @@ E.ref (R.eval_ref r) t - | Value v -> k @@ E.value (T.eval_type v) t - | Call0 ident -> k @@ E.call0 ident t + | Ref r -> k @@ E.ref (R.eval_ref r) + | Value v -> k @@ E.value (T.eval_type v) + | Call0 ident -> k @@ E.call0 ident | Call1 (ident, p1) -> _eval p1 (fun v1 -> - k @@ E.call1 ident v1 t) + k @@ E.call1 ident v1) | Call2 (ident, p1, p2) -> _eval p1 (fun v1 -> _eval p2 (fun v2 -> - k @@ E.call2 ident v1 v2 t)) + k @@ E.call2 ident v1 v2)) | Call3 (ident, p1, p2, p3) -> (_eval[@tailcall]) p1 (fun v1 -> (_eval[@tailcall]) p2 (fun v2 -> (_eval[@tailcall]) p3 (fun v3 -> - k @@ E.call3 ident v1 v2 v3 t))) + k @@ E.call3 ident v1 v2 v3))) | CallN (ident, exprs) -> let mapped = List.map (fun x -> _eval x (fun x -> x)) exprs in - k @@ E.callN ident mapped t + k @@ E.callN ident mapped | Expression e -> - (_eval[@tailcall]) e (fun v1 -> k @@ E.expression v1 t) + (_eval[@tailcall]) e (fun v1 -> k @@ E.expression v1) end in E.observe (_eval e (fun x -> x)) diff --git a/src/scTypes.mli b/src/scTypes.mli old mode 100755 new mode 100644 index 04d38eb..326a31c --- a/src/scTypes.mli +++ b/src/scTypes.mli @@ -63,8 +63,6 @@ module Refs : sig val range : Cell.t -> Cell.t -> t - val shift: (int * int) -> t -> t - (** Evaluate a reference and get the result *) module Eval(R:Sym_ref.SYM_REF): sig @@ -105,11 +103,9 @@ module Expr : sig (** An expression *) val expression : t -> t - val shift_exp: (int * int) -> t -> t - module Eval(E:Sym_expr.SYM_EXPR): sig - val eval: t -> E.t -> E.obs + val eval: t -> E.obs end diff --git a/src/sheet.ml b/src/sheet.ml old mode 100755 new mode 100644 index 4984bde..151965e --- a/src/sheet.ml +++ b/src/sheet.ml @@ -240,12 +240,7 @@ module Raw = struct 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 catalog (fun id -> (PageMap.find id t).value)) - } in - add_element catalog id f t + add id expr catalog t end let get_sink id t = diff --git a/tests/odf/odf_ExpressionParser_test.ml b/tests/odf/odf_ExpressionParser_test.ml old mode 100755 new mode 100644 index 40dcbcd..d129e7b --- a/tests/odf/odf_ExpressionParser_test.ml +++ b/tests/odf/odf_ExpressionParser_test.ml @@ -24,8 +24,8 @@ module Show = ScTypes.Expr.Eval(Show_expr.Show_Expr(Show_ref)(Show_type)) let _msg ~(expected:ScTypes.Expr.t) ~(result:ScTypes.Expr.t) = let b1 = UTF8.Buffer.create 16 and b2 = UTF8.Buffer.create 16 in - Show.eval expected () b1; - Show.eval result () b2; + Show.eval expected b1; + Show.eval result b2; Printf.sprintf "Expected \n\t%s but got \n\t%s" (UTF8.raw_encode @@ UTF8.Buffer.contents b1) diff --git a/tests/selection_test.ml b/tests/selection_test.ml new file mode 100644 index 0000000..940abd7 --- /dev/null +++ b/tests/selection_test.ml @@ -0,0 +1,78 @@ +(* +This file is part of licht. + +licht is free software: you can redistribute it and/or modify +it under the terms of the GNU General Public License as published by +the Free Software Foundation, either version 3 of the License, or +(at your option) any later version. + +licht is distributed in the hope that it will be useful, +but WITHOUT ANY WARRANTY; without even the implied warranty of +MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +GNU General Public License for more details. + +You should have received a copy of the GNU General Public License +along with licht. If not, see . +*) + +open OUnit2 +module S = Selection + +(* Test if a single cell is selected with an axe *) +let test_selected_single axe1 axe2 env = begin + + let selection = Selection.create (10, 10) in + + assert_equal + true + (Selection.is_selected axe1 selection); + + assert_equal + false + (Selection.is_selected axe2 selection); +end + +let test_selected_multiple axe1 axe2 env = begin + + let selection = Selection.extends + (Actions.Left 1) + (Selection.create (10, 10)) in + + assert_equal + true + (Selection.is_selected axe1 selection); + + assert_equal + false + (Selection.is_selected axe2 selection); +end + +let test_extract_single env = begin + + let selection = Selection.create (10, 10) in + + assert_equal + (10, 10) + (Selection.extract selection); +end +let test_extract_multiple env = begin + + let selection = Selection.extends + (Actions.Left 1) + (Selection.create (10, 10)) in + + assert_equal + (9, 10) + (Selection.extract selection); +end + +let tests = "selection_test">::: [ + "test_selected1" >:: test_selected_single (S.Horizontal 10) (S.Horizontal 11); + "test_selected2" >:: test_selected_single (S.Vertical 10) (S.Vertical 11); + "test_selected3" >:: test_selected_single (S.Cell (10, 10)) (S.Cell (11, 11)); + "test_selected4" >:: test_selected_multiple (S.Horizontal 10) (S.Horizontal 11); + "test_selected5" >:: test_selected_multiple (S.Vertical 10) (S.Vertical 11); + "test_selected6" >:: test_selected_multiple (S.Cell (10, 10)) (S.Cell (11, 11)); + "test_extract1 " >:: test_extract_single; + "test_extract2 " >:: test_extract_multiple; +] diff --git a/tests/test.ml b/tests/test.ml old mode 100755 new mode 100644 index a69c4a3..e0b006d --- a/tests/test.ml +++ b/tests/test.ml @@ -26,6 +26,7 @@ let () = Expression_test.tests; Sheet_test.tests; Odf_ExpressionParser_test.tests; + Selection_test.tests; Splay_test.tests; ] in OUnit2.run_test_tt_main tests -- cgit v1.2.3