OCaml parser combinator that compiles to direct recursive descent
add skip_many, skip_some, take_while, take_while1 combinators
author
vm.fail
date
(Jan 16, 2026, 10:06 PM UTC)
commit
d6752811
d675281183d7a307dc09778b0188b212388718e0
parent
81c9c703
81c9c70347ca90bc76cd6fc5b906897b5c2eec4c
vm.fail
date
(Jan 16, 2026, 10:06 PM UTC)
commit
d6752811
d675281183d7a307dc09778b0188b212388718e0
parent
81c9c703
81c9c70347ca90bc76cd6fc5b906897b5c2eec4c
+137
+9
src/check.ml
+9
src/check.ml
···
27
27
| NotFollowedBy _ -> true
28
28
| Many _ -> true
29
29
| Some_ { p; _ } -> nullable p
30
+
| SkipMany _ -> true
31
+
| SkipSome { p; _ } -> nullable p
32
+
| TakeWhile { at_least_one; _ } -> not at_least_one
30
33
| Optional _ -> true
31
34
| Option _ -> true
32
35
| SepBy _ -> true
···
80
83
| Label { p; _ } -> check path p
81
84
| Many { p; _ } -> check path p
82
85
| Some_ { p; _ } -> check path p
86
+
| SkipMany { p; _ } -> check path p
87
+
| SkipSome { p; _ } -> check path p
88
+
| TakeWhile _ -> None
83
89
| Optional { p; _ } -> check path p
84
90
| Option { p; _ } -> check path p
85
91
| SepBy { p; _ } -> check path p
···
133
139
| NotFollowedBy { p; _ } -> check_expr env p
134
140
| Many { p; _ } -> check_expr env p
135
141
| Some_ { p; _ } -> check_expr env p
142
+
| SkipMany { p; _ } -> check_expr env p
143
+
| SkipSome { p; _ } -> check_expr env p
144
+
| TakeWhile _ -> []
136
145
| Optional { p; _ } -> check_expr env p
137
146
| Option { p; _ } -> check_expr env p
138
147
| SepBy { p; sep; _ } -> check_expr env p @ check_expr env sep
+105
src/codegen.ml
+105
src/codegen.ml
···
266
266
loop [x] inp
267
267
| Error e -> Error e])
268
268
269
+
| SkipMany { p; loc } ->
270
+
(match p with
271
+
| Token { tok; _ } ->
272
+
[%expr
273
+
let rec loop input =
274
+
match I.peek input with
275
+
| Some t when t = [%e tok] -> loop (I.advance input)
276
+
| _ -> Ok ((), input)
277
+
in
278
+
loop input]
279
+
| Satisfy { pred; _ } ->
280
+
[%expr
281
+
let rec loop input =
282
+
match I.peek input with
283
+
| Some t when [%e pred] t -> loop (I.advance input)
284
+
| _ -> Ok ((), input)
285
+
in
286
+
loop input]
287
+
| Any _ ->
288
+
[%expr
289
+
let rec loop input =
290
+
match I.peek input with
291
+
| Some _ -> loop (I.advance input)
292
+
| None -> Ok ((), input)
293
+
in
294
+
loop input]
295
+
| _ ->
296
+
let p_code = compile ~loc env p in
297
+
[%expr
298
+
let rec loop input =
299
+
match [%e p_code] with
300
+
| Ok (_, inp) -> loop inp
301
+
| Error _ -> Ok ((), input)
302
+
in
303
+
loop input])
304
+
305
+
| SkipSome { p; loc } ->
306
+
(match p with
307
+
| Token { tok; _ } ->
308
+
[%expr
309
+
match I.peek input with
310
+
| Some t when t = [%e tok] ->
311
+
let rec loop input =
312
+
match I.peek input with
313
+
| Some t when t = [%e tok] -> loop (I.advance input)
314
+
| _ -> Ok ((), input)
315
+
in
316
+
loop (I.advance input)
317
+
| _ -> [%e error_expr ~loc [%expr [I.show_token [%e tok]]]]]
318
+
| Satisfy { pred; label; _ } ->
319
+
let expected = match label with
320
+
| Some l -> elist ~loc [estring ~loc l]
321
+
| None -> [%expr ["<satisfy>"]]
322
+
in
323
+
[%expr
324
+
match I.peek input with
325
+
| Some t when [%e pred] t ->
326
+
let rec loop input =
327
+
match I.peek input with
328
+
| Some t when [%e pred] t -> loop (I.advance input)
329
+
| _ -> Ok ((), input)
330
+
in
331
+
loop (I.advance input)
332
+
| _ -> [%e error_expr ~loc expected]]
333
+
| _ ->
334
+
let p_code = compile ~loc env p in
335
+
[%expr
336
+
match [%e p_code] with
337
+
| Ok (_, inp) ->
338
+
let rec loop input =
339
+
match [%e p_code] with
340
+
| Ok (_, inp2) -> loop inp2
341
+
| Error _ -> Ok ((), input)
342
+
in
343
+
loop inp
344
+
| Error e -> Error e])
345
+
346
+
| TakeWhile { pred; at_least_one; loc } ->
347
+
if at_least_one then
348
+
[%expr
349
+
match I.peek input with
350
+
| Some t when [%e pred] t ->
351
+
let buf = Buffer.create 16 in
352
+
let rec loop input =
353
+
match I.peek input with
354
+
| Some t when [%e pred] t ->
355
+
Buffer.add_char buf t;
356
+
loop (I.advance input)
357
+
| _ -> Ok (Buffer.contents buf, input)
358
+
in
359
+
Buffer.add_char buf t;
360
+
loop (I.advance input)
361
+
| _ -> [%e error_expr ~loc [%expr ["<take_while1>"]]]]
362
+
else
363
+
[%expr
364
+
let buf = Buffer.create 16 in
365
+
let rec loop input =
366
+
match I.peek input with
367
+
| Some t when [%e pred] t ->
368
+
Buffer.add_char buf t;
369
+
loop (I.advance input)
370
+
| _ -> Ok (Buffer.contents buf, input)
371
+
in
372
+
loop input]
373
+
269
374
| Optional { p; loc } ->
270
375
let p_code = compile ~loc env p in
271
376
[%expr
+4
src/first_set.ml
+4
src/first_set.ml
···
55
55
| NotFollowedBy _ -> epsilon
56
56
| Many _ -> epsilon
57
57
| Some_ { p; _ } -> compute env p
58
+
| SkipMany _ -> epsilon
59
+
| SkipSome { p; _ } -> compute env p
60
+
| TakeWhile { at_least_one = false; _ } -> epsilon
61
+
| TakeWhile { pred; at_least_one = true; _ } -> of_predicate pred
58
62
| Optional { p; _ } -> { (compute env p) with nullable = true }
59
63
| Option { p; _ } -> { (compute env p) with nullable = true }
60
64
| SepBy _ -> epsilon
+6
src/ir.ml
+6
src/ir.ml
···
22
22
| NotFollowedBy of { loc : loc; p : expr }
23
23
| Many of { loc : loc; p : expr }
24
24
| Some_ of { loc : loc; p : expr }
25
+
| SkipMany of { loc : loc; p : expr }
26
+
| SkipSome of { loc : loc; p : expr }
27
+
| TakeWhile of { loc : loc; pred : Ppxlib.expression; at_least_one : bool }
25
28
| Optional of { loc : loc; p : expr }
26
29
| Option of { loc : loc; default : Ppxlib.expression; p : expr }
27
30
| SepBy of { loc : loc; p : expr; sep : expr }
···
75
78
| NotFollowedBy { loc; _ } -> loc
76
79
| Many { loc; _ } -> loc
77
80
| Some_ { loc; _ } -> loc
81
+
| SkipMany { loc; _ } -> loc
82
+
| SkipSome { loc; _ } -> loc
83
+
| TakeWhile { loc; _ } -> loc
78
84
| Optional { loc; _ } -> loc
79
85
| Option { loc; _ } -> loc
80
86
| SepBy { loc; _ } -> loc
+5
src/optimise.ml
+5
src/optimise.ml
···
61
61
Many { loc; p = optimise p }
62
62
| Some_ { p; loc } ->
63
63
Some_ { loc; p = optimise p }
64
+
| SkipMany { p; loc } ->
65
+
SkipMany { loc; p = optimise p }
66
+
| SkipSome { p; loc } ->
67
+
SkipSome { loc; p = optimise p }
68
+
| TakeWhile _ -> expr
64
69
| Optional { p; loc } ->
65
70
Optional { loc; p = optimise p }
66
71
| Option { default; p; loc } ->
+8
src/ppx_combin.ml
+8
src/ppx_combin.ml
···
63
63
Ir.Some_ { loc; p = expr_to_ir ~loc p }
64
64
| Pexp_apply ({ pexp_desc = Pexp_ident { txt = Lident "optional"; _ }; _ }, [(Nolabel, p)]) ->
65
65
Ir.Optional { loc; p = expr_to_ir ~loc p }
66
+
| Pexp_apply ({ pexp_desc = Pexp_ident { txt = Lident "skip_many"; _ }; _ }, [(Nolabel, p)]) ->
67
+
Ir.SkipMany { loc; p = expr_to_ir ~loc p }
68
+
| Pexp_apply ({ pexp_desc = Pexp_ident { txt = Lident "skip_some"; _ }; _ }, [(Nolabel, p)]) ->
69
+
Ir.SkipSome { loc; p = expr_to_ir ~loc p }
70
+
| Pexp_apply ({ pexp_desc = Pexp_ident { txt = Lident "take_while"; _ }; _ }, [(Nolabel, pred)]) ->
71
+
Ir.TakeWhile { loc; pred; at_least_one = false }
72
+
| Pexp_apply ({ pexp_desc = Pexp_ident { txt = Lident "take_while1"; _ }; _ }, [(Nolabel, pred)]) ->
73
+
Ir.TakeWhile { loc; pred; at_least_one = true }
66
74
67
75
| Pexp_apply ({ pexp_desc = Pexp_ident { txt = Lident "option"; _ }; _ }, [(Nolabel, default); (Nolabel, p)]) ->
68
76
Ir.Option { loc; default; p = expr_to_ir ~loc p }