diff --git a/_oasis b/_oasis index 17827688..3fdc7b15 100644 --- a/_oasis +++ b/_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" diff --git a/doc/intro.txt b/doc/intro.txt index bc686872..570c36a9 100644 --- a/doc/intro.txt +++ b/doc/intro.txt @@ -28,6 +28,7 @@ CCBool CCError CCFloat CCFun +CCFormat CCHash CCHashtbl CCHeap diff --git a/src/core/CCFormat.ml b/src/core/CCFormat.ml new file mode 100644 index 00000000..5bff0275 --- /dev/null +++ b/src/core/CCFormat.ml @@ -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) diff --git a/src/core/CCFormat.mli b/src/core/CCFormat.mli new file mode 100644 index 00000000..d8c06657 --- /dev/null +++ b/src/core/CCFormat.mli @@ -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 *) diff --git a/src/core/CCPrint.ml b/src/core/CCPrint.ml index 8ccde136..4b936a7e 100644 --- a/src/core/CCPrint.ml +++ b/src/core/CCPrint.ml @@ -59,7 +59,7 @@ let list ?(start="[") ?(stop="]") ?(sep=", ") pp buf l = Buffer.add_string buf start; pp_list l; Buffer.add_string buf stop - + let array ?(start="[") ?(stop="]") ?(sep=", ") pp buf a = Buffer.add_string buf start; for i = 0 to Array.length a - 1 do @@ -67,7 +67,7 @@ let array ?(start="[") ?(stop="]") ?(sep=", ") pp buf a = pp buf a.(i) done; Buffer.add_string buf stop - + let arrayi ?(start="[") ?(stop="]") ?(sep=", ") pp buf a = Buffer.add_string buf start; for i = 0 to Array.length a - 1 do