-
Notifications
You must be signed in to change notification settings - Fork 106
/
batPrint.ml
114 lines (98 loc) · 3.64 KB
/
batPrint.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
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
(*
* Print - Functional unparsing
* Copyright (C) 2009 Jeremie Dimino
*
* This library is free software; you can redistribute it and/or
* modify it under the terms of the GNU Lesser General Public
* License as published by the Free Software Foundation; either
* version 2.1 of the License, or (at your option) any later version,
* with the special exception on linking described in file LICENSE.
*
* This library is distributed in the hope that it will be useful,
* but WITHOUT ANY WARRANTY; without even the implied warranty of
* MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
* Lesser General Public License for more details.
*
* You should have received a copy of the GNU Lesser General Public
* License along with this library; if not, write to the Free Software
* Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
*)
type ('a, 'b) directive = ((unit BatInnerIO.output -> unit) -> 'b) -> 'a
type pattern = string
type ('a, 'b) format = {
pattern : pattern;
printer : pattern -> ('a, 'b) directive;
}
(* Parse an integer followed by a [')'] in [pattern] *)
let parse_key pattern i =
let rec aux acc i =
if i = String.length pattern then
invalid_arg "Batteries.Print.format"
else
match pattern.[i] with
| ')' ->
(acc, i + 1)
| '0' .. '9' as ch ->
aux (acc * 10 + (Char.code ch - Char.code '0')) (i + 1)
| _ ->
invalid_arg "Batteries.Print.format"
in
if i + 1 >= String.length pattern then
invalid_arg "Batteries.Print.format"
else
match pattern.[i] with
| '0' .. '9' as ch ->
aux (Char.code ch - Char.code '0') (i + 1)
| _ ->
invalid_arg "Batteries.Print.format"
let format oc pattern directives =
let rec aux i =
if i = String.length pattern then
()
else
match pattern.[i] with
| '%' ->
if i + 1 >= String.length pattern then
invalid_arg "Batteries.Print.format"
else begin
match pattern.[i + 1] with
| '(' ->
let key, i = parse_key pattern (i + 2) in
if key < 0 || key > Array.length directives then
invalid_arg "Batteries.Print.format"
else begin
directives.(key) oc;
aux i
end
| '%' ->
BatInnerIO.write oc '%';
aux (i + 2)
| '!' ->
BatInnerIO.flush oc;
aux (i + 2)
| _ ->
invalid_arg "Batteries.Print.format"
end
| ch ->
BatInnerIO.write oc ch;
aux (i + 1)
in
aux 0
let literal str k = k (fun oc -> BatInnerIO.nwrite oc str)
let kfprintf k oc fmt = fmt.printer fmt.pattern (fun f -> f (BatIO.cast_output oc); k oc)
let fprintf oc fmt = fmt.printer fmt.pattern (fun f -> f (BatIO.cast_output oc))
let ifprintf _ fmt = fprintf BatInnerIO.stdnull fmt
let printf fmt = fprintf BatInnerIO.stdout fmt
let eprintf fmt = fprintf BatInnerIO.stderr fmt
let bprintf buf fmt = fprintf (BatInnerIO.output_buffer buf) fmt
let kbprintf k buf fmt = kfprintf (fun _ -> k buf) (BatInnerIO.output_buffer buf) fmt
let sprintf fmt =
let oc = BatInnerIO.output_buffer (Buffer.create 42) in
kfprintf BatInnerIO.close_out oc fmt
let ksprintf k fmt =
let oc = BatInnerIO.output_buffer (Buffer.create 42) in
kfprintf (fun oc -> k (BatInnerIO.close_out oc)) oc fmt
let rprintf fmt =
ksprintf BatRope.of_string fmt
let krprintf k fmt =
ksprintf (fun s -> k (BatRope.of_string s)) fmt