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/tools.ml | 223 +++++++++++++++++++++-------------------------------------- 1 file changed, 80 insertions(+), 143 deletions(-) (limited to 'src/tools.ml') diff --git a/src/tools.ml b/src/tools.ml index c9d78a7..88feade 100644 --- a/src/tools.ml +++ b/src/tools.ml @@ -18,213 +18,150 @@ along with licht. If not, see . let u = UTF8.from_utf8string module Option = struct - - let map f = function - | Some x -> Some (f x) - | None -> None - - let iter f = function - | Some x -> f x - | None -> () - - let bind f = function - | None -> None - | Some x -> f x - - let default v = function - | None -> v - | Some x -> x - - let test f v = begin - match f v with - | Some x -> x - | None -> v - end - - + let map f = function Some x -> Some (f x) | None -> None + let iter f = function Some x -> f x | None -> () + let bind f = function None -> None | Some x -> f x + let default v = function None -> v | Some x -> x + let test f v = match f v with Some x -> x | None -> v end module String = struct - include String - let split str ~by:sep = begin + let split str ~by:sep = let p = String.index str sep in let slen = String.length str in - String.sub str 0 p, String.sub str (p + 1) (slen - p - 1) - end + (String.sub str 0 p, String.sub str (p + 1) (slen - p - 1)) - let string_of_ints v = begin + let string_of_ints v = let buff = Buffer.create 1 in - let rec convert value = begin - Buffer.add_char buff @@ char_of_int @@ value land 0xFF; + let rec convert value = + Buffer.add_char buff @@ char_of_int @@ (value land 0xFF); let rem = value lsr 8 in - match rem with - | 0 -> Buffer.contents buff - | x -> (convert[@tailcall]) x - end in + match rem with 0 -> Buffer.contents buff | x -> (convert [@tailcall]) x + in let res = convert v in let buff' = Buffer.create @@ String.length res in - for i = ((String.length res) - 1) downto 0 do + for i = String.length res - 1 downto 0 do Buffer.add_char buff' @@ String.get res i done; Buffer.contents buff' - end - let print_buffer f t = begin + let print_buffer f t = let buff = UTF8.Buffer.create 16 in f buff t; UTF8.Buffer.contents buff - end - let filter_float str = begin + let filter_float str = let l = String.length str in - if l > 0 && String.get str (l - 1) = '.' then - String.sub str 0 (l - 1) - else - str - end - + if l > 0 && String.get str (l - 1) = '.' then String.sub str 0 (l - 1) + else str end module List = struct - (** fold_left over only the first element *) - let fst f init = function - | hd::tl -> f init hd - | [] -> init - - let printb ?(first=(u"(")) ?(last=(u")")) ?(sep=(u",")) f buffer elems = begin - - let rec print = begin function - | [] -> () - | hd::[] -> - f buffer hd; - | hd::tl -> - f buffer hd; - UTF8.Buffer.add_string buffer sep; - (print[@tailcall]) tl - end in + let fst f init = function hd :: tl -> f init hd | [] -> init + + let printb ?(first = u "(") ?(last = u ")") ?(sep = u ",") f buffer elems = + let rec print = function + | [] -> () + | [ hd ] -> f buffer hd + | hd :: tl -> + f buffer hd; + UTF8.Buffer.add_string buffer sep; + (print [@tailcall]) tl + in UTF8.Buffer.add_string buffer first; print elems; UTF8.Buffer.add_string buffer last - end - - let rec find_map f = begin function - | [] -> raise Not_found - | hd::tl -> begin match f hd with - | Some x -> x - | None -> (find_map[@tailcall]) f tl - end - end - - and find_map2 p = begin function - | [] -> raise Not_found - | x::l -> - begin try find_map p x with - Not_found -> (find_map2[@tailcall]) p l - end - end + let rec find_map f = function + | [] -> raise Not_found + | hd :: tl -> ( + match f hd with Some x -> x | None -> (find_map [@tailcall]) f tl) + + and find_map2 p = function + | [] -> raise Not_found + | x :: l -> ( + try find_map p x with Not_found -> (find_map2 [@tailcall]) p l) end module Tuple2 = struct - - let fst = Pervasives.fst - - let snd = Pervasives.snd - + let fst = Stdlib.fst + let snd = Stdlib.snd let map1 f (a, b) = (f a, b) - let map2 f (a, b) = (a, f b) - let replace1 v (a, b) = (v, b) - let replace2 v (a, b) = (a, v) - let printb ?(first="(") ?(last=")") ?(sep=",") format1 format2 out (a, b) = begin - UTF8.Printf.bprintf out "%s%a%s%a%s" - first - format1 a - sep - format2 b - last - end - + let printb ?(first = "(") ?(last = ")") ?(sep = ",") format1 format2 out (a, b) + = + UTF8.Printf.bprintf out "%s%a%s%a%s" first format1 a sep format2 b last end module NCurses = struct - type mouse_event = - | BUTTON1_PRESSED - | BUTTON1_RELEASED - | BUTTON1_CLICKED - | BUTTON1_DOUBLE_CLICKED - | BUTTON1_TRIPLE_CLICKED - | BUTTON2_PRESSED - | BUTTON2_RELEASED - | BUTTON2_CLICKED - | BUTTON2_DOUBLE_CLICKED - | BUTTON2_TRIPLE_CLICKED - | BUTTON3_PRESSED - | BUTTON3_RELEASED - | BUTTON3_CLICKED - | BUTTON3_DOUBLE_CLICKED - | BUTTON3_TRIPLE_CLICKED - | BUTTON4_PRESSED - | BUTTON4_RELEASED - | BUTTON4_CLICKED - | BUTTON4_DOUBLE_CLICKED - | BUTTON4_TRIPLE_CLICKED - | BUTTON_SHIFT - | BUTTON_CTRL - | BUTTON_ALT - | ALL_MOUSE_EVENTS - | REPORT_MOUSE_POSITION + | BUTTON1_PRESSED + | BUTTON1_RELEASED + | BUTTON1_CLICKED + | BUTTON1_DOUBLE_CLICKED + | BUTTON1_TRIPLE_CLICKED + | BUTTON2_PRESSED + | BUTTON2_RELEASED + | BUTTON2_CLICKED + | BUTTON2_DOUBLE_CLICKED + | BUTTON2_TRIPLE_CLICKED + | BUTTON3_PRESSED + | BUTTON3_RELEASED + | BUTTON3_CLICKED + | BUTTON3_DOUBLE_CLICKED + | BUTTON3_TRIPLE_CLICKED + | BUTTON4_PRESSED + | BUTTON4_RELEASED + | BUTTON4_CLICKED + | BUTTON4_DOUBLE_CLICKED + | BUTTON4_TRIPLE_CLICKED + | BUTTON_SHIFT + | BUTTON_CTRL + | BUTTON_ALT + | ALL_MOUSE_EVENTS + | REPORT_MOUSE_POSITION type event_type - external set_mouse_event: mouse_event list -> unit = "c_set_mouse_event" - - external get_mouse_event: unit -> (int * event_type * (int * int * int)) option = "c_get_mouse_event" + external set_mouse_event : mouse_event list -> unit = "c_set_mouse_event" - external is_event_of_type: mouse_event -> event_type -> bool = "c_is_event_of_type" + external get_mouse_event : + unit -> (int * event_type * (int * int * int)) option = "c_get_mouse_event" + external is_event_of_type : mouse_event -> event_type -> bool + = "c_is_event_of_type" end let try_finally f except = - try let res = f () in + try + let res = f () in except (); res with e -> except (); raise e -type (_,_) cmp = - | Eq : ('a,'a) cmp - | Lt : ('a,'b) cmp - | Gt : ('a,'b) cmp +type (_, _) cmp = Eq : ('a, 'a) cmp | Lt : ('a, 'b) cmp | Gt : ('a, 'b) cmp (** Existencial type for comparing two types. This type has no utility, except for structural comparison between two values. *) -type existencial = Ex: 'a -> existencial +type existencial = Ex : 'a -> existencial module type COMPARABLE_TYPE = sig + type 'a t - type 'a t - - val comp: 'a t -> 'b t -> ('a, 'b) cmp - + val comp : 'a t -> 'b t -> ('a, 'b) cmp end let fold_for f a b init = - let rec _fold res i = begin - if i >= b then res - else - _fold (f i res) (i + 1) - end in - (_fold[@tailcall]) init a - + let rec _fold res i = if i >= b then res else _fold (f i res) (i + 1) in + (_fold [@tailcall]) init a -- cgit v1.2.3