Source

spotlib / lib / base.ml

type ('a, 'b) result = [ `Ok of 'a | `Error of 'b ]

let failwithf fmt = Printf.kprintf failwith fmt
let invalid_argf fmt = Printf.kprintf invalid_arg fmt

let memoize f =
  let cache = Hashtbl.create 101 in
  fun v -> try Hashtbl.find cache v with Not_found ->
    let r = f v in
    Hashtbl.replace cache v r;
    r

let (&.) f g = fun x -> f (g x)
let (^.) f g = fun x -> f (g x)
let (@@) f g = fun x -> f (g x)
external (&) : ('a -> 'b) -> 'a -> 'b = "%apply"
external (&~) : (f:'a -> 'b) -> 'a -> 'b = "%apply"
external (|!) : 'a -> ('a -> 'b) -> 'b = "%revapply"
external (|>) : 'a -> ('a -> 'b) -> 'b =  "%revapply"

external id : 'a -> 'a = "%identity"
external (!&) : _ -> unit = "%ignore"

exception Finally of exn * exn
;;

let protect ~f v ~(finally : 'a -> unit) =
  let res =
    try f v
    with exn ->
      (try finally v with final_exn -> raise (Finally (exn, final_exn)));
      raise exn
  in
  finally v;
  res
;;

let catch ~f v = try `Ok (f v) with e -> `Error e;;

let try_ignore ~f v = try f v with _ -> ();;
let try_bool ~f v = try ignore (f v); true with _ -> false

let time f v =
  let start = Unix.gettimeofday () in
  let res = f v in
  let end_ = Unix.gettimeofday () in
  res, end_ -. start

let imp init f =
  let r = ref init in
  let res = f r in
  !r, res

let imp_ init f = fst (imp init f)
 
(* Printf *)
let sprintf = Printf.sprintf

let with_ref r v f =
  let back_v = !r in
  r := v;
  protect ~f () ~finally:(fun () -> r := back_v)