package fmlib

  1. Overview
  2. Docs

Source file buffer.ml

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
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
open Fmlib_std
open Interfaces


module Make
        (State: ANY)
        (Token: ANY)
        (Expect: ANY)
        (Semantic: ANY)
=
struct
    module Error = Error.Make (Expect) (Semantic)

    type _end =
        | No_end
        | End_received
        | End_consumed


    type t = {
        state:
            State.t;

        has_consumed:
            (* Are there consumed token? *)
            bool;

        error: Error.t;

        la_ptr:
            (* Pointer to the first lookahead token in the buffer. *)
            int;

        is_buffering:
            (* Are we in buffering mode? I.e. are we within a backtrackable
               parser? *)
            bool;
        toks:
            (* Buffered token. The token from [la_ptr] to the end are lookahead
               token. *)
            Token.t array;

        _end:
            (* Buffered end of token stream. The end of token stream can only be
               consumed once. Once in the state [End_consumed] there is no way
               back. *)
            _end;
      }


    let init (st: State.t): t =
      {state =
           st;
       has_consumed =
           false;
       error =
           Error.init;
       la_ptr =
           0;
       is_buffering =
           false;
       toks =
           [||];
       _end =
           No_end}


    let state (b: t): State.t =
      b.state


    let error (b: t): Error.t =
      b.error


    let count_toks (b: t): int =
        (* Number of token in the buffer. *)
        Array.length b.toks


    let has_end (b: t): bool =
        match b._end with
        | No_end ->
            false
        | _ ->
            true

    let has_lookahead (b: t): bool =
        (* Are there lookahead token in the buffer? *)
        b.la_ptr < count_toks b || b._end = End_received


    let lookaheads (b: t): Token.t array =
        (* An array consisting only of the lookahead token in the buffer. *)
        let len = count_toks b - b.la_ptr
        in
        Array.sub b.toks b.la_ptr len


    let first_lookahead (b: t): Token.t option =
        (* The first lookahead token. *)
        assert (has_lookahead b);
        if b.la_ptr < count_toks b then
            Some b.toks.(b.la_ptr)
        else
            None


    let push_token (t: Token.t) (b: t): t =
        (* Push a new lookahead token to the buffer. *)
        if b.is_buffering || has_lookahead b then
            (* In buffering mode or if they are lookahead token, the new token
               is pushed to the buffer. *)
            {b with
             toks =
                 Array.push t b.toks}

        else
            (* Not in buffering mode an no lookaheads. We can forget all token
               in the buffer. *)
            {b with
             la_ptr =
                 0;
             toks =
                 [|t|]}


    let push_end (b: t): t =
        assert (not (has_end b));
        {b with _end = End_received}



    let update (f: State.t -> State.t) (b: t): t =
        (* Update the state. *)
        {b with state = f b.state}


    let add_expected (e: Expect.t) (b: t): t =
        {b with error = Error.add_expected e b.error}


    let put_error (e: Semantic.t) (b: t): t =
        {b with error = Error.make_semantic e}


    let clear_errors  (b: t): t =
        {b with error = Error.init}

    let clear_last_error (b: t): t =
        {b with error = Error.clear_last b.error}


    let consume (state: State.t) (b: t): t =
        (* Consume the first lookahead token. *)
        assert (has_lookahead b);
        if b.la_ptr < count_toks b then
            {b with
             state;
             has_consumed = true;
             error = Error.init;
             la_ptr = 1 + b.la_ptr}

        else if b._end = End_received then
            {b with
             state;
             has_consumed = true;
             error = Error.init;
             _end  = End_consumed}

        else
            assert false (* Cannot happen. *)



    let reject (e: Expect.t) (b: t): t =
        (* Reject the first lookahead token.

           The token are unchanged. The failed expectation [e{ is added to the
           syntax errors.
        *)
        add_expected e b


    let start_new_consumer (b: t): t =
      {b with has_consumed = false}


    let has_consumed (b: t): bool =
      b.has_consumed

    let end_new_consumer (b0: t) (b: t): t =
        {b with
            has_consumed =
                b0.has_consumed || b.has_consumed;

            state =
                if b.has_consumed then
                    b.state
                else
                    b0.state
        }


    let start_alternatives (b: t): t =
        {b with has_consumed = false}


    let end_failed_alternatives (e: Expect.t) (b0: t) (b: t): t =
      if b.has_consumed then
          b
      else
          {b with
           has_consumed =
               b0.has_consumed;
           error =
               Error.add_expected e b0.error}


    let end_succeeded_alternatives (b0: t) (b: t): t =
        if b.has_consumed then
            b
        else
            {b with
             has_consumed =
                 b0.has_consumed;
             error =
                 b0.error}


    let start_backtrack (b: t): t =
        (* Start backtracking i.e. set the buffer into buffering mode.

           Token have to be buffered from now on. In case of failure we treat
           the consumed token as lookahead token.
        *)
        {b with is_buffering = true}


    let end_backtrack_success (b0: t) (b: t): t =
        (* The current backtrackable parser has succeeded. *)
        if b0.is_buffering then
            (* The current backtrackable parser is nested within another
               backtrackable parser. Therefore no change to the buffer. *)
            b

        else
            (* The current backtrackable parser is not nested within another
               backtrackable parser. We end buffering and forget all consumed
               token. The lookahead token remain in the buffer. *)
            {b with
             is_buffering =
                 false;
             toks =
                 lookaheads b; (* only lookahead token *)
             la_ptr =
                 0}


    let end_backtrack_fail (e: Expect.t option) (b0: t) (b: t): t =
        (* The current backtrackable parser has failed.

           Reestablish the buffer at the start of the backtrackable parser and
           treat the consumed token as lookahead token (i.e. unconsume them).
        *)
        assert (count_toks b0 <= count_toks b);
        {b0 with
         toks =
             b.toks;
         error =
             match e with
             | None ->
                 b0.error
             | Some e ->
                 Error.add_expected e b0.error}
end
OCaml

Innovation. Community. Security.