mirror of
https://github.com/c-cube/ocaml-containers.git
synced 2025-12-06 03:05:28 -05:00
add CCFormat into core/
This commit is contained in:
Simon Cruanes
parent
5e9c071947
commit
3d9a7a0b74
5 changed files with 219 additions and 3 deletions
2
_oasis
2
_oasis
|
|
@ -49,7 +49,7 @@ Library "containers"
|
|||
Path: src/core
|
||||
Modules: CCVector, CCPrint, CCError, CCHeap, CCList, CCOpt, CCPair,
|
||||
CCFun, CCHash, CCInt, CCBool, CCFloat, CCArray,
|
||||
CCOrd, CCRandom, CCString, CCHashtbl, CCMap
|
||||
CCOrd, CCRandom, CCString, CCHashtbl, CCMap, CCFormat
|
||||
BuildDepends: bytes
|
||||
|
||||
Library "containers_io"
|
||||
|
|
|
|||
|
|
@ -28,6 +28,7 @@ CCBool
|
|||
CCError
|
||||
CCFloat
|
||||
CCFun
|
||||
CCFormat
|
||||
CCHash
|
||||
CCHashtbl
|
||||
CCHeap
|
||||
|
|
|
|||
142
src/core/CCFormat.ml
Normal file
142
src/core/CCFormat.ml
Normal file
|
|
@ -0,0 +1,142 @@
|
|||
|
||||
(*
|
||||
copyright (c) 2013, simon cruanes
|
||||
all rights reserved.
|
||||
|
||||
redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions are met:
|
||||
|
||||
redistributions of source code must retain the above copyright notice, this
|
||||
list of conditions and the following disclaimer. redistributions in binary
|
||||
form must reproduce the above copyright notice, this list of conditions and the
|
||||
following disclaimer in the documentation and/or other materials provided with
|
||||
the distribution.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
|
||||
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
|
||||
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*)
|
||||
|
||||
(** {1 Helpers for Format} *)
|
||||
|
||||
type 'a sequence = ('a -> unit) -> unit
|
||||
|
||||
type t = Format.formatter
|
||||
type 'a printer = t -> 'a -> unit
|
||||
|
||||
(** {2 Combinators} *)
|
||||
|
||||
let silent _fmt _ = ()
|
||||
|
||||
let unit fmt () = Format.pp_print_string fmt "()"
|
||||
let int fmt i = Format.pp_print_string fmt (string_of_int i)
|
||||
let string fmt s = Format.pp_print_string fmt s
|
||||
let bool fmt b = Format.fprintf fmt "%B" b
|
||||
let float3 fmt f = Format.fprintf fmt "%.3f" f
|
||||
let float fmt f = Format.pp_print_string fmt (string_of_float f)
|
||||
|
||||
let list ?(start="[") ?(stop="]") ?(sep=", ") pp fmt l =
|
||||
let rec pp_list l = match l with
|
||||
| x::((_::_) as l) ->
|
||||
pp fmt x;
|
||||
Format.pp_print_string fmt sep;
|
||||
Format.pp_print_cut fmt ();
|
||||
pp_list l
|
||||
| x::[] -> pp fmt x
|
||||
| [] -> ()
|
||||
in
|
||||
Format.pp_print_string fmt start;
|
||||
pp_list l;
|
||||
Format.pp_print_string fmt stop
|
||||
|
||||
let array ?(start="[") ?(stop="]") ?(sep=", ") pp fmt a =
|
||||
Format.pp_print_string fmt start;
|
||||
for i = 0 to Array.length a - 1 do
|
||||
if i > 0 then (
|
||||
Format.pp_print_string fmt sep;
|
||||
Format.pp_print_cut fmt ();
|
||||
);
|
||||
pp fmt a.(i)
|
||||
done;
|
||||
Format.pp_print_string fmt stop
|
||||
|
||||
let arrayi ?(start="[") ?(stop="]") ?(sep=", ") pp fmt a =
|
||||
Format.pp_print_string fmt start;
|
||||
for i = 0 to Array.length a - 1 do
|
||||
if i > 0 then (
|
||||
Format.pp_print_string fmt sep;
|
||||
Format.pp_print_cut fmt ();
|
||||
);
|
||||
pp fmt (i, a.(i))
|
||||
done;
|
||||
Format.pp_print_string fmt stop
|
||||
|
||||
let seq ?(start="[") ?(stop="]") ?(sep=", ") pp fmt seq =
|
||||
Format.pp_print_string fmt start;
|
||||
let first = ref true in
|
||||
seq (fun x ->
|
||||
(if !first then first := false else Format.pp_print_string fmt sep);
|
||||
pp fmt x);
|
||||
Format.pp_print_string fmt stop
|
||||
|
||||
let opt pp fmt x = match x with
|
||||
| None -> Format.pp_print_string fmt "none"
|
||||
| Some x -> Format.fprintf fmt "some %a" pp x
|
||||
|
||||
let pair ppa ppb fmt (a, b) =
|
||||
Format.fprintf fmt "(%a, %a)" ppa a ppb b
|
||||
|
||||
let triple ppa ppb ppc fmt (a, b, c) =
|
||||
Format.fprintf fmt "(%a, %a, %a)" ppa a ppb b ppc c
|
||||
|
||||
let quad ppa ppb ppc ppd fmt (a, b, c, d) =
|
||||
Format.fprintf fmt "(%a, %a, %a, %a)" ppa a ppb b ppc c ppd d
|
||||
|
||||
let map f pp fmt x =
|
||||
pp fmt (f x);
|
||||
()
|
||||
|
||||
(** {2 IO} *)
|
||||
|
||||
let output fmt pp x = pp fmt x
|
||||
|
||||
let to_string pp x =
|
||||
let buf = Buffer.create 64 in
|
||||
let fmt = Format.formatter_of_buffer buf in
|
||||
pp fmt x;
|
||||
Format.pp_print_flush fmt ();
|
||||
Buffer.contents buf
|
||||
|
||||
let sprintf format =
|
||||
let buf = Buffer.create 64 in
|
||||
let fmt = Format.formatter_of_buffer buf in
|
||||
Format.kfprintf
|
||||
(fun _fmt -> Format.pp_print_flush fmt (); Buffer.contents buf)
|
||||
fmt
|
||||
format
|
||||
|
||||
let stdout = Format.std_formatter
|
||||
let stderr = Format.err_formatter
|
||||
|
||||
let _with_file_out filename f =
|
||||
let oc = open_out filename in
|
||||
let fmt = Format.formatter_of_out_channel oc in
|
||||
begin try
|
||||
let x = f fmt in
|
||||
Format.pp_print_flush fmt ();
|
||||
x
|
||||
with e ->
|
||||
Format.pp_print_flush fmt ();
|
||||
close_out_noerr oc;
|
||||
raise e
|
||||
end
|
||||
|
||||
let to_file filename format =
|
||||
_with_file_out filename (fun fmt -> Format.fprintf fmt format)
|
||||
73
src/core/CCFormat.mli
Normal file
73
src/core/CCFormat.mli
Normal file
|
|
@ -0,0 +1,73 @@
|
|||
|
||||
(*
|
||||
copyright (c) 2013, simon cruanes
|
||||
all rights reserved.
|
||||
|
||||
redistribution and use in source and binary forms, with or without
|
||||
modification, are permitted provided that the following conditions are met:
|
||||
|
||||
redistributions of source code must retain the above copyright notice, this
|
||||
list of conditions and the following disclaimer. redistributions in binary
|
||||
form must reproduce the above copyright notice, this list of conditions and the
|
||||
following disclaimer in the documentation and/or other materials provided with
|
||||
the distribution.
|
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
|
||||
ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
|
||||
WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
|
||||
DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
|
||||
FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
|
||||
DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
|
||||
SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
|
||||
CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
|
||||
OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
|
||||
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
|
||||
*)
|
||||
|
||||
(** {1 Helpers for Format}
|
||||
|
||||
@since NEXT_RELEASE *)
|
||||
|
||||
type 'a sequence = ('a -> unit) -> unit
|
||||
|
||||
type t = Format.formatter
|
||||
type 'a printer = t -> 'a -> unit
|
||||
|
||||
(** {2 Combinators} *)
|
||||
|
||||
val silent : 'a printer (** prints nothing *)
|
||||
|
||||
val unit : unit printer
|
||||
val int : int printer
|
||||
val string : string printer
|
||||
val bool : bool printer
|
||||
val float3 : float printer (* 3 digits after . *)
|
||||
val float : float printer
|
||||
|
||||
val list : ?start:string -> ?stop:string -> ?sep:string -> 'a printer -> 'a list printer
|
||||
val array : ?start:string -> ?stop:string -> ?sep:string -> 'a printer -> 'a array printer
|
||||
val arrayi : ?start:string -> ?stop:string -> ?sep:string ->
|
||||
(int * 'a) printer -> 'a array printer
|
||||
val seq : ?start:string -> ?stop:string -> ?sep:string -> 'a printer -> 'a sequence printer
|
||||
|
||||
val opt : 'a printer -> 'a option printer
|
||||
|
||||
val pair : 'a printer -> 'b printer -> ('a * 'b) printer
|
||||
val triple : 'a printer -> 'b printer -> 'c printer -> ('a * 'b * 'c) printer
|
||||
val quad : 'a printer -> 'b printer -> 'c printer -> 'd printer -> ('a * 'b * 'c * 'd) printer
|
||||
|
||||
val map : ('a -> 'b) -> 'b printer -> 'a printer
|
||||
|
||||
(** {2 IO} *)
|
||||
|
||||
val output : t -> 'a printer -> 'a -> unit
|
||||
val to_string : 'a printer -> 'a -> string
|
||||
|
||||
val stdout : t
|
||||
val stderr : t
|
||||
|
||||
val sprintf : ('a, t, unit, string) format4 -> 'a
|
||||
(** print into a string *)
|
||||
|
||||
val to_file : string -> ('a, t, unit, unit) format4 -> 'a
|
||||
(** Print to the given file *)
|
||||
Loading…
Add table
Reference in a new issue