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
167
168
open! Import
include Parser_intf
module Make (Kind : Kind.S) (Mode : Mode(Kind).S) :
S
with type parsed_value = Mode.parsed_value
with type State.t = (Kind.state, Kind.Stack.t) A.state
with module Stack = Kind.Stack = struct
type parsed_value = Mode.parsed_value
module Stack = Kind.Stack
module State = struct
type t = (Kind.state, Kind.Stack.t) A.state
let create ?pos () = A.new_state ?initial_pos:pos Mode.mode Kind.kind
let reset = A.reset
let offset = A.offset
let line = A.line
let column = A.column
let position t : Positions.pos = { offset = offset t; line = line t; col = column t }
let stop state = A.set_error_state state
end
let feed = A.feed
let feed_eoi state stack = Mode.make_value state (A.feed_eoi state stack)
let feed_substring = Automaton_helpers.feed_substring
let feed_string = Automaton_helpers.feed_string
let feed_subbytes = Automaton_helpers.feed_subbytes
let feed_bytes = Automaton_helpers.feed_bytes
let parse_string_exn str =
let state = State.create () in
feed_eoi state (feed_string state str Kind.Stack.empty)
;;
let parse_string str =
match parse_string_exn str with
| x -> Ok x
| exception Parse_error.Parse_error e -> Error e
;;
end
module Make_eager (Kind : Kind.S) (Mode : Mode_eager(Kind).S) :
S_eager
with type parsed_value = Mode.parsed_value
with type State.t = (Kind.state, Kind.Stack.t) A.state
with module Stack = Kind.Stack = struct
type parsed_value = Mode.parsed_value
module Stack = Kind.Stack
module State = struct
module Read_only = struct
type t = (Kind.state, Kind.Stack.t) A.state
let offset = A.offset
let line = A.line
let column = A.column
let position t : Positions.pos =
{ offset = offset t; line = line t; col = column t }
;;
end
include Read_only
let create ?pos ?(no_sexp_is_error = false) f =
let got_sexp state stack =
let parsed_value = Mode.make_value state stack in
f state parsed_value;
Stack.empty
in
A.new_state ?initial_pos:pos (Eager { got_sexp; no_sexp_is_error }) Kind.kind
;;
let reset = A.reset
let stop t = A.set_error_state t
let old_parser_cont_state t = Parser_automaton.old_parser_cont_state t
end
let feed = A.feed
let feed_eoi state stack = ignore (A.feed_eoi state stack : Stack.t)
let feed_substring = Automaton_helpers.feed_substring
let feed_string = Automaton_helpers.feed_string
let feed_subbytes = Automaton_helpers.feed_subbytes
let feed_bytes = Automaton_helpers.feed_bytes
module Lexbuf_consumer = struct
type t = State.t
exception Got_sexp of parsed_value * Positions.pos
let got_sexp state parsed_value =
raise_notrace (Got_sexp (parsed_value, State.position state))
;;
let create () = State.create got_sexp
let pos_of_lexbuf lexbuf =
let p = lexbuf.Lexing.lex_curr_p in
{ Positions.line = p.pos_lnum; col = p.pos_cnum - p.pos_bol; offset = p.pos_cnum }
;;
let update_lexbuf (lexbuf : Lexing.lexbuf) (pos : Positions.pos) =
let p = pos.offset - lexbuf.lex_abs_pos in
lexbuf.lex_curr_pos <- p;
lexbuf.lex_start_pos <- p;
lexbuf.lex_curr_p
<- { lexbuf.lex_curr_p with
pos_lnum = pos.line
; pos_cnum = pos.offset
; pos_bol = pos.offset - pos.col
}
;;
let rec feed_lexbuf t (lexbuf : Lexing.lexbuf) stack =
let stack =
feed_subbytes
t
lexbuf.lex_buffer
stack
~pos:lexbuf.lex_curr_pos
~len:(lexbuf.lex_buffer_len - lexbuf.lex_curr_pos)
in
lexbuf.lex_curr_pos <- lexbuf.lex_buffer_len;
lexbuf.lex_start_pos <- lexbuf.lex_buffer_len;
if not lexbuf.lex_eof_reached
then (
lexbuf.refill_buff lexbuf;
feed_lexbuf t lexbuf stack)
else feed_eoi t stack
;;
let parse_gen t (lexbuf : Lexing.lexbuf) =
A.reset t ~pos:(pos_of_lexbuf lexbuf);
match feed_lexbuf t lexbuf Stack.empty with
| () ->
update_lexbuf lexbuf (State.position t);
None
| exception Got_sexp (parsed_value, pos) ->
update_lexbuf lexbuf pos;
Some parsed_value
| exception exn ->
update_lexbuf lexbuf (State.position t);
raise exn
;;
let set_no_sexp_is_error t x =
match A.mode t with
| Eager e -> e.no_sexp_is_error <- x
| _ -> assert false
;;
let parse t lexbuf =
set_no_sexp_is_error t true;
match parse_gen t lexbuf with
| Some x -> x
| None -> failwith "Parsexp.parse_gen: None"
;;
let parse_opt t lexbuf =
set_no_sexp_is_error t false;
parse_gen t lexbuf
;;
end
end