2019-05-13 00:46:25 +04:00
|
|
|
open Format
|
2019-10-09 18:07:13 +04:00
|
|
|
|
2019-05-13 00:46:25 +04:00
|
|
|
let string : formatter -> string -> unit = fun ppf s -> fprintf ppf "%s" s
|
2019-10-09 18:07:13 +04:00
|
|
|
|
2019-05-13 00:46:25 +04:00
|
|
|
let tag tag : formatter -> unit -> unit = fun ppf () -> fprintf ppf tag
|
2019-10-09 18:07:13 +04:00
|
|
|
|
2019-05-13 00:46:25 +04:00
|
|
|
let bool ppf b = fprintf ppf "%b" b
|
2019-10-09 18:07:13 +04:00
|
|
|
|
2019-05-13 00:46:25 +04:00
|
|
|
let pair f g ppf (a , b) = fprintf ppf "%a , %a" f a g b
|
2019-10-09 18:07:13 +04:00
|
|
|
|
2019-05-13 00:46:25 +04:00
|
|
|
let new_line : formatter -> unit -> unit = tag "@;"
|
2019-10-09 18:07:13 +04:00
|
|
|
|
2019-05-13 00:46:25 +04:00
|
|
|
let rec new_lines n ppf () =
|
|
|
|
match n with
|
|
|
|
| 0 -> new_line ppf ()
|
|
|
|
| n -> new_line ppf () ; new_lines (n-1) ppf ()
|
2019-10-09 18:07:13 +04:00
|
|
|
|
2019-05-13 00:46:25 +04:00
|
|
|
let const const : formatter -> unit -> unit = fun ppf () -> fprintf ppf "%s" const
|
2019-10-09 18:07:13 +04:00
|
|
|
|
2019-05-13 00:46:25 +04:00
|
|
|
let comment : formatter -> string -> unit = fun ppf s -> fprintf ppf "(* %s *)" s
|
2019-10-09 18:07:13 +04:00
|
|
|
|
2019-05-13 00:46:25 +04:00
|
|
|
let list_sep value separator = pp_print_list ~pp_sep:separator value
|
2019-10-09 18:07:13 +04:00
|
|
|
|
2019-05-13 00:46:25 +04:00
|
|
|
let list value = pp_print_list ~pp_sep:(tag "") value
|
2019-10-09 18:07:13 +04:00
|
|
|
|
2019-05-13 00:46:25 +04:00
|
|
|
let ne_list_sep value separator ppf (hd, tl) =
|
|
|
|
value ppf hd ;
|
|
|
|
separator ppf () ;
|
|
|
|
pp_print_list ~pp_sep:separator value ppf tl
|
|
|
|
|
|
|
|
let prepend s f ppf a =
|
|
|
|
fprintf ppf "%s%a" s f a
|
|
|
|
|
|
|
|
let option = fun f ppf opt ->
|
|
|
|
match opt with
|
|
|
|
| Some x -> fprintf ppf "Some(%a)" f x
|
|
|
|
| None -> fprintf ppf "None"
|
|
|
|
|
|
|
|
let lr = fun ppf lr ->
|
|
|
|
match lr with
|
|
|
|
| `Left -> fprintf ppf "left"
|
|
|
|
| `Right -> fprintf ppf "right"
|
|
|
|
|
|
|
|
let int = fun ppf n -> fprintf ppf "%d" n
|
|
|
|
|
|
|
|
let map = fun f pp ppf x ->
|
|
|
|
pp ppf (f x)
|
|
|
|
|
2019-10-09 18:07:13 +04:00
|
|
|
let pair_sep value sep ppf (a, b) =
|
|
|
|
fprintf ppf "%a %s %a" value a sep value b
|
|
|
|
|
2019-05-13 00:46:25 +04:00
|
|
|
let smap_sep value sep ppf m =
|
|
|
|
let module SMap = X_map.String in
|
|
|
|
let lst = SMap.to_kv_list m in
|
|
|
|
let new_pp ppf (k, v) = fprintf ppf "%s -> %a" k value v in
|
|
|
|
fprintf ppf "%a" (list_sep new_pp sep) lst
|