ocamlformatHEADmaster

1 files changed, 132 insertions, 144 deletions

diff --git a/src/functions.ml b/src/functions.ml
index 491d968..87cff58 100644
--- a/src/functions.ml
+++ b/src/functions.ml
@@ -19,59 +19,52 @@ module D = DataType
 module T = Tools

 

 type _ typ =

-  | Unit: unit typ

-  | Bool: D.Bool.t typ

-  | Num: D.Num.t typ

-  | String: UTF8.t typ

-  | List: 'a typ -> 'a list typ

+  | Unit : unit typ

+  | Bool : D.Bool.t typ

+  | Num : D.Num.t typ

+  | String : UTF8.t typ

+  | List : 'a typ -> 'a list typ

 

 let t_unit = Unit

-let t_bool: DataType.Bool.t typ = Bool

-let t_int:  DataType.Num.t  typ = Num

-let t_string: UTF8.t typ = String

-let t_list (t: 'a typ): 'a list typ = List t

+let t_bool : DataType.Bool.t typ = Bool

+let t_int : DataType.Num.t typ = Num

+let t_string : UTF8.t typ = String

+let t_list (t : 'a typ) : 'a list typ = List t

 

-let typ_of_format: type a. a ScTypes.DataFormat.t -> a typ = function

+let typ_of_format : type a. a ScTypes.DataFormat.t -> a typ = function

   | ScTypes.DataFormat.Date -> Num

   | ScTypes.DataFormat.Number -> Num

   | ScTypes.DataFormat.String -> String

   | ScTypes.DataFormat.Bool -> Bool

 

-

-let rec repr:

-type a. Format.formatter -> a typ -> unit =

-fun printer typ -> match typ with

-  | Unit ->   Format.fprintf printer "Unit"

-  | Bool ->   Format.fprintf printer "Bool"

-  | Num  ->   Format.fprintf printer "Num"

+let rec repr : type a. Format.formatter -> a typ -> unit =

+ fun printer typ ->

+  match typ with

+  | Unit -> Format.fprintf printer "Unit"

+  | Bool -> Format.fprintf printer "Bool"

+  | Num -> Format.fprintf printer "Num"

   | String -> Format.fprintf printer "String"

-  | List t -> Format.fprintf printer "List[%a]"

-      (repr[@tailcall]) t

-

-module C = Catalog.Make(struct

+  | List t -> Format.fprintf printer "List[%a]" (repr [@tailcall]) t

 

+module C = Catalog.Make (struct

   let repr = repr

 

-  let rec compare_typ: type a b. a typ -> b typ -> (a, b) T.cmp =

-  begin fun a b ->

-    match a, b with

-    | Unit, Unit     -> T.Eq

-    | Bool, Bool     -> T.Eq

-    | Num, Num       -> T.Eq

+  let rec compare_typ : type a b. a typ -> b typ -> (a, b) T.cmp =

+   fun a b ->

+    match (a, b) with

+    | Unit, Unit -> T.Eq

+    | Bool, Bool -> T.Eq

+    | Num, Num -> T.Eq

     | String, String -> T.Eq

-    | List l1, List l2 ->

-        begin match compare_typ l1 l2 with

+    | List l1, List l2 -> (

+        match compare_typ l1 l2 with

         | T.Lt -> T.Lt

         | T.Eq -> T.Eq

-        | T.Gt -> T.Gt

-        end

-    | x, y -> if (T.Ex x) > (T.Ex y) then T.Gt else T.Lt

-  end

+        | T.Gt -> T.Gt)

+    | x, y -> if T.Ex x > T.Ex y then T.Gt else T.Lt

 

   type 'a t = 'a typ

-

   type 'a returnType = 'a ScTypes.ReturnType.t

-

 end)

 

 let f_num = ScTypes.ReturnType.f_num

@@ -80,131 +73,126 @@ let f_number = ScTypes.ReturnType.f_number
 let f_string = ScTypes.ReturnType.f_string

 let f_bool = ScTypes.ReturnType.f_bool

 

-module Make_Compare(Comp: D.COMPARABLE) = struct

-

-  let register t catalog  = begin catalog

-    |> C.register2 "="  (t, t) f_bool Comp.eq

+module Make_Compare (Comp : D.COMPARABLE) = struct

+  let register t catalog =

+    catalog

+    |> C.register2 "=" (t, t) f_bool Comp.eq

     |> C.register2 "<>" (t, t) f_bool Comp.neq

-    |> C.register2 ">"  (t, t) f_bool Comp.gt

+    |> C.register2 ">" (t, t) f_bool Comp.gt

     |> C.register2 ">=" (t, t) f_bool Comp.ge

-    |> C.register2 "<"  (t, t) f_bool Comp.lt

+    |> C.register2 "<" (t, t) f_bool Comp.lt

     |> C.register2 "<=" (t, t) f_bool Comp.le

-  end

-

 end

 

-let built_in catalog = begin

-

-  let module CompareNum = Make_Compare(D.Num) in

-  let module CompareString = Make_Compare(D.String) in

-  let module CompareBool = Make_Compare(D.Bool) in

-

+let built_in catalog =

+  let module CompareNum = Make_Compare (D.Num) in

+  let module CompareString = Make_Compare (D.String) in

+  let module CompareBool = Make_Compare (D.Bool) in

   (* Helper for list functions : reduce over a list of elements *)

-  let reduce name typ res f c = begin

-    C.register1 name (t_list typ) res (fun x ->

-      List.fold_left f (List.hd x) x) c

-  |> C.register1 name (t_list (t_list typ)) res (fun x ->

-      List.fold_left (List.fold_left f) (List.hd (List.hd x)) x);

-  end in

+  let reduce name typ res f c =

+    C.register1 name (t_list typ) res

+      (fun x -> List.fold_left f (List.hd x) x)

+      c

+    |> C.register1 name

+         (t_list (t_list typ))

+         res

+         (fun x -> List.fold_left (List.fold_left f) (List.hd (List.hd x)) x)

+  in

 

   (* Helper for list functions : fold over a list of elements *)

-  let fold name t_in t_out f init c = begin

-    C.register1 name (t_list t_in) t_out (fun x ->

-      List.fold_left f init x) c

-  |> C.register1 name (t_list (t_list t_in)) t_out (fun x ->

-      List.fold_left (List.fold_left f) init x)

-  end in

+  let fold name t_in t_out f init c =

+    C.register1 name (t_list t_in) t_out (fun x -> List.fold_left f init x) c

+    |> C.register1 name

+         (t_list (t_list t_in))

+         t_out

+         (fun x -> List.fold_left (List.fold_left f) init x)

+  in

 

-

-  let if_: type a. bool -> a -> a -> a = fun a b c -> if a then b else c in

+  let if_ : type a. bool -> a -> a -> a = fun a b c -> if a then b else c in

 

   (* Build a date *)

-  C.register3 "date"  (t_int, t_int, t_int) f_date (

-    fun year month day ->

-      D.Date.get_julian_day

-        (D.Num.to_int year)

-        (D.Num.to_int month)

-        (D.Num.to_int day)

-  ) catalog

+  C.register3 "date" (t_int, t_int, t_int) f_date

+    (fun year month day ->

+      D.Date.get_julian_day (D.Num.to_int year) (D.Num.to_int month)

+        (D.Num.to_int day))

+    catalog

   |> CompareNum.register t_int

-

-  |> C.register1 "rand" t_unit       f_number  D.Num.rnd

-

-  |> C.register1 "pi"   t_unit       f_number (fun () -> D.Num.of_float (4. *. atan 1.))

-  |> C.register1 "sin"  t_int        f_number (fun x  -> D.Num.of_float (sin  (D.Num.to_float x)))

-  |> C.register1 "cos"  t_int        f_number (fun x  -> D.Num.of_float (cos  (D.Num.to_float x)))

-  |> C.register1 "tan"  t_int        f_number (fun x  -> D.Num.of_float (tan  (D.Num.to_float x)))

-  |> C.register1 "atan" t_int        f_number (fun x  -> D.Num.of_float (atan (D.Num.to_float x)))

-  |> C.register1 "asin" t_int        f_number (fun x  -> D.Num.of_float (asin (D.Num.to_float x)))

-  |> C.register1 "acos" t_int        f_number (fun x  -> D.Num.of_float (acos (D.Num.to_float x)))

-  |> C.register1 "sinh" t_int        f_number (fun x  -> D.Num.of_float (sinh (D.Num.to_float x)))

-  |> C.register1 "cosh" t_int        f_number (fun x  -> D.Num.of_float (cosh (D.Num.to_float x)))

-  |> C.register1 "tanh" t_int        f_number (fun x  -> D.Num.of_float (tanh (D.Num.to_float x)))

-  |> C.register2 "atan2" (t_int, t_int)f_number (fun x y ->

-    D.Num.of_float (atan2 (D.Num.to_float x) (D.Num.to_float y))

-  )

-

-  |> C.register1 "sqrt" t_int        f_number (fun x  -> D.Num.of_float (sqrt(D.Num.to_float x)))

-  |> C.register1 "exp"  t_int        f_number (fun x  -> D.Num.of_float (exp (D.Num.to_float x)))

-  |> C.register1 "ln"   t_int        f_number (fun x  -> D.Num.of_float (log (D.Num.to_float x)))

-

+  |> C.register1 "rand" t_unit f_number D.Num.rnd

+  |> C.register1 "pi" t_unit f_number (fun () -> D.Num.of_float (4. *. atan 1.))

+  |> C.register1 "sin" t_int f_number (fun x ->

+         D.Num.of_float (sin (D.Num.to_float x)))

+  |> C.register1 "cos" t_int f_number (fun x ->

+         D.Num.of_float (cos (D.Num.to_float x)))

+  |> C.register1 "tan" t_int f_number (fun x ->

+         D.Num.of_float (tan (D.Num.to_float x)))

+  |> C.register1 "atan" t_int f_number (fun x ->

+         D.Num.of_float (atan (D.Num.to_float x)))

+  |> C.register1 "asin" t_int f_number (fun x ->

+         D.Num.of_float (asin (D.Num.to_float x)))

+  |> C.register1 "acos" t_int f_number (fun x ->

+         D.Num.of_float (acos (D.Num.to_float x)))

+  |> C.register1 "sinh" t_int f_number (fun x ->

+         D.Num.of_float (sinh (D.Num.to_float x)))

+  |> C.register1 "cosh" t_int f_number (fun x ->

+         D.Num.of_float (cosh (D.Num.to_float x)))

+  |> C.register1 "tanh" t_int f_number (fun x ->

+         D.Num.of_float (tanh (D.Num.to_float x)))

+  |> C.register2 "atan2" (t_int, t_int) f_number (fun x y ->

+         D.Num.of_float (atan2 (D.Num.to_float x) (D.Num.to_float y)))

+  |> C.register1 "sqrt" t_int f_number (fun x ->

+         D.Num.of_float (sqrt (D.Num.to_float x)))

+  |> C.register1 "exp" t_int f_number (fun x ->

+         D.Num.of_float (exp (D.Num.to_float x)))

+  |> C.register1 "ln" t_int f_number (fun x ->

+         D.Num.of_float (log (D.Num.to_float x)))

   |> C.register3 "if" (t_bool, t_int, t_int) f_number if_

   |> C.register3 "if" (t_bool, t_bool, t_bool) f_bool if_

   |> C.register3 "if" (t_bool, t_string, t_string) f_string if_

-

-  |> C.register1 "abs"   t_int       f_number  D.Num.abs

-  |> C.register1 "int"   t_int       f_number  D.Num.floor

-  |> C.register1 "rounddown" t_int   f_number  D.Num.round_down

-  |> C.register1 "round" t_int       f_number  D.Num.round

-

-  |> C.register1 "trim"  t_string    f_string  UTF8.trim

-  |> C.register1 "right" t_string    f_string  (fun x -> UTF8.get x (-1))

-  |> C.register2 "right" (t_string, t_int) f_string (

-    fun t n ->

-      let n' = D.Num.to_int n in

-      UTF8.sub t (-(n')) n'

-  )

-  |> C.register1 "left"  t_string    f_string  (fun x -> UTF8.get x 0)

-  |> C.register2 "left"  (t_string, t_int) f_string (

-    fun t n ->

-      let n' = D.Num.to_int n in

-      UTF8.sub t 0 n'

-  )

-  |> C.register1 "len"   t_string    f_number  (fun x -> D.Num.of_int (UTF8.length x))

-  |> C.register1 "lenb"  t_string    f_number  (fun x -> D.Num.of_int (String.length (UTF8.to_utf8string x)))

-  |> C.register1 "lower" t_string    f_string  UTF8.lower

-  |> C.register1 "unicode" t_string  f_number (fun x -> D.Num.of_int (UTF8.code x))

-  |> C.register1 "unichar" t_int     f_string (fun x -> UTF8.char (D.Num.to_int x))

-  |> C.register1 "upper" t_string    f_string  UTF8.upper

-  |> C.register3 "substitute" (t_string, t_string, t_string)  f_string  UTF8.replace

-  |> C.register2 "rept"  (t_string, t_int) f_string (fun t n -> UTF8.repeat (D.Num.to_int n) t)

-

+  |> C.register1 "abs" t_int f_number D.Num.abs

+  |> C.register1 "int" t_int f_number D.Num.floor

+  |> C.register1 "rounddown" t_int f_number D.Num.round_down

+  |> C.register1 "round" t_int f_number D.Num.round

+  |> C.register1 "trim" t_string f_string UTF8.trim

+  |> C.register1 "right" t_string f_string (fun x -> UTF8.get x (-1))

+  |> C.register2 "right" (t_string, t_int) f_string (fun t n ->

+         let n' = D.Num.to_int n in

+         UTF8.sub t (-n') n')

+  |> C.register1 "left" t_string f_string (fun x -> UTF8.get x 0)

+  |> C.register2 "left" (t_string, t_int) f_string (fun t n ->

+         let n' = D.Num.to_int n in

+         UTF8.sub t 0 n')

+  |> C.register1 "len" t_string f_number (fun x -> D.Num.of_int (UTF8.length x))

+  |> C.register1 "lenb" t_string f_number (fun x ->

+         D.Num.of_int (String.length (UTF8.to_utf8string x)))

+  |> C.register1 "lower" t_string f_string UTF8.lower

+  |> C.register1 "unicode" t_string f_number (fun x ->

+         D.Num.of_int (UTF8.code x))

+  |> C.register1 "unichar" t_int f_string (fun x -> UTF8.char (D.Num.to_int x))

+  |> C.register1 "upper" t_string f_string UTF8.upper

+  |> C.register3 "substitute"

+       (t_string, t_string, t_string)

+       f_string UTF8.replace

+  |> C.register2 "rept" (t_string, t_int) f_string (fun t n ->

+         UTF8.repeat (D.Num.to_int n) t)

   |> CompareBool.register t_bool

-  |> C.register1 "true"  t_unit            f_bool (fun () -> D.Bool.true_)

-  |> C.register1 "false" t_unit            f_bool (fun () -> D.Bool.false_)

-  |> C.register1 "not"   t_bool            f_bool D.Bool.not

-  |> C.register2 "and"   (t_bool, t_bool)  f_bool D.Bool.and_

-  |> C.register2 "or"    (t_bool, t_bool)  f_bool D.Bool.or_

-  |> C.register2 "xor"   (t_bool, t_bool)  f_bool D.Bool.neq

-

+  |> C.register1 "true" t_unit f_bool (fun () -> D.Bool.true_)

+  |> C.register1 "false" t_unit f_bool (fun () -> D.Bool.false_)

+  |> C.register1 "not" t_bool f_bool D.Bool.not

+  |> C.register2 "and" (t_bool, t_bool) f_bool D.Bool.and_

+  |> C.register2 "or" (t_bool, t_bool) f_bool D.Bool.or_

+  |> C.register2 "xor" (t_bool, t_bool) f_bool D.Bool.neq

   |> CompareString.register t_string

-

   |> reduce "min" t_int f_num D.Num.min (* Minimum value from a list *)

   |> reduce "max" t_int f_num D.Num.max (* Maximum value from a list *)

-

-  |> fold "sum"     t_int f_number D.Num.add  (D.Num.zero)

-  |> fold "product" t_int f_number D.Num.mult (D.Num.one)

-

-  |> C.register2 "^"     (t_int, t_int) f_number  D.Num.pow

-  |> C.register2 "power" (t_int, t_int) f_number  D.Num.pow

-

-  |> C.register2 "gcd"(t_int, t_int) f_number  D.Num.gcd

-  |> C.register2 "lcm"(t_int, t_int) f_number  D.Num.lcm

-  |> C.register1 "+"  t_int          f_num     (fun x -> x)

-  |> C.register1 "-"  t_int          f_num     D.Num.neg    (* Unary negation *)

-  |> C.register2 "+"  (t_int, t_int) f_num     D.Num.add

-  |> C.register2 "-"  (t_int, t_int) f_num     D.Num.sub

-  |> C.register2 "*"  (t_int, t_int) f_number  D.Num.mult

-  |> C.register2 "/"  (t_int, t_int) f_number  D.Num.div

-

-end

+  |> fold "sum" t_int f_number D.Num.add D.Num.zero

+  |> fold "product" t_int f_number D.Num.mult D.Num.one

+  |> C.register2 "^" (t_int, t_int) f_number D.Num.pow

+  |> C.register2 "power" (t_int, t_int) f_number D.Num.pow

+  |> C.register2 "gcd" (t_int, t_int) f_number D.Num.gcd

+  |> C.register2 "lcm" (t_int, t_int) f_number D.Num.lcm

+  |> C.register1 "+" t_int f_num (fun x -> x)

+  |> C.register1 "-" t_int f_num D.Num.neg (* Unary negation *)

+  |> C.register2 "+" (t_int, t_int) f_num D.Num.add

+  |> C.register2 "-" (t_int, t_int) f_num D.Num.sub

+  |> C.register2 "*" (t_int, t_int) f_number D.Num.mult

+  |> C.register2 "/" (t_int, t_int) f_number D.Num.div