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
153
154
155
156
157
158
159
160
161
162
163
164
let string_at
(needs_more: 'a -> bool)
(put: char -> 'a -> 'a)
(put_end: 'a -> 'a)
(start: int)
(str: string)
(p: 'a)
: int * 'a
=
let len = String.length str
in
assert (start <= len + 1);
let rec run i p =
if i > len || not (needs_more p) then
i, p
else if i < len then
run (i + 1) (put str.[i] p)
else
run (i + 1) (put_end p)
in
run start p
let string
(needs_more: 'a -> bool)
(put: char -> 'a -> 'a)
(put_end: 'a -> 'a)
(str: string)
(p: 'a)
: 'a
=
string_at needs_more put put_end 0 str p |> snd
let channel
(needs_more: 'a -> bool)
(put: char -> 'a -> 'a)
(put_end: 'a -> 'a)
(ic: in_channel)
(p: 'a)
: 'a
=
let rec run p =
if not (needs_more p) then
p
else
try
run (put (input_char ic) p)
with End_of_file ->
put_end p
in
run p
module Make (CD: Interfaces.CHAR_DECODER) =
struct
let string_at
(needs_more: 'a -> bool)
(put: CD.t -> 'a -> 'a)
(put_end: 'a -> 'a)
(start: int)
(str: string)
(p: 'a)
: int * 'a
=
let len = String.length str
in
assert (start <= len + 1);
let rec run i d p =
if i > len || not (needs_more p) then
i, p
else if i < len then
let d =
CD.put str.[i] d
in
if CD.(is_complete d || has_error d) then
run (i + 1) CD.init (put d p)
else
run (i + 1) d p
else begin
if CD.(is_complete d || has_error d) then
i + 1, put_end p
else
i + 1, put_end (put d p)
end
in
run start CD.init p
let string
(needs_more: 'a -> bool)
(put: CD.t -> 'a -> 'a)
(put_end: 'a -> 'a)
(str: string)
(p: 'a)
: 'a
=
string_at needs_more put put_end 0 str p |> snd
let channel
(needs_more: 'a -> bool)
(put: CD.t -> 'a -> 'a)
(put_end: 'a -> 'a)
(ic: in_channel)
(p: 'a)
: 'a
=
let rec run d p =
if not (needs_more p) then
p
else
try
let c = input_char ic in
let d = CD.put c d
in
if CD.(is_complete d || has_error d) then
run CD.init (put d p)
else
run d p
with End_of_file ->
if CD.(is_complete d || has_error d) then
put_end p
else
put_end (put d p)
in
run CD.init p
end