From ef312564ca84a2b49fc291434d8fb2f8501bb618 Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@chimrod.com>
Date: Tue, 15 Nov 2016 13:00:01 +0100
Subject: Initial commit

---
 functions.ml | 114 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 114 insertions(+)
 create mode 100755 functions.ml

(limited to 'functions.ml')

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
+  );
-- 
cgit v1.2.3