From 6f6ff0e39eb6d771ef5336394079646ccdc18bd5 Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Tue, 7 Nov 2017 15:44:40 +0100 Subject: Use Zarith instead of Num for computing numbers --- Makefile | 4 +- cell.ml | 2 +- cell.mli | 2 +- dataType.ml | 127 ++++++--------------- dataType.mli | 34 +++++- date.ml | 199 ++++++++++++++++++--------------- date.mli | 38 +++++++ evaluator.ml | 35 ++++-- expressionLexer.mll | 4 +- expressionParser.mly | 47 ++++---- odf/odf.ml | 19 ++-- odf/odf_ExpressionLexer.mll | 18 +-- odf/odf_ExpressionParser.mly | 16 ++- scTypes.ml | 21 ++-- tests/dataType_test.ml | 33 ++---- tests/expressionParser_test.ml | 6 +- tests/expression_test.ml | 18 +-- tests/odf/odf_ExpressionParser_test.ml | 2 +- tests/sheet_test.ml | 4 +- tests/tools_test.ml | 117 +++++++++---------- tools.ml | 46 -------- 21 files changed, 384 insertions(+), 408 deletions(-) create mode 100755 date.mli diff --git a/Makefile b/Makefile index 5dbb9a0..cdda759 100755 --- a/Makefile +++ b/Makefile @@ -1,5 +1,5 @@ OCAMLBUILD ?= ocamlbuild -PACKAGES=dynlink,num,curses,camlzip,ezxmlm,text,str,menhirLib +PACKAGES=dynlink,curses,camlzip,ezxmlm,text,str,menhirLib,zarith PATHS=.,odf MENHIR=-use-menhir @@ -18,7 +18,7 @@ stub: $(MAKE) -C stub LIB=$(LIB) deps: - opam install ocamlbuild curses camlzip ezxmlm ounit text menhir + opam install ocamlbuild curses camlzip ezxmlm ounit text menhir zarith byte: stub $(OCAMLBUILD) -pkgs $(PACKAGES) $(STUB_OPTIONS) $(MENHIR) -Is $(PATHS) main.byte diff --git a/cell.ml b/cell.ml index c4aa9c3..e6ccd63 100755 --- a/cell.ml +++ b/cell.ml @@ -10,7 +10,7 @@ let from_string (fixed_x, x_name) (fixed_y, y) = | 'A'..'Z' as c -> x:= (!x * 26) + ((int_of_char c) - 64) | _ -> () ) x_name; - (!x, Num.int_of_num y), (fixed_x, fixed_y) + (!x, y), (fixed_x, fixed_y) let to_hname x = begin let rec extract acc value = diff --git a/cell.mli b/cell.mli index 621fc3b..8f225a5 100755 --- a/cell.mli +++ b/cell.mli @@ -10,7 +10,7 @@ end val to_pair: t -> (int * int) -val from_string: bool * string -> bool * Num.num -> t +val from_string: bool * string -> bool * int -> t val to_hname: int -> UTF8.t diff --git a/dataType.ml b/dataType.ml index 2fcbd0d..b6c4fd0 100755 --- a/dataType.ml +++ b/dataType.ml @@ -21,97 +21,40 @@ end module Num = struct - type t = - | NAN - | N of Num.num - - let nan = NAN - - let of_num n = N n - - let zero = Num.num_of_int 0 - - let to_num = function - | NAN -> zero - | N n -> n - - let eq v1 v2 = match v1, v2 with - | N n1, N n2 -> Num.eq_num n1 n2 - | _, _ -> false - - let neq a b = not (eq a b) - - let lt v1 v2 = match v1, v2 with - | N n1, N n2 -> Num.lt_num n1 n2 - | N x, NAN -> Num.lt_num x (zero) - | NAN, N x -> Num.lt_num (zero) x - | NAN, NAN -> false - - let le v1 v2 = match v1, v2 with - | N n1, N n2 -> Num.le_num n1 n2 - | N x, NAN -> Num.le_num x (zero) - | NAN, N x -> Num.le_num (zero) x - | NAN, NAN -> false - - let gt v1 v2 = match v1, v2 with - | N n1, N n2 -> Num.gt_num n1 n2 - | N x, NAN -> Num.gt_num x (zero) - | NAN, N x -> Num.gt_num (zero) x - | NAN, NAN -> false - - let ge v1 v2 = match v1, v2 with - | N n1, N n2 -> Num.ge_num n1 n2 - | N x, NAN -> Num.ge_num x (zero) - | NAN, N x -> Num.ge_num (zero) x - | NAN, NAN -> false - - let add v1 v2 = match v1, v2 with - | N n1, N n2 -> N (Num.add_num n1 n2) - | n1, NAN -> n1 - | NAN, n1 -> n1 - - let mult v1 v2 = match v1, v2 with - | N n1, N n2 -> N (Num.mult_num n1 n2) - | _, _ -> N zero - - let div v1 v2 = match v1, v2 with - | N n1, N n2 -> N (Num.div_num n1 n2) - | _, N _ -> N zero - | _, _ -> raise Division_by_zero - - let sub v1 v2 = match v1, v2 with - | N n1, N n2 -> N (Num.sub_num n1 n2) - | v, NAN -> v - | NAN, N n -> N (Num.minus_num n) - - let pow v1 v2 = match v1, v2 with - | N n1, N n2 -> N (Num.power_num n1 n2) - | _, NAN -> N (Num.num_of_int 1) - | NAN, _ -> N zero - - let rnd () = N ( - Num.div_num - (Num.num_of_int @@ Int32.to_int @@ Random.int32 Int32.max_int) - (Num.num_of_int @@ Int32.to_int @@ Int32.max_int) - ) - - let min v1 v2 = match v1, v2 with - | N n1, N n2 -> N (Num.min_num n1 n2) - | NAN, x -> x - | x, NAN -> x - - let max v1 v2 = match v1, v2 with - | N n1, N n2 -> N (Num.max_num n1 n2) - | NAN, x -> x - | x, NAN -> x - - let abs = function - | NAN -> NAN - | N n1 -> N (Num.abs_num n1) - - let neg = function - | NAN -> NAN - | N n1 -> N (Num.minus_num n1) + let rnd () = + let value = Random.bits () in + Q.make (Z.of_int value) (Z.of_int (1 lsl 30)) + + include Q + + let eq = Q.equal + + let neq a b = not (Q.equal a b) + + let mult = Q.mul + + let floor f = Q.of_bigint (Q.to_bigint f) + + let ge = Q.geq + + let ge = Q.geq + + let le = Q.leq + + let pow t q_factor = + let factor = Q.to_int q_factor + and num = Q.num t + and den = Q.num t in + + Q.make (Z.pow num factor) (Z.pow den factor) + + let gcd t1 t2 = + Q.of_bigint @@ Z.gcd (Q.to_bigint t1) (Q.to_bigint t2) + + let lcm t1 t2 = + Q.of_bigint @@ Z.lcm (Q.to_bigint t1) (Q.to_bigint t2) + + let is_integer t = (Q.den t) == Z.one end @@ -135,3 +78,5 @@ module String = struct include Comparable end + +module Date = Date.Make(Num) diff --git a/dataType.mli b/dataType.mli index 901346c..5397fdb 100755 --- a/dataType.mli +++ b/dataType.mli @@ -12,10 +12,14 @@ module Num: sig type t - val of_num: Num.num -> t - val nan: t + val one: t + val zero: t - val to_num: t -> Num.num + val of_int: int -> t + val to_int: t -> int + + val to_float: t -> float + val of_float: float -> t val neg: t -> t @@ -38,6 +42,14 @@ module Num: sig val min: t -> t -> t val abs: t -> t + + val floor: t -> t + + val gcd: t -> t -> t + val lcm: t -> t -> t + + val is_integer: t -> bool + end module Bool: sig @@ -67,3 +79,19 @@ module String: sig val gt: t -> t -> bool val ge: t -> t -> bool end + +module Date: sig + + (** Create a date from a year month day *) + val get_julian_day : int -> int -> int -> Num.t + + (** Return the year, month and day from a date *) + val date_from_julian_day : Num.t -> int * int * int + + val time_from_julian_day : Num.t -> int * int * Num.t + + val from_string: string -> Num.t + + (** Print out the date *) + val to_string: Num.t -> string +end diff --git a/date.ml b/date.ml index 4869f38..0a2631f 100644 --- a/date.ml +++ b/date.ml @@ -1,101 +1,122 @@ -type t = Num.num - -let get_julian_day year month day = begin - let y, m = - if month > 2 then - year, month - else - year - 1, month + 12 - in - let b = - if (year > 1582) || (year = 1582 && month > 10) || (year = 1582 && month = 10 && day >= 15) then - let s = y / 100 in - 2 - s + (s / 4) - else - 0 - in - 365 * y + y / 4 - + (int_of_float (30.6001 *. (float_of_int (m + 1)))) - + day - + b - + 1720995 - - 2415019 (* Shift to 30/12/1899 *) - |> Num.num_of_int +module type CALCULABLE = sig + + type t + + val add: t -> t -> t + + val sub: t -> t -> t + + val mult: t -> t -> t + + val div: t -> t -> t + + val floor: t -> t + + val of_int: int -> t + + val to_int: t -> int + + val to_float: t -> float end -let date_from_julian_day (day:Num.num) = begin - - let shift_day = Num.floor_num day - |> Num.add_num (Num.num_of_int 2415019) in - - let z = Num.int_of_num shift_day in - let f = - if z >= 2299161 then - (* We use the Num module here to prevent overflow *) - let day' = Num.(((num_of_int 4) */ shift_day +/ (num_of_int 274277)) // (num_of_int 146097)) - |> Num.floor_num - |> Num.int_of_num in - z + 1401 + ((day' * 3) / 4) - 38 - else - z + 1401 + +module Make(C : CALCULABLE) = struct + + let get_julian_day year month day = begin + let y, m = + if month > 2 then + year, month + else + year - 1, month + 12 in - let e = (4 * f) + 3 in - let h = 5 * ((e mod 1461) / 4) + 2 in (* 1461 is 365.25 * 4 *) - let d = ((h mod 153) / 5) + 1 - and m = (((h / 153) + 2) mod 12) + 1 in - let y = (e / 1461) - 4716 + (14 - m) / 12 in (* 4716 is day 2 *) - (y, m, d) + let b = + if (year > 1582) || (year = 1582 && month > 10) || (year = 1582 && month = 10 && day >= 15) then + let s = y / 100 in + 2 - s + (s / 4) + else + 0 + in + 365 * y + y / 4 + + (int_of_float (30.6001 *. (float_of_int (m + 1)))) + + day + + b + + 1720995 + - 2415019 (* Shift to 30/12/1899 *) + |> C.of_int -end + end + + let date_from_julian_day day = begin + + let shift_day = C.add (C.floor day) (C.of_int 2415019) in + + let z = C.to_int shift_day in + let f = + if z >= 2299161 then + (* We use the Num module here to prevent overflow *) + let product = C.mult (C.of_int 4) shift_day in + let shifted = C.add product (C.of_int 274277) in + let div = C.div shifted (C.of_int 146097) in + let day' = C.to_int @@ C.floor div in + z + 1401 + ((day' * 3) / 4) - 38 + else + z + 1401 + in + let e = (4 * f) + 3 in + let h = 5 * ((e mod 1461) / 4) + 2 in (* 1461 is 365.25 * 4 *) + let d = ((h mod 153) / 5) + 1 + and m = (((h / 153) + 2) mod 12) + 1 in + let y = (e / 1461) - 4716 + (14 - m) / 12 in (* 4716 is day 2 *) + (y, m, d) + + end + + let time_from_julian_day j = begin -let time_from_julian_day j = begin Num.( - let day = floor_num j in - let time = j -/ day in - - let h = floor_num @@ time */ (num_of_int 24) in - let h_24 = (h // (num_of_int 24)) in - let m = floor_num @@ (num_of_int 1440) */ (time -/ h_24 ) in - let s = (num_of_int 86400) */ (time -/ h_24 -/ (m // (num_of_int 1440))) in - (h, m, s) -) end - -(** Compute the julian for a given date. - - Integer return number of days since November 24, 4714 BC. - Fractionnal part return the time since midnight. -*) -let from_string str = begin - let n = Num.num_of_int in - let date_regex = Str.regexp "[0-9]+-[0-9]+-[0-9]+" - and time_regex = Str.regexp "[0-9]+-[0-9]+-[0-9]+T[0-9]+:[0-9]+:[0-9]" in - if Str.string_match time_regex str 0 then - Scanf.sscanf str "%d-%d-%dT%d:%d:%d" (fun year month day hour min sec -> - Num.( - let nhour = n hour // (n 24) - and nmin = n min // (n 1440) - and nsec = n sec // (n 86400) in - (get_julian_day year month day) +/ nhour +/ nmin +/ nsec + let day = C.floor j in + let time = C.sub j day in + + let h = C.floor @@ C.mult time (C.of_int 24) in + let h_24 = C.div h (C.of_int 24) in + let m = C.floor @@ C.mult (C.of_int 1440) (C.sub time h_24) in + let s = C.mult (C.of_int 86400) (C.sub (C.sub time h_24) (C.div m (C.of_int 1440))) in + (C.to_int h, C.to_int m, s) + end + + (** Compute the julian for a given date. + + Integer return number of days since November 24, 4714 BC. + Fractionnal part return the time since midnight. + *) + let from_string str = begin + let n = C.of_int in + let date_regex = Str.regexp "[0-9]+-[0-9]+-[0-9]+" + and time_regex = Str.regexp "[0-9]+-[0-9]+-[0-9]+T[0-9]+:[0-9]+:[0-9]" in + if Str.string_match time_regex str 0 then + Scanf.sscanf str "%d-%d-%dT%d:%d:%d" (fun year month day hour min sec -> + Num.( + let nhour = C.div (n hour) (n 24) + and nmin = C.div (n min) (n 1440) + and nsec = C.div (n sec) (n 86400) in + C.add (C.add (C.add (get_julian_day year month day) nhour) nmin) nsec + ) + ) else if Str.string_match date_regex str 0 then + Scanf.sscanf str "%d-%d-%d" get_julian_day + else ( + C.of_int 0 ) - ) else if Str.string_match date_regex str 0 then - Scanf.sscanf str "%d-%d-%d" get_julian_day - else ( - Num.num_of_int 0 - ) -end + end -let to_string date = begin - let y, m, d = date_from_julian_day date - and h, n, s = time_from_julian_day date in + let to_string date = begin + let y, m, d = date_from_julian_day date + and h, n, s = time_from_julian_day date in - Printf.sprintf "%d-%02d-%02dT%02d:%02d:%02g" - y - m - d - (Num.int_of_num h) - (Num.int_of_num n) - (Num.float_of_num s) + Printf.sprintf "%d-%02d-%02dT%02d:%02d:%02g" + y m d -end + h n (C.to_float s) + end +end diff --git a/date.mli b/date.mli new file mode 100755 index 0000000..dd24124 --- /dev/null +++ b/date.mli @@ -0,0 +1,38 @@ +module type CALCULABLE = sig + + type t + + val add: t -> t -> t + + val sub: t -> t -> t + + val mult: t -> t -> t + + val div: t -> t -> t + + val floor: t -> t + + val of_int: int -> t + + val to_int: t -> int + + val to_float: t -> float + +end + +module Make(C:CALCULABLE): sig + + (** Create a date from a year month day *) + val get_julian_day : int -> int -> int -> C.t + + (** Return the year, month and day from a date *) + val date_from_julian_day : C.t -> int * int * int + + val time_from_julian_day : C.t -> int * int * C.t + + val from_string: string -> C.t + + (** Print out the date *) + val to_string: C.t -> string + +end diff --git a/evaluator.ml b/evaluator.ml index a5f3380..075f728 100755 --- a/evaluator.ml +++ b/evaluator.ml @@ -274,11 +274,10 @@ let () = begin (* Build a date *) register3 "date" (t_int, t_int, t_int) f_date ( fun year month day -> - 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 + D.Date.get_julian_day + (D.Num.to_int year) + (D.Num.to_int month) + (D.Num.to_int day) ); let module CompareNum = Make_Compare(D.Num) in @@ -286,6 +285,23 @@ let () = begin CompareNum.register t_int; register0 "rand" f_number D.Num.rnd; + register1 "exp" t_int f_number (fun x -> D.Num.of_float (exp @@ D.Num.to_float x)); + register0 "pi" f_number (fun () -> D.Num.of_float (4. *. atan 1.)); + register1 "sin" t_int f_number (fun x -> D.Num.of_float (sin @@ D.Num.to_float x)); + register1 "cos" t_int f_number (fun x -> D.Num.of_float (cos @@ D.Num.to_float x)); + register1 "tan" t_int f_number (fun x -> D.Num.of_float (tan @@ D.Num.to_float x)); + register1 "atan" t_int f_number (fun x -> D.Num.of_float (atan @@ D.Num.to_float x)); + register1 "asin" t_int f_number (fun x -> D.Num.of_float (asin @@ D.Num.to_float x)); + register1 "acos" t_int f_number (fun x -> D.Num.of_float (acos @@ D.Num.to_float x)); + register1 "sinh" t_int f_number (fun x -> D.Num.of_float (sinh @@ D.Num.to_float x)); + register1 "cosh" t_int f_number (fun x -> D.Num.of_float (cosh @@ D.Num.to_float x)); + register1 "tanh" t_int f_number (fun x -> D.Num.of_float (tanh @@ D.Num.to_float x)); + register2 "atan2" (t_int, t_int)f_number (fun x y -> + D.Num.of_float (atan2 (D.Num.to_float x) (D.Num.to_float y)) + ); + + register1 "sqrt" t_int f_number (fun x -> D.Num.of_float (sqrt @@ D.Num.to_float x)); + register3 "if" (t_bool, t_int, t_int) f_number if_; register3 "if" (t_bool, t_bool, t_bool) f_bool if_; register3 "if" (t_bool, t_string, t_string) f_string if_; @@ -298,8 +314,11 @@ let () = begin register0 "false" f_bool (fun () -> D.Bool.false_); register1 "not" t_bool f_bool D.Bool.not; register2 "and" (t_bool, t_bool) f_bool D.Bool.and_; +(* fold "and" t_bool f_bool D.Bool.and_ (D.Bool.true_); *) register2 "or" (t_bool, t_bool) f_bool D.Bool.or_; +(* fold "or" t_bool f_bool D.Bool.or_ (D.Bool.false_); *) register2 "xor" (t_bool, t_bool) f_bool D.Bool.neq; +(* fold "xor" t_bool f_bool D.Bool.neq (D.Bool.false_); *) let module CompareString = Make_Compare(D.String) in CompareString.register t_string; @@ -307,9 +326,11 @@ let () = begin reduce "min" t_int f_num D.Num.min; (* Minimum value from a list *) reduce "max" t_int f_num D.Num.max; (* Maximum value from a list *) - 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)); + fold "sum" t_int f_number D.Num.add (D.Num.zero); + fold "product" t_int f_number D.Num.mult (D.Num.one); + register2 "gcd"(t_int, t_int) f_number D.Num.gcd; + register2 "lcm"(t_int, t_int) f_number D.Num.lcm; register1 "+" t_int f_num (fun x -> x); register1 "-" t_int f_num D.Num.neg; (* Unary negation *) register2 "^" (t_int, t_int) f_number D.Num.pow; diff --git a/expressionLexer.mll b/expressionLexer.mll index 57ef26a..2d2f87e 100755 --- a/expressionLexer.mll +++ b/expressionLexer.mll @@ -21,8 +21,8 @@ let cell = letters+ digit+ rule read = parse | space+ { read lexbuf } - | digit+ as _1 { NUM (_1, Num.num_of_string _1)} - | real as _1 { REAL(Tools.String.filter_float _1, Tools.Num.of_float_string _1)} + | digit+ as _1 { NUM _1} + | real as _1 { REAL(Tools.String.filter_float _1)} | '$' { DOLLAR } | '=' { EQ } diff --git a/expressionParser.mly b/expressionParser.mly index a9f685f..b7f77ae 100755 --- a/expressionParser.mly +++ b/expressionParser.mly @@ -8,8 +8,8 @@ %} -%token REAL -%token NUM +%token REAL +%token NUM %token STR %token LETTERS @@ -46,30 +46,27 @@ content: | basic EOF {$1} basic: - | PLUS num {Result (number (DataType.Num.of_num (snd $2)))} - | MINUS num {Result (number (DataType.Num.of_num @@ Num.minus_num (snd $2)))} - | num {Result (number (DataType.Num.of_num (snd $1)))} + | PLUS num {Result (number $2)} + | MINUS num {Result (number (DataType.Num.neg $2))} + | num {Result (number $1)} | NUM DIVIDE NUM DIVIDE NUM {Result ( date ( - DataType.Num.of_num @@ (Date.get_julian_day - (Num.int_of_num @@ snd $1) - (Num.int_of_num @@ snd $3) - (Num.int_of_num @@ snd $5) - )))} + DataType.Date.get_julian_day + (int_of_string $1) + (int_of_string $3) + (int_of_string $5) + ))} | NUM COLON NUM COLON NUM {Result ( date ( - Num.( - let nhour = (snd $1) // (num_of_int 24) - and nmin = (snd $3) // (num_of_int 1440) - and nsec = (snd $5) // (num_of_int 86400) - in DataType.Num.of_num @@ nhour +/ nmin +/ nsec) + let nhour = DataType.Num.div (DataType.Num.of_int @@ int_of_string $1) (DataType.Num.of_int 24) + and nmin = DataType.Num.div (DataType.Num.of_int @@ int_of_string $3) (DataType.Num.of_int 1440) + and nsec = DataType.Num.div (DataType.Num.of_int @@ int_of_string $5) (DataType.Num.of_int 86400) + in DataType.Num.add (DataType.Num.add nhour nmin) nsec ) )} expr: - | num {Value (number ( - DataType.Num.of_num (snd $1) - ))} + | num {Value (number ($1))} | MINUS expr {Call (F.sub, [$2])} | PLUS expr {Call (F.add, [$2])} @@ -99,18 +96,18 @@ expr: | expr GE expr {Call (F.ge, [$1; $3])} %inline cell: - | LETTERS NUM { Cell.from_string (false, $1) (false, snd $2) } - | DOLLAR LETTERS NUM { Cell.from_string (true, $2) (false, snd $3) } - | LETTERS DOLLAR NUM { Cell.from_string (false, $1) (true, snd $3) } - | DOLLAR LETTERS DOLLAR NUM { Cell.from_string (true, $2) (true, snd $4) } + | LETTERS NUM { Cell.from_string (false, $1) (false, int_of_string $2) } + | DOLLAR LETTERS NUM { Cell.from_string (true, $2) (false, int_of_string $3) } + | LETTERS DOLLAR NUM { Cell.from_string (false, $1) (true, int_of_string $3) } + | DOLLAR LETTERS DOLLAR NUM { Cell.from_string (true, $2) (true, int_of_string $4) } num: - | REAL {$1} - | NUM {$1} + | REAL {DataType.Num.of_float @@ float_of_string $1} + | NUM {DataType.Num.of_int @@ int_of_string $1} ident: | text* { String.concat "" $1 } text: | LETTERS { $1 } - | NUM { fst $1 } + | NUM { $1 } diff --git a/odf/odf.ml b/odf/odf.ml index 8fa3411..ae120d9 100755 --- a/odf/odf.ml +++ b/odf/odf.ml @@ -31,11 +31,11 @@ let load_formula formula = let load_content content = begin function | "float" -> Expression.Basic ( ScTypes.number ( - DataType.Num.of_num (Tools.Num.of_float_string content) + DataType.Num.of_float (float_of_string content) )) | "date" -> Expression.Basic ( ScTypes.date ( - DataType.Num.of_num (Tools.Num.of_float_string content) + DataType.Num.of_float (float_of_string content) )) | _ -> Expression.Basic ( ScTypes.string ( @@ -170,13 +170,13 @@ let write_basic: type a. 'b list -> Xmlm.output -> a ScTypes.types -> unit = fun | ScTypes.Str s -> write_str attrs output (UTF8.to_utf8string s) | ScTypes.Bool b -> write_bool attrs output (string_of_bool b) | ScTypes.Num (data_type, d) -> - let n = DataType.Num.to_num d in begin match ScTypes.get_numeric_type data_type with | ScTypes.Number -> - let value = (string_of_float @@ Num.float_of_num n) in + let f = DataType.Num.to_float d in + let value = string_of_float f in write_num ((NS.value_attr, value)::attrs) output value | ScTypes.Date -> - let value = Date.to_string n in + let value = DataType.Date.to_string d in write_date ((NS.date_value_attr, value)::attrs) output value end end @@ -204,13 +204,14 @@ let rec print_expr : UTF8.Buffer.buffer -> ScTypes.expression -> unit = fun buff u(string_of_bool b) |> UTF8.Buffer.add_string buffer | ScTypes.Value (ScTypes.Num (data_type, d)) -> - let n = DataType.Num.to_num d in begin match ScTypes.get_numeric_type data_type with | ScTypes.Number -> - UTF8.Buffer.add_string buffer @@ u(string_of_float @@ Num.float_of_num n) + let f = DataType.Num.to_float d in + UTF8.Buffer.add_string buffer @@ u(string_of_float f) | ScTypes.Date -> - u(Date.to_string n) - |> UTF8.Buffer.add_string buffer + DataType.Date.to_string d + |> u + |> UTF8.Buffer.add_string buffer end | ScTypes.Ref r -> print_ref buffer r | ScTypes.Expression x -> diff --git a/odf/odf_ExpressionLexer.mll b/odf/odf_ExpressionLexer.mll index 1db73c3..7f6a55b 100755 --- a/odf/odf_ExpressionLexer.mll +++ b/odf/odf_ExpressionLexer.mll @@ -26,8 +26,8 @@ let cell = letters+ digit+ rule read = parse | space+ { read lexbuf } - | digit+ as _1 { NUM (_1, Num.num_of_string _1)} - | real as _1 { REAL (Tools.String.filter_float _1, Tools.Num.of_float_string _1)} + | digit+ as _1 { NUM _1} + | real as _1 { REAL (Tools.String.filter_float _1)} | '$' { DOLLAR } | '=' { EQ } @@ -58,14 +58,14 @@ rule read = parse and read_string buf = parse | '"' { STR (Buffer.contents buf) } - | '\\' '/' { Buffer.add_char buf '/'; read_string buf lexbuf } - | '\\' '\\' { Buffer.add_char buf '\\'; read_string buf lexbuf } - | '\\' 'b' { Buffer.add_char buf '\b'; read_string buf lexbuf } + | '\\' '/' { Buffer.add_char buf '/'; read_string buf lexbuf } + | '\\' '\\' { Buffer.add_char buf '\\'; read_string buf lexbuf } + | '\\' 'b' { Buffer.add_char buf '\b'; read_string buf lexbuf } | '\\' 'f' { Buffer.add_char buf '\012'; read_string buf lexbuf } - | '\\' 'n' { Buffer.add_char buf '\n'; read_string buf lexbuf } - | '\\' 'r' { Buffer.add_char buf '\r'; read_string buf lexbuf } - | '\\' 't' { Buffer.add_char buf '\t'; read_string buf lexbuf } - | '\\' '"' { Buffer.add_char buf '"'; read_string buf lexbuf } + | '\\' 'n' { Buffer.add_char buf '\n'; read_string buf lexbuf } + | '\\' 'r' { Buffer.add_char buf '\r'; read_string buf lexbuf } + | '\\' 't' { Buffer.add_char buf '\t'; read_string buf lexbuf } + | '\\' '"' { Buffer.add_char buf '"'; read_string buf lexbuf } | [^ '"' '\\' '\000']+ { Buffer.add_string buf (Lexing.lexeme lexbuf); read_string buf lexbuf diff --git a/odf/odf_ExpressionParser.mly b/odf/odf_ExpressionParser.mly index 190e6f1..6b571a9 100755 --- a/odf/odf_ExpressionParser.mly +++ b/odf/odf_ExpressionParser.mly @@ -4,12 +4,12 @@ let u = UTF8.from_utf8string - let extractColumnNameFromNum (fixed, (str, value)) = (fixed, value) + let extractColumnNameFromNum (fixed, str) = (fixed, int_of_string str) %} -%token REAL -%token NUM +%token REAL +%token NUM %token STR %token LETTERS @@ -43,9 +43,7 @@ value: | LETTERS COLON EQ expr EOF {$4} expr: - | num {Value (number ( - DataType.Num.of_num @@ snd $1 - ))} + | num {Value (number ($1))} | MINUS expr {Call (F.sub, [$2])} | PLUS expr {Call (F.add, [$2])} @@ -85,8 +83,8 @@ fixed(X): | X {false, $1} num: - | REAL {$1} - | NUM {$1} + | REAL {DataType.Num.of_float @@ float_of_string $1} + | NUM {DataType.Num.of_int @@ int_of_string $1} ident: | IDENT { $1 } @@ -94,4 +92,4 @@ ident: text: | LETTERS { $1 } - | NUM { fst $1 } + | NUM { $1 } diff --git a/scTypes.ml b/scTypes.ml index a222f3b..075f25d 100755 --- a/scTypes.ml +++ b/scTypes.ml @@ -85,8 +85,8 @@ module DataFormat = struct end let default_value_for: type a. a dataFormat -> a = function - | Date -> DataType.Num.nan - | Number -> DataType.Num.nan + | Date -> DataType.Num.zero + | Number -> DataType.Num.zero | Bool -> false | String -> UTF8.empty @@ -106,7 +106,7 @@ module DataFormat = struct end module Type = struct - (* Required because Num.Big_int cannot be compared with Pervasives.(=) *) + let (=) : type a b. a types -> b types -> bool = fun t1 t2 -> match t1, t2 with | Num (_, n1), Num (_, n2) -> DataType.Num.eq n1 n2 @@ -131,15 +131,18 @@ module Type = struct | Str x -> UTF8.Buffer.add_string buffer x | Bool b -> UTF8.Printf.bprintf buffer "%B" b | Num (Number, n) -> - let n = DataType.Num.to_num n in - if Num.is_integer_num n then - UTF8.Buffer.add_string buffer @@ u(Num.string_of_num n) + if DataType.Num.is_integer n then + DataType.Num.to_int n + |> string_of_int + |> UTF8.from_utf8string + |> UTF8.Buffer.add_string buffer else - let to_b = UTF8.Format.formatter_of_buffer buffer in - ignore @@ UTF8.Format.fprintf to_b "%.2f" (Num.float_of_num n); + let f = DataType.Num.to_float n + and to_b = UTF8.Format.formatter_of_buffer buffer in + ignore @@ UTF8.Format.fprintf to_b "%.2f" f; Format.pp_print_flush to_b () | Num (Date, n) -> - let y, m, d = Date.date_from_julian_day (DataType.Num.to_num n) in + let y, m, d = DataType.Date.date_from_julian_day n in UTF8.Printf.bprintf buffer "%d/%d/%d" y m d end diff --git a/tests/dataType_test.ml b/tests/dataType_test.ml index 3bf51ad..ddb45ae 100755 --- a/tests/dataType_test.ml +++ b/tests/dataType_test.ml @@ -3,42 +3,31 @@ module N = DataType.Num let test_num_add n1 n2 result ctx = begin assert_equal - ~cmp:(Num.(=/)) + ~cmp:(=) result - (N.to_num @@ N.add n1 n2) + (N.to_int @@ N.add n1 n2) end let test_num_mult n1 n2 result ctx = begin assert_equal - ~cmp:(Num.(=/)) + ~cmp:(=) result - (N.to_num @@ N.mult n1 n2) + (N.to_int @@ N.mult n1 n2) end let test_num_sub n1 n2 result ctx = begin assert_equal - ~cmp:(Num.(=/)) + ~cmp:(=) result - (N.to_num @@ N.sub n1 n2) + (N.to_int @@ N.sub n1 n2) end -let n1 = N.of_num (Num.num_of_int 1) -let n2 = N.of_num (Num.num_of_int 2) +let n1 = N.of_int 1 +let n2 = N.of_int 2 let num_tests = "num_test">::: [ - "test_add" >:: test_num_add n1 n1 (Num.num_of_int 2); - "test_add_nan1" >:: test_num_add n1 N.nan (Num.num_of_int 1); - "test_add_nan2" >:: test_num_add N.nan n1 (Num.num_of_int 1); - "test_add_nan3" >:: test_num_add N.nan N.nan (Num.num_of_int 0); - - "test_mult" >:: test_num_mult n2 n1 (Num.num_of_int 2); - "test_mult_nan1" >:: test_num_mult n1 N.nan (Num.num_of_int 0); - "test_mult_nan2" >:: test_num_mult N.nan n1 (Num.num_of_int 0); - "test_mult_nan3" >:: test_num_mult N.nan N.nan (Num.num_of_int 0); - - "test_sub" >:: test_num_sub n1 n1 (Num.num_of_int 0); - "test_sub_nan1" >:: test_num_sub n1 N.nan (Num.num_of_int 1); - "test_sub_nan2" >:: test_num_sub N.nan n1 (Num.num_of_int (-1)); - "test_sub_nan3" >:: test_num_sub N.nan N.nan (Num.num_of_int 0); + "test_add" >:: test_num_add n1 n1 2; + "test_mult" >:: test_num_mult n2 n1 2; + "test_sub" >:: test_num_sub n1 n1 0; ] diff --git a/tests/expressionParser_test.ml b/tests/expressionParser_test.ml index 30bd665..12ceeb0 100755 --- a/tests/expressionParser_test.ml +++ b/tests/expressionParser_test.ml @@ -20,7 +20,7 @@ let test_num ctx = begin let expected = Expression.Formula ( Expression.Expression ( ScTypes.Value (ScTypes.number ( - DataType.Num.of_num (Num.num_of_int 1) + DataType.Num.of_int 1 ) ))) in let result = load_expr "=1" in @@ -54,7 +54,7 @@ let test_call2 ctx = begin Expression.Expression ( ScTypes.Call ( u"foo2", [ScTypes.Value (ScTypes.number ( - DataType.Num.of_num (Num.num_of_int 4) + DataType.Num.of_int 4 ))]))) in let result = load_expr "=foo2(4)" in @@ -82,5 +82,5 @@ let tests = "expression_parser_test">::: [ "test_num" >:: test_num; "test_call" >:: test_call; "test_call2" >:: test_call2; - "test_ref" >:: test_ref; + "test_ref" >:: test_ref; ] diff --git a/tests/expression_test.ml b/tests/expression_test.ml index 2fa4d9b..5def730 100755 --- a/tests/expression_test.ml +++ b/tests/expression_test.ml @@ -6,11 +6,11 @@ let u = UTF8.from_utf8string let _msg ~expected ~result = let get_type = function - | Expression.Basic ScTypes.Num (ScTypes.Number, _) -> "N" - | Expression.Basic ScTypes.Num (ScTypes.Date, _) -> "D" - | Expression.Basic ScTypes.Str _ -> "S" - | Expression.Basic ScTypes.Bool _ -> "B" - | Expression.Formula _ -> "F" in + | Expression.Basic ScTypes.Num (ScTypes.Number, _) -> "N" + | Expression.Basic ScTypes.Num (ScTypes.Date, _) -> "D" + | Expression.Basic ScTypes.Str _ -> "S" + | Expression.Basic ScTypes.Bool _ -> "B" + | Expression.Formula _ -> "F" in Printf.sprintf "Expected %s:%s but got %s:%s" (UTF8.raw_encode @@ Expression.show expected) @@ -53,7 +53,7 @@ let test_num ctx = begin let result = Expression.load @@ u"123" in let expected = Expression.load_expr @@ Expression.Basic ( ScTypes.number ( - DataType.Num.of_num @@ Num.num_of_int 123 + DataType.Num.of_int 123 )) in assert_equal expected result end @@ -62,7 +62,7 @@ let test_float ctx = begin let result = Expression.load @@ u"12.45" in let expected = Expression.load_expr @@ Expression.Basic ( ScTypes.number ( - DataType.Num.of_num @@ T.Num.of_float_string "12.45" + DataType.Num.of_float @@ float_of_string "12.45" )) in assert_equal expected result end @@ -71,7 +71,7 @@ let test_relative ctx = begin let result = Expression.load @@ u"-123" in let expected = Expression.load_expr @@ Expression.Basic ( ScTypes.number ( - DataType.Num.of_num @@ Num.num_of_int (-123) + DataType.Num.of_int (-123) )) in assert_equal expected result end @@ -80,7 +80,7 @@ let test_date ctx = begin let result = Expression.load @@ u"1900/01/01" and expected = Expression.load_expr @@ Expression.Basic ( ScTypes.date ( - DataType.Num.of_num @@ Date.get_julian_day 1900 01 01 + DataType.Date.get_julian_day 1900 01 01 )) in assert_equal expected result end diff --git a/tests/odf/odf_ExpressionParser_test.ml b/tests/odf/odf_ExpressionParser_test.ml index 8b4e4ff..18efe96 100755 --- a/tests/odf/odf_ExpressionParser_test.ml +++ b/tests/odf/odf_ExpressionParser_test.ml @@ -15,7 +15,7 @@ let _msg ~(expected:ScTypes.expression) ~(result:ScTypes.expression) = let build_num value = ScTypes.number ( - DataType.Num.of_num @@ Num.num_of_int value + DataType.Num.of_int value ) diff --git a/tests/sheet_test.ml b/tests/sheet_test.ml index 7353dc6..9218134 100755 --- a/tests/sheet_test.ml +++ b/tests/sheet_test.ml @@ -16,9 +16,7 @@ let _msg ~expected ~result = begin (get_string result) end -let build_num value = ScTypes.number ( - DataType.Num.of_num @@ Num.num_of_int value -) +let build_num value = ScTypes.number @@ DataType.Num.of_int value (** Test a simple references between two cells *) let test_create_ref_1 ctx = begin diff --git a/tests/tools_test.ml b/tests/tools_test.ml index 5514404..74a3acd 100755 --- a/tests/tools_test.ml +++ b/tests/tools_test.ml @@ -98,21 +98,41 @@ end module TestDate = struct - let _msg ~expected ~result = - Printf.sprintf "Expected %s but got %s" - (Num.string_of_num expected) - (Num.string_of_num result) + module Float = struct + + type t = float + let add = ( +. ) + let sub = ( -. ) + let mult = ( *. ) + let div = ( /. ) + + let floor = Pervasives.floor + + let of_int = float_of_int + + let to_int = int_of_float + let to_float x = x + + end + + module FDate = Date.Make(Float) + + let epsilon = 1.0e-5 + + let (=.) a b = (abs_float (a-.b)) < epsilon let test_get_julian_day ctx = begin - let result = Date.get_julian_day 2016 01 01 - and expected = (Num.num_of_int 42370) in + let result = FDate.get_julian_day 2016 01 01 + and expected = 42370. in - (* Check that the num is round *) - assert_equal true (Num.is_integer_num result); + let _msg ~expected ~result = + Printf.sprintf "Expected %f but got %f" + expected + result in assert_equal - ~cmp:Num.(=/) + ~cmp:(=.) ~msg:(_msg ~expected ~result) expected result @@ -126,7 +146,7 @@ module TestDate = struct y2 m2 d2 in - let result = Date.date_from_julian_day @@ Num.num_of_int 734 + let result = FDate.date_from_julian_day 734. and expected = (1902, 01, 03) in assert_equal @@ -137,11 +157,18 @@ module TestDate = struct end let test_parse_time ctx = begin - let result = Date.from_string "1902-01-03T12:34:56" - and expected = (Num.num_of_string "3966431/5400") in + let result = FDate.from_string "1902-01-03T12:34:56" + + and expected = 3966431. /. 5400. (* =2415753.52425925925925925925 *) + + and _msg ~expected ~result = + Printf.sprintf "Expected %f but got %f" + expected + result in + assert_equal - ~cmp:Num.(=/) + ~cmp:(=.) ~msg:(_msg ~expected ~result) expected result @@ -150,17 +177,17 @@ module TestDate = struct let test_time_from_julian_day ctx = begin let _msg (h1, m1, s1) (h2, m2, s2) = - Printf.sprintf "Expected %f:%f:%f but got %f:%f:%f" + Printf.sprintf "Expected %d:%d:%f but got %d:%d:%f" h1 m1 s1 h2 m2 s2 in - let result = Date.time_from_julian_day @@ Date.from_string "1902-01-03T12:34:56" - |> Tools.Tuple3.map (Num.float_of_num) - and expected = (12., 34., 56.) in + let result = FDate.time_from_julian_day @@ FDate.from_string "1902-01-03T12:34:56" + and expected = (12, 34, 56.) in assert_equal ~msg:(_msg expected result) + ~cmp:(fun (a, b, c) (a', b', c') -> a = a' && b = b' && c =. c') expected result end @@ -168,9 +195,9 @@ module TestDate = struct let test_time_add_hour ctx = begin - let (result:string) = Date.from_string "1902-01-03T12:34:56" - |> Num.(add_num ((num_of_int 1) // (num_of_int 2)) ) - |> Date.to_string in + let (result:string) = FDate.from_string "1902-01-03T12:34:56" + |> fun x -> (x +. (1. /. 2.)) + |> FDate.to_string in let expected = "1902-01-04T00:34:56" in @@ -185,9 +212,9 @@ module TestDate = struct let test_time_add_hour2 ctx = begin - let (result:string) = Date.from_string "1902-01-03T12:34:56" - |> Num.(add_num ((num_of_int 3) // (num_of_int 4)) ) - |> Date.to_string in + let (result:string) = FDate.from_string "1902-01-03T12:34:56" + |> fun x -> (x +. (3. /. 4.)) + |> FDate.to_string in let expected = "1902-01-04T00:34:56" in @@ -201,44 +228,6 @@ module TestDate = struct end -(* -module TestLocale = struct - - let test_empty_string_length ctx = begin - - Tools.Locale.set Tools.Locale.LC_CTYPE "en_US.UTF-8"; - let result = Tools.Locale.length "" in - let expected = 0 in - Tools.Locale.set Tools.Locale.LC_CTYPE "C"; - - assert_equal expected result - end - - let test_one_byte_length ctx = begin - - Tools.Locale.set Tools.Locale.LC_CTYPE "en_US.UTF-8"; - let result = Tools.Locale.length "A" in - let expected = 1 in - Tools.Locale.set Tools.Locale.LC_CTYPE "C"; - - assert_equal expected result - end - - (** Encode an two-bytes UTF-8 string and check that the length is only one - character*) - let test_two_byte_length ctx = begin - - Tools.Locale.set Tools.Locale.LC_CTYPE "en_US.UTF-8"; - let result = Tools.Locale.length "\xc3\x80" in - let expected = 1 in - Tools.Locale.set Tools.Locale.LC_CTYPE "C"; - - assert_equal expected result - end - -end -*) - let tests = "tools_test">::: [ TestString.tests; @@ -250,10 +239,4 @@ let tests = "tools_test">::: [ "test_time_from_julian_day" >:: TestDate.test_time_from_julian_day; "test_time_add_hour" >:: TestDate.test_time_add_hour; -(* - (** Locale test *) - "test_locale_length0" >:: TestLocale.test_empty_string_length; - "test_locale_length1" >:: TestLocale.test_one_byte_length; - "test_locale_length2" >:: TestLocale.test_two_byte_length; -*) ] diff --git a/tools.ml b/tools.ml index f8f03cb..6dfe564 100755 --- a/tools.ml +++ b/tools.ml @@ -69,52 +69,6 @@ module String = struct end -module Num = struct - - include Num - - let of_float_string a = begin - try - let ipart_s,fpart_s = String.split a ~by:'.' in - let ipart = if ipart_s = "" then Num.Int 0 else Num.num_of_string ipart_s in - let fpart = - if fpart_s = "" then Num.Int 0 - else - let fpart = Num.num_of_string fpart_s in - let num10 = Num.num_of_int 10 in - let frac = Num.power_num num10 (Num.num_of_int (String.length fpart_s)) in - Num.div_num fpart frac - in - Num.add_num ipart fpart - with Not_found -> Num.num_of_string a - end - - let of_float f = begin - match classify_float f with - | FP_normal - | FP_subnormal -> - let x,e = frexp f in - let n,e = - Big_int.big_int_of_int64 (Int64.of_float (ldexp x 52)), - (e-52) - in - if e >= 0 then - Big_int (Big_int.shift_left_big_int n e) - else - Num.div_num - (Big_int n) - (Big_int Big_int.(shift_left_big_int unit_big_int ~-e)) - | FP_zero -> Num.num_of_int 0 - | FP_nan -> Num.div_num (Num.num_of_int 0) (Num.num_of_int 0) - | FP_infinite -> - if f >= 0. then - Num.div_num (Num.num_of_int 1) (Num.num_of_int 0) - else - Num.div_num (Num.num_of_int (-1)) (Num.num_of_int 0) - end - -end - module List = struct (** fold_left over only the first element *) -- cgit v1.2.3