From 023c11470e32744a43b7e3c7c248f3c47ebdc687 Mon Sep 17 00:00:00 2001
From: Sébastien Dailly <sebastien@chimrod.com>
Date: Mon, 21 Nov 2016 17:06:19 +0100
Subject: Use gadt for function catalog

---
 dataType.ml | 133 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 133 insertions(+)
 create mode 100755 dataType.ml

(limited to 'dataType.ml')

diff --git a/dataType.ml b/dataType.ml
new file mode 100755
index 0000000..3937465
--- /dev/null
+++ b/dataType.ml
@@ -0,0 +1,133 @@
+module type COMPARABLE = sig
+  type t
+  val eq: t -> t -> bool
+  val neq: t -> t -> bool
+  val lt: t -> t -> bool
+  val le: t -> t -> bool
+  val gt: t -> t -> bool
+  val ge: t -> t -> bool
+end
+
+module Comparable = struct
+
+  let eq = (=)
+  let neq = (<>)
+  let lt = (<)
+  let le = (<=)
+  let gt = (>)
+  let ge = (>=)
+
+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)
+
+end
+
+module Bool = struct
+
+  type t = bool
+  include Comparable
+
+  let true_ = true
+  let false_ = false
+
+  let or_ = (||)
+  let and_ = (&&)
+  let not = Pervasives.not
+
+end
+
+module String = struct
+
+  type t = UTF8.t
+  include Comparable
+
+end
-- 
cgit v1.2.3