aboutsummaryrefslogtreecommitdiff
path: root/functions.ml
diff options
context:
space:
mode:
Diffstat (limited to 'functions.ml')
-rwxr-xr-xfunctions.ml114
1 files changed, 114 insertions, 0 deletions
diff --git a/functions.ml b/functions.ml
new file mode 100755
index 0000000..2014d2e
--- /dev/null
+++ b/functions.ml
@@ -0,0 +1,114 @@
+open Catalog
+
+let u = UTF8.from_utf8string
+
+let eq = u"="
+let neq = u"<>"
+let lt = u"<"
+let le = u"<="
+let gt = u">"
+let ge = u">="
+
+let add = u"+"
+let mul = u"*"
+let pow = u"^"
+let div = u"/"
+let sub = u"-"
+
+let sum = u"sum"
+
+let () =
+
+ (** Comparaison *)
+ let compare = function
+ | ScTypes.Num (n1,_)::ScTypes.Num (n2,_)::[] -> Num.compare_num n1 n2
+ | ScTypes.Date n1::ScTypes.Date n2::[] -> Num.compare_num n1 n2
+ | ScTypes.Str s1::ScTypes.Str s2::[] -> UTF8.compare s1 s2
+ | ScTypes.Bool b1::ScTypes.Bool b2::[] -> Pervasives.compare b1 b2
+ | ScTypes.List l1::ScTypes.List l2::[] -> Pervasives.compare l1 l2
+ | t1::t2::[] -> Pervasives.compare t1 t2
+ | _ -> raise ScTypes.Error
+ in
+ register eq (fun args -> ScTypes.Bool ((compare args) = 0));
+ register neq (fun args -> ScTypes.Bool ((compare args) != 0));
+ register lt (fun args -> ScTypes.Bool ((compare args) < 0));
+ register le (fun args -> ScTypes.Bool ((compare args) <= 0));
+ register gt (fun args -> ScTypes.Bool ((compare args) > 0));
+ register ge (fun args -> ScTypes.Bool ((compare args) >= 0));
+
+ (** Basic *)
+
+ register sum (fun args ->
+
+ let rec sum value = function
+ | ScTypes.Undefined -> value
+ | ScTypes.Num (n,_) -> Num.add_num value n
+ | ScTypes.Date n -> Num.add_num value n
+ | ScTypes.List l -> List.fold_left sum value l
+ | _ -> raise ScTypes.Error in
+
+ ScTypes.Num (List.fold_left sum (Num.num_of_int 0) args, None)
+ );
+
+ let rec operation f = begin function
+ | ScTypes.Undefined , x -> operation f (ScTypes.Num (Num.num_of_int 0, None), x)
+ | x, ScTypes.Undefined -> operation f (x, ScTypes.Num (Num.num_of_int 0, None))
+ | ScTypes.Num (n1,_), ScTypes.Num (n2,_) -> ScTypes.Num (f n1 n2, None)
+ | ScTypes.Date n1, ScTypes.Date n2 -> ScTypes.Date (f n1 n2)
+ | ScTypes.Date n1, ScTypes.Num (n2,_) -> ScTypes.Date (f n1 n2)
+ | ScTypes.Num (n1,_), ScTypes.Date n2 -> ScTypes.Date (f n1 n2)
+ | _ -> raise ScTypes.Error
+ end
+ in
+
+ register add (function
+ | t1::t2::[] -> (operation Num.add_num) (t1, t2)
+ | _ -> raise ScTypes.Error
+ );
+
+ register mul (function
+ | t1::t2::[] -> (operation Num.mult_num) (t1, t2)
+ | _ -> raise ScTypes.Error
+ );
+
+ register div (function
+ | t1::t2::[] -> (operation Num.div_num) (t1, t2)
+ | _ -> raise ScTypes.Error
+ );
+
+ register sub (function
+ | t1::t2::[] -> (operation Num.sub_num) (t1, t2)
+ | _ -> raise ScTypes.Error
+ );
+
+ register pow (function
+ | t1::t2::[] -> (operation Num.power_num) (t1, t2)
+ | _ -> raise ScTypes.Error
+ );
+
+ (** Binary *)
+
+ register (u"true") (function
+ | [] -> ScTypes.Bool true
+ | _ -> raise ScTypes.Error
+ );
+
+ register (u"false") (function
+ | [] -> ScTypes.Bool false
+ | _ -> raise ScTypes.Error
+ );
+
+ register (u"not") (function
+ | (ScTypes.Bool x):: [] -> ScTypes.Bool (not x)
+ | _ -> raise ScTypes.Error
+ );
+
+ register (u"date") (function
+ | (ScTypes.Num (x,_)):: [] -> ScTypes.Date x
+ | _ -> raise ScTypes.Error
+ );
+
+ register (u"num") (function
+ | (ScTypes.Date x):: [] -> ScTypes.Num (x, None)
+ | _ -> raise ScTypes.Error
+ );