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
|
(* camlp5r *)
(* fstream.ml,v *)
(* Copyright (c) INRIA 2007-2017 *)
exception Cut;
type mlazy_c 'a =
[ Lfun of unit -> 'a
| Lval of 'a ]
;
type mlazy 'a =
[ Cval of 'a
| Clazy of ref (mlazy_c 'a) ]
;
value mlazy f = Clazy (ref (Lfun f));
value mlazy_force l =
match l with
[ Cval v -> v
| Clazy l ->
match l.val with
[ Lfun f -> do { let x = f () in l.val := Lval x; x }
| Lval v -> v ] ]
;
value mlazy_is_val l =
match l with
[ Cval _ -> True
| Clazy l ->
match l.val with
[ Lval _ -> True
| Lfun _ -> False ] ]
;
type t 'a = { count : int; data : mlazy (data 'a) }
and data 'a =
[ Nil
| Cons of 'a and t 'a
| App of t 'a and t 'a ]
;
value from f =
loop 0 where rec loop i =
{count = 0;
data =
mlazy
(fun () ->
match f i with
[ Some x -> Cons x (loop (i + 1))
| None -> Nil ])}
;
value rec next s =
let count = s.count + 1 in
match mlazy_force s.data with
[ Nil -> None
| Cons a s -> Some (a, {count = count; data = s.data})
| App s1 s2 ->
match next s1 with
[ Some (a, s1) ->
Some (a, {count = count; data = mlazy (fun () -> App s1 s2)})
| None ->
match next s2 with
[ Some (a, s2) -> Some (a, {count = count; data = s2.data})
| None -> None ] ] ]
;
value empty s =
match next s with
[ Some _ -> None
| None -> Some ((), s) ]
;
value nil = {count = 0; data = Cval Nil};
value cons a s = Cons a s;
value app s1 s2 = App s1 s2;
value flazy f = {count = 0; data = mlazy f};
value of_list l =
List.fold_right (fun x s -> flazy (fun () -> cons x s)) l nil
;
value of_string s =
from (fun c -> if c < String.length s then Some s.[c] else None)
;
value of_channel ic =
from (fun _ -> try Some (input_char ic) with [ End_of_file -> None ])
;
value iter f =
do_rec where rec do_rec strm =
match next strm with
[ Some (a, strm) ->
let _ = f a in
do_rec strm
| None -> () ]
;
value count s = s.count;
value count_unfrozen s =
loop 0 s where rec loop cnt s =
if mlazy_is_val s.data then
match mlazy_force s.data with
[ Cons _ s -> loop (cnt + 1) s
| _ -> cnt ]
else cnt
;
(* backtracking parsers *)
type kont 'a 'b = [ K of unit -> option ('b * t 'a * kont 'a 'b) ];
type bp 'a 'b = t 'a -> option ('b * t 'a * kont 'a 'b);
value bcontinue = fun [ (K k) -> k () ];
value bparse_all p strm =
loop (fun () -> p strm) where rec loop p =
match p () with
[ Some (r, _, K k) -> [r :: loop k]
| None -> [] ]
;
value b_seq a b strm =
let rec app_a kont1 () =
match kont1 () with
[ Some (x, strm, K kont1) -> app_b (fun () -> b x strm) kont1 ()
| None -> None ]
and app_b kont2 kont1 () =
match kont2 () with
[ Some (y, strm, K kont2) -> Some (y, strm, K (app_b kont2 kont1))
| None -> app_a kont1 () ]
in
app_a (fun () -> a strm) ()
;
value b_or a b strm =
loop (fun () -> a strm) () where rec loop kont () =
match kont () with
[ Some (x, strm, K kont) -> Some (x, strm, K (loop kont))
| None -> b strm ]
;
value b_term f strm =
match next strm with
[ Some (x, strm) ->
match f x with
[ Some y -> Some (y, strm, K (fun _ -> None))
| None -> None ]
| None -> None ]
;
value b_act a strm = Some (a, strm, K (fun _ -> None));
|
