aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rwxr-xr-xdataType.ml34
-rwxr-xr-xevaluator.ml4
-rwxr-xr-xexpression.ml2
-rwxr-xr-xscTypes.ml21
-rwxr-xr-xscTypes.mli2
-rwxr-xr-xtests/dataType_test.ml22
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;
diff --git a/scTypes.ml b/scTypes.ml
index 075f25d..48e4d3c 100755
--- a/scTypes.ml
+++ b/scTypes.ml
@@ -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);
]