Source file prelude.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
(** Useful shortcuts *)

module U = ExtUnix.Specific
module Enum = ExtEnum

let ($) f g = fun x -> f (g x)
let ($$) f g = fun x y -> f (g x) (g y)
let (!!) = Lazy.force

module F1 = struct
  let (@@) f g = fun x -> f @@ g @@ x
  let (|>) f g = fun x -> x |> f |> g
end

external id : 'a -> 'a = "%identity"
external identity : 'a -> 'a = "%identity"
let flip f x y = f y x
let some x = Some x
let const x = fun () -> x

let apply2 f = fun (x,y) -> f x, f y

let printfn fmt = Printf.ksprintf print_endline fmt
let eprintfn fmt = Printf.ksprintf prerr_endline fmt

let curry f a b = f (a, b)
let uncurry f (a,b) = f a b

module Fresh(T : sig type t val compare : t -> t -> int end)() =
struct
  type t = T.t
  let inject = id
  let project = id
  let inject_list = id
  let project_list = id
  let compare = T.compare
  let equal a b = T.compare a b = 0
  let map f x = inject @@ f @@ project x
  let map2 f x y = inject @@ f (project x) (project y)
end

let (+=) a b = a := !a + b
let (-=) a b = a := !a - b
let tuck l x = l := x :: !l
let cons l x = x :: l

let round f =
  let bot = floor f in
  if f -. bot < 0.5 then bot else bot +. 1.

let atoi name v = try int_of_string v with _ -> Exn.fail "%s %S not integer" name v

let call_me_maybe f x =
  match f with
  | None -> ()
  | Some f -> f x

(*
  If libev backend is available, do nothing (lwt uses it as default).
  Otherwise, prefer poll over select, because select can only monitor fds up to 1024,
  and poll is guaranteed to be available without the fd limitation.
*)
let () =
  match Lwt_engine.id () with
  | Lwt_engine.Engine_id__libev _ -> ()
  | Lwt_engine.Engine_id__select ->
    (* prefer poll over select, because select can only monitor fds up to 1024,
       and poll is guaranteed to be available without the fd limitation. *)
    Lwt_engine.set @@ new Lwt_engines.poll
  | Lwt_engine.Engine_id__poll -> ()
  | _ ->
      (* unknown engine*)
      ()