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