From 30075b876185002fd661b0af505727ab6fb38199 Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Thu, 6 Jan 2022 09:20:08 +0100 Subject: ocamlformat --- src/functions.ml | 276 ++++++++++++++++++++++++++----------------------------- 1 file changed, 132 insertions(+), 144 deletions(-) (limited to 'src/functions.ml') 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 -- cgit v1.2.3