aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rwxr-xr-xMakefile4
-rwxr-xr-xcell.ml2
-rwxr-xr-xcell.mli2
-rwxr-xr-xdataType.ml127
-rwxr-xr-xdataType.mli34
-rw-r--r--date.ml199
-rwxr-xr-xdate.mli38
-rwxr-xr-xevaluator.ml35
-rwxr-xr-xexpressionLexer.mll4
-rwxr-xr-xexpressionParser.mly47
-rwxr-xr-xodf/odf.ml19
-rwxr-xr-xodf/odf_ExpressionLexer.mll18
-rwxr-xr-xodf/odf_ExpressionParser.mly16
-rwxr-xr-xscTypes.ml21
-rwxr-xr-xtests/dataType_test.ml33
-rwxr-xr-xtests/expressionParser_test.ml6
-rwxr-xr-xtests/expression_test.ml18
-rwxr-xr-xtests/odf/odf_ExpressionParser_test.ml2
-rwxr-xr-xtests/sheet_test.ml4
-rwxr-xr-xtests/tools_test.ml117
-rwxr-xr-xtools.ml46
21 files changed, 384 insertions, 408 deletions
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 <string * Num.num> REAL
-%token <string * Num.num> NUM
+%token <string> REAL
+%token <string> NUM
%token <string> STR
%token <string> 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 <string * Num.num> REAL
-%token <string * Num.num> NUM
+%token <string> REAL
+%token <string> NUM
%token <string> STR
%token <string> 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 *)
generated by cgit v1.2.3 (git 2.39.1) at 2024-12-25 06:15:18 +0000