blob: 34f0b54385de9e1ed4e6d22d2a2b73242a313bc6 (
plain)
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
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
|
external format_int: string -> int -> string = "format_int"
external format_float: string -> float -> string = "format_float"
let fprintf outchan format =
let format = (Obj.magic format : string) in
let rec doprn i =
if i >= String.length format then
Obj.magic ()
else begin
let c = String.unsafe_get format i in
if c <> '%' then begin
output_char outchan c;
doprn (succ i)
end else begin
let j = skip_args (succ i) in
match String.unsafe_get format j with
'%' ->
output_char outchan '%';
doprn (succ j)
| 's' ->
Obj.magic(fun s ->
if j <= i+1 then
output_string outchan s
else begin
let p =
try
int_of_string (String.sub format (i+1) (j-i-1))
with _ ->
invalid_arg "fprintf: bad %s format" in
if p > 0 & String.length s < p then begin
output_string outchan
(String.make (p - String.length s) ' ');
output_string outchan s
end else if p < 0 & String.length s < -p then begin
output_string outchan s;
output_string outchan
(String.make (-p - String.length s) ' ')
end else
output_string outchan s
end;
doprn (succ j))
| 'c' ->
Obj.magic(fun c ->
output_char outchan c;
doprn (succ j))
| 'd' | 'o' | 'x' | 'X' | 'u' ->
Obj.magic(fun n ->
output_string outchan
(format_int (String.sub format i (j-i+1)) n);
doprn (succ j))
| 'f' | 'e' | 'E' | 'g' | 'G' ->
Obj.magic(fun f ->
output_string outchan
(format_float (String.sub format i (j-i+1)) f);
doprn (succ j))
| 'b' ->
Obj.magic(fun b ->
output_string outchan (string_of_bool b);
doprn (succ j))
| 'a' ->
Obj.magic(fun printer arg ->
printer outchan arg;
doprn(succ j))
| 't' ->
Obj.magic(fun printer ->
printer outchan;
doprn(succ j))
| c ->
invalid_arg ("fprintf: unknown format")
end
end
and skip_args j =
match String.unsafe_get format j with
'0' .. '9' | ' ' | '.' | '-' -> skip_args (succ j)
| c -> j
in doprn 0
let printf fmt = fprintf stdout fmt
and eprintf fmt = fprintf stderr fmt
let sprintf format =
let format = (Obj.magic format : string) in
let res = ref [] in
let rec doprn start i =
if i >= String.length format then begin
if i > start then res := String.sub format start (i-start) :: !res;
Obj.magic(String.concat "" (List.rev !res))
end else
if String.unsafe_get format i <> '%' then
doprn start (i+1)
else begin
if i > start then res := String.sub format start (i-start) :: !res;
let j = skip_args (succ i) in
match String.unsafe_get format j with
'%' ->
doprn j (succ j)
| 's' ->
Obj.magic(fun s ->
if j <= i+1 then
res := s :: !res
else begin
let p =
try
int_of_string (String.sub format (i+1) (j-i-1))
with _ ->
invalid_arg "fprintf: bad %s format" in
if p > 0 & String.length s < p then begin
res := String.make (p - String.length s) ' ' :: !res;
res := s :: !res
end else if p < 0 & String.length s < -p then begin
res := s :: !res;
res := String.make (-p - String.length s) ' ' :: !res
end else
res := s :: !res
end;
doprn (succ j) (succ j))
| 'c' ->
Obj.magic(fun c ->
res := String.make 1 c :: !res;
doprn (succ j) (succ j))
| 'd' | 'o' | 'x' | 'X' | 'u' ->
Obj.magic(fun n ->
res := format_int (String.sub format i (j-i+1)) n :: !res;
doprn (succ j) (succ j))
| 'f' | 'e' | 'E' | 'g' | 'G' ->
Obj.magic(fun f ->
res := format_float (String.sub format i (j-i+1)) f :: !res;
doprn (succ j) (succ j))
| 'b' ->
Obj.magic(fun b ->
res := string_of_bool b :: !res;
doprn (succ j) (succ j))
| 'a' ->
Obj.magic(fun printer arg ->
res := printer () arg :: !res;
doprn (succ j) (succ j))
| 't' ->
Obj.magic(fun printer ->
res := printer () :: !res;
doprn (succ j) (succ j))
| c ->
invalid_arg ("sprintf: unknown format")
end
and skip_args j =
match String.unsafe_get format j with
'0' .. '9' | ' ' | '.' | '-' -> skip_args (succ j)
| c -> j
in doprn 0 0
|
