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
|
(***********************************************************************)
(* *)
(* Objective Caml *)
(* *)
(* Daniel de Rauglaudre, projet Cristal, INRIA Rocquencourt *)
(* *)
(* Copyright 1996 Institut National de Recherche en Informatique et *)
(* Automatique. Distributed only by permission. *)
(* *)
(***********************************************************************)
(* $Id$ *)
(* The fields of type t are not mutable to preserve polymorphism of
the empty stream. This is type safe because the empty stream is never
patched. *)
type 'a t = {(*mutable*) count : int; (*mutable*) data : 'a data}
and 'a data =
Sempty
| Scons of 'a * 'a data
| Sapp of 'a data * 'a data
| Slazy of (unit -> 'a data)
| Sgen of 'a gen
| Sbuffio of buffio
and 'a gen =
{mutable curr : 'a option option; func : int -> 'a option}
and buffio =
{ic : in_channel; buff : string; mutable len : int; mutable ind : int}
exception Parse_failure
exception Parse_error of string
let count s = s.count
let fill_buff b =
b.len <- input b.ic b.buff 0 (String.length b.buff);
b.ind <- 0
let rec get_data =
function
Sempty -> None
| Scons (a, d) -> Some (a, d)
| Sapp (d1, d2) ->
begin match get_data d1 with
Some (a, d) -> Some (a, Sapp (d, d2))
| None -> get_data d2
end
| Slazy f -> get_data (f ())
| _ -> invalid_arg "illegal stream concatenation"
let rec peek s =
match s.data with
Sempty -> None
| Scons (a, _) -> Some a
| Sapp (d1, d2) ->
begin match get_data d1 with
Some (a, d) ->
Obj.set_field (Obj.repr s) 1 (Obj.repr (Scons (a, Sapp (d, d2))));
Some a
| None ->
Obj.set_field (Obj.repr s) 1 (Obj.repr d2);
peek s
end
| Slazy f ->
begin match f () with
Sgen _ | Sbuffio _ -> invalid_arg "illegal stream concatenation"
| x -> Obj.set_field (Obj.repr s) 1 (Obj.repr x); peek s
end
| Sgen {curr = Some a} -> a
| Sgen g -> let x = g.func s.count in g.curr <- Some x; x
| Sbuffio b ->
if b.ind >= b.len then fill_buff b;
if b.len == 0 then begin
Obj.set_field (Obj.repr s) 1 (Obj.repr Sempty); None
end
else Some (Obj.magic b.buff.[b.ind])
let rec junk s =
match s.data with
Scons (_, s') ->
Obj.set_field (Obj.repr s) 0 (Obj.repr (succ s.count));
Obj.set_field (Obj.repr s) 1 (Obj.repr s')
| Sgen {curr=Some None} -> ()
| Sgen ({curr=Some _} as g) ->
Obj.set_field (Obj.repr s) 0 (Obj.repr (succ s.count)); g.curr <- None
| Sbuffio b ->
Obj.set_field (Obj.repr s) 0 (Obj.repr (succ s.count));
b.ind <- succ b.ind
| _ -> match peek s with None -> () | Some _ -> junk s
let next s =
match peek s with
Some a -> junk s; a
| None -> raise Parse_failure
let empty s =
match peek s with
Some _ -> raise Parse_failure
| None -> ()
let iter f strm =
let rec do_rec () =
match peek strm with
Some a -> junk strm; f a; do_rec ()
| None -> ()
in
do_rec ()
(* Stream building functions *)
let from f = {count = 0; data = Sgen {curr = None; func = f}}
let of_list l =
{count = 0; data = List.fold_right (fun x l -> Scons (x, l)) l Sempty}
let of_string s =
from (fun c -> if c < String.length s then Some s.[c] else None)
let of_channel ic =
{count = 0;
data = Sbuffio {ic = ic; buff = String.create 4096; len = 0; ind = 0}}
(* Stream expressions builders *)
let sempty = {count = 0; data = Sempty}
let scons f s = {count = 0; data = Slazy (fun _ -> Scons (f (), s.data))}
let sapp f s =
match s.data with
Sempty -> {count = 0; data = Slazy (fun _ -> (f ()).data)}
| d -> {count = 0; data = Slazy (fun _-> Sapp ((f ()).data, d))}
(* For debugging use *)
let rec dump f s =
print_string "{count = "; print_int s.count; print_string "; data = ";
dump_data f s.data; print_string "}"; print_newline ()
and dump_data f =
function
Sempty -> print_string "Sempty"
| Scons (a, d) ->
print_string "Scons ("; f a; print_string ", "; dump_data f d;
print_string ")"
| Sapp (d1, d2) ->
print_string "Sapp ("; dump_data f d1; print_string ", ";
dump_data f d2; print_string ")"
| Slazy f -> print_string "Slazy"
| Sgen _ -> print_string "Sgen"
| Sbuffio b -> print_string "Sbuffio"
|
