diff options
| -rwxr-xr-x | dataType.ml | 34 | ||||
| -rwxr-xr-x | evaluator.ml | 4 | ||||
| -rwxr-xr-x | expression.ml | 2 | ||||
| -rwxr-xr-x | scTypes.ml | 21 | ||||
| -rwxr-xr-x | scTypes.mli | 2 | ||||
| -rwxr-xr-x | tests/dataType_test.ml | 22 |
6 files changed, 71 insertions, 14 deletions
diff --git a/dataType.ml b/dataType.ml index b6c4fd0..8e5ead0 100755 --- a/dataType.ml +++ b/dataType.ml @@ -33,7 +33,10 @@ module Num = struct let mult = Q.mul
- let floor f = Q.of_bigint (Q.to_bigint f)
+ let floor t =
+ let num = Q.num t
+ and den = Q.den t in
+ Q.of_bigint @@ Z.fdiv num den
let ge = Q.geq
@@ -41,12 +44,29 @@ module Num = struct 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
+ let is_integer t = (Q.den t) == Z.one
+
+ let pow t q_factor = begin
+
+ if is_integer q_factor then
+
+ let factor = Q.to_int q_factor
+ and num = Q.num t
+ and den = Q.den t in
+
+ Q.make (Z.pow num factor) (Z.pow den factor)
- Q.make (Z.pow num factor) (Z.pow den factor)
+ else
+
+ let factor = Q.to_float q_factor
+ and num = Z.to_float @@ Q.num t
+ and den = Z.to_float @@ Q.den t in
+
+ Q.div
+ (Q.of_float (num ** factor))
+ (Q.of_float (den ** factor))
+
+ end
let gcd t1 t2 =
Q.of_bigint @@ Z.gcd (Q.to_bigint t1) (Q.to_bigint t2)
@@ -54,8 +74,6 @@ module Num = struct 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
module Bool = struct
diff --git a/evaluator.ml b/evaluator.ml index 64d260e..0681183 100755 --- a/evaluator.ml +++ b/evaluator.ml @@ -330,11 +330,13 @@ let () = begin 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 "^" (t_int, t_int) f_number D.Num.pow;
+ register2 "power" (t_int, t_int) f_number D.Num.pow;
+
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;
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;
diff --git a/expression.ml b/expression.ml index fd697a9..20227ad 100755 --- a/expression.ml +++ b/expression.ml @@ -91,7 +91,7 @@ let show e = | Formula (Expression f) ->
UTF8.Buffer.add_char buffer '=';
ScTypes.show_expr buffer f
- | Basic b -> ScTypes.Type.show buffer b
+ | Basic b -> ScTypes.Type.show_full buffer b
| Formula (Error (i,s)) -> UTF8.Buffer.add_string buffer s
| Undefined -> ()
end;
@@ -127,7 +127,7 @@ module Type = struct show_list printer buffer tl end - and show: type a. UTF8.Buffer.buffer -> a types -> unit = fun buffer -> begin function + let show: type a. UTF8.Buffer.buffer -> a types -> unit = fun buffer -> begin function | Str x -> UTF8.Buffer.add_string buffer x | Bool b -> UTF8.Printf.bprintf buffer "%B" b | Num (Number, n) -> @@ -146,6 +146,25 @@ module Type = struct UTF8.Printf.bprintf buffer "%d/%d/%d" y m d end + let show_full: type a. UTF8.Buffer.buffer -> a types -> unit = fun buffer -> begin function + | Str x -> UTF8.Buffer.add_string buffer x + | Bool b -> UTF8.Printf.bprintf buffer "%B" b + | Num (Number, 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 f = DataType.Num.to_float n + and to_b = UTF8.Format.formatter_of_buffer buffer in + ignore @@ UTF8.Format.fprintf to_b "%f" f; + Format.pp_print_flush to_b () + | Num (Date, n) -> + let y, m, d = DataType.Date.date_from_julian_day n in + UTF8.Printf.bprintf buffer "%d/%d/%d" y m d + end + type t = | Value: 'a dataFormat * 'a -> t diff --git a/scTypes.mli b/scTypes.mli index d147d92..348f4fe 100755 --- a/scTypes.mli +++ b/scTypes.mli @@ -81,6 +81,8 @@ module Type : sig val show: UTF8.Buffer.buffer -> 'a types -> unit
+ val show_full: UTF8.Buffer.buffer -> 'a types -> unit
+
end
module Refs : sig
diff --git a/tests/dataType_test.ml b/tests/dataType_test.ml index ddb45ae..f015e89 100755 --- a/tests/dataType_test.ml +++ b/tests/dataType_test.ml @@ -22,12 +22,28 @@ let test_num_sub n1 n2 result ctx = begin (N.to_int @@ N.sub n1 n2)
end
+let test_floor n1 expected ctx = begin
+
+ let result = N.to_int @@ N.floor n1 in
+
+ assert_equal
+ ~msg:(Printf.sprintf "Expected %d but got %d" expected result)
+ ~cmp:(=)
+ expected
+ result
+
+end
+
+
+
let n1 = N.of_int 1
let n2 = N.of_int 2
let num_tests = "num_test">::: [
- "test_add" >:: test_num_add n1 n1 2;
- "test_mult" >:: test_num_mult n2 n1 2;
- "test_sub" >:: test_num_sub n1 n1 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;
+ "test_floor1" >:: test_floor (N.of_float 1.2) 1;
+ "test_floor2" >:: test_floor (N.of_float (-1.2)) (-2);
]
|