From 0d1f9ff76aa6df3f17edd2d73c76ab444fec8528 Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Mon, 2 Jan 2017 17:56:04 +0100 Subject: Corrected some issues with odf documents --- evaluator.ml | 74 +++++++++++++++++++++++++++++++++--------------------------- 1 file changed, 41 insertions(+), 33 deletions(-) (limited to 'evaluator.ml') diff --git a/evaluator.ml b/evaluator.ml index 3adf7fa..490ab43 100755 --- a/evaluator.ml +++ b/evaluator.ml @@ -1,8 +1,6 @@ module D = DataType module T = Tools -let u = UTF8.from_utf8string - exception RegisteredFunction (** Data format *) @@ -392,32 +390,25 @@ let repr mapper value = begin | ScTypes.Bool b -> Result (Bool b) | ScTypes.Date d -> Result (Num (Date, (D.Num.of_num d))) | ScTypes.Str s -> Result (String s) - | ScTypes.Undefined -> raise Errors.TypeError end in - (** Extract the value from a raw type. - If the value is Undefined, provide a default result. - *) - let guess_value: type a. a typ -> ScTypes.types -> existencialResult = fun typ value -> begin - try extract_value value with Errors.TypeError -> - match typ with + let add_elem: type a. a typ -> a list * a dataFormat -> ScTypes.types option -> a list * a dataFormat = + begin fun type_of (result, format_of) next -> + let Result r = match next with + | Some x -> extract_value x + | None -> begin match type_of with | Num -> Result (Num (Number, (D.Num.nan))) | Bool -> Result (Bool false) - | String -> Result (String (u"")) + | String -> Result (String (UTF8.empty)) | List x -> Result (List ((default_format_for_type x), [])) | Unit -> raise Errors.TypeError - end in - - - let add_elem: type a. a typ -> a list * a dataFormat -> ScTypes.types -> a list * a dataFormat = - begin fun type_of (result, format_of) next -> - let Result r = guess_value type_of next in - begin match compare_typ type_of (type_of_value r) with - | T.Eq -> - let l' = (get_value_content r)::result in - l' , (most_generic_format (format_of_value r) format_of) - | _ -> raise Errors.TypeError - end + end in + begin match compare_typ type_of (type_of_value r) with + | T.Eq -> + let l' = (get_value_content r)::result in + l' , (most_generic_format (format_of_value r) format_of) + | _ -> raise Errors.TypeError + end end in (* Return the result for any expression as an ScTypes.types result *) @@ -449,11 +440,14 @@ let repr mapper value = begin (* For a reference to an external we first extract the value pointed *) | ScTypes.Ref r -> begin match mapper r with - | ScTypes.Refs.Single v -> extract_value v + | ScTypes.Refs.Single v -> + begin match v with + | None -> raise Errors.TypeError + | Some v -> extract_value v + end | ScTypes.Refs.Array1 l -> - (* Guess the list type from it's first defined element *) - let Result r = extract_value (List.find ((!=) ScTypes.Undefined) l) in + let Result r = extract_value (Tools.List.find_map (fun x -> x) l) in let format_of = format_of_value r in let type_of = type_of_value r in (* Build the list with all the elements *) @@ -461,7 +455,8 @@ let repr mapper value = begin Result (List (format, elems)) | ScTypes.Refs.Array2 l -> (* Guess the list type from it's first defined element *) - let Result r = extract_value (Tools.List.find2 ((!=) ScTypes.Undefined) l) in + let Result r = extract_value (Tools.List.find_map2 (fun x -> x) l) in + let format_of = format_of_value r in let type_of = type_of_value r in (* Build the list with all the elements *) @@ -526,14 +521,17 @@ let () = begin let module CompareNum = MAKE(D.Num) in CompareNum.register t_int; - register0 "rand" f_number D.Num.rnd; - register2 "+" (t_int, t_int) f_num D.Num.add; - register2 "-" (t_int, t_int) f_num D.Num.sub; - register2 "*" (t_int, t_int) f_number D.Num.mult; - register2 "/" (t_int, t_int) f_number D.Num.div; - register2 "^" (t_int, t_int) f_number D.Num.pow; + register0 "rand" f_number D.Num.rnd; - register1 "abs" t_int f_number D.Num.abs; + register1 "+" t_int f_num (fun x -> x); + register1 "-" t_int f_num D.Num.neg; (* Unary negation *) + register2 "+" (t_int, t_int) f_num D.Num.add; + register2 "-" (t_int, t_int) f_num D.Num.sub; + register2 "*" (t_int, t_int) f_number D.Num.mult; + register2 "/" (t_int, t_int) f_number D.Num.div; + register2 "^" (t_int, t_int) f_number D.Num.pow; + + register1 "abs" t_int f_number D.Num.abs; fold "sum" t_int f_number D.Num.add (D.Num.of_num (Num.num_of_int 0)); fold "product" t_int f_number D.Num.mult (D.Num.of_num (Num.num_of_int 1)); @@ -553,4 +551,14 @@ let () = begin let module CompareString = MAKE(D.String) in CompareString.register t_string; + (* Build a date *) + register3 "date" (t_int, t_int, t_int) f_date ( + fun year month day -> + Tools.Date.get_julian_day + (Num.int_of_num @@ Num.floor_num @@ D.Num.to_num year) + (Num.int_of_num @@ Num.floor_num @@ D.Num.to_num month) + (Num.int_of_num @@ Num.floor_num @@ D.Num.to_num day) + |> D.Num.of_num + ) + end -- cgit v1.2.3