vm.fail
OCaml parser combinator that compiles to direct recursive descent
3.5 kB
100 lines
1open Ir
2
3let rec optimise expr =
4 match expr with
5 | Map { f; p; loc } ->
6 let p' = optimise p in
7 (match p' with
8 | Pure { value; _ } ->
9 Pure { loc; value = [%expr [%e f] [%e value]] }
10 | Map { f = f2; p = p2; _ } ->
11 Map { loc; f = [%expr fun x -> [%e f] ([%e f2] x)]; p = p2 }
12 | _ -> Map { loc; f; p = p' })
13
14 | SeqRight { p; q; loc } ->
15 let p' = optimise p in
16 let q' = optimise q in
17 (match p' with
18 | Pure _ -> q'
19 | _ -> SeqRight { loc; p = p'; q = q' })
20
21 | SeqLeft { p; q; loc } ->
22 let p' = optimise p in
23 let q' = optimise q in
24 (match q' with
25 | Pure _ -> p'
26 | _ -> SeqLeft { loc; p = p'; q = q' })
27
28 | Apply { pf; px; loc } ->
29 let pf' = optimise pf in
30 let px' = optimise px in
31 (match pf', px' with
32 | Pure { value = f; _ }, Pure { value = x; _ } ->
33 Pure { loc; value = [%expr [%e f] [%e x]] }
34 | Pure { value = f; _ }, _ ->
35 Map { loc; f; p = px' }
36 | _, Pure { value = x; _ } ->
37 Map { loc; f = [%expr fun f -> f [%e x]]; p = pf' }
38 | _ -> Apply { loc; pf = pf'; px = px' })
39
40 | Alt { p; q; loc } ->
41 let p' = optimise p in
42 let q' = optimise q in
43 (match p' with
44 | Fail _ -> q'
45 | _ -> Alt { loc; p = p'; q = q' })
46
47 | Bind { p; f; loc } ->
48 let p' = optimise p in
49 (match p' with
50 | Pure { value; _ } ->
51 Bind { loc; p = Pure { loc; value = [%expr ()] }; f = [%expr fun () -> [%e f] [%e value]] }
52 | _ -> Bind { loc; p = p'; f })
53
54 | Attempt { p; loc } ->
55 Attempt { loc; p = optimise p }
56 | Lookahead { p; loc } ->
57 Lookahead { loc; p = optimise p }
58 | NotFollowedBy { p; loc } ->
59 NotFollowedBy { loc; p = optimise p }
60 | Many { p; loc } ->
61 Many { loc; p = optimise p }
62 | Some_ { p; loc } ->
63 Some_ { loc; p = optimise p }
64 | Optional { p; loc } ->
65 Optional { loc; p = optimise p }
66 | Option { default; p; loc } ->
67 Option { loc; default; p = optimise p }
68 | SepBy { p; sep; loc } ->
69 SepBy { loc; p = optimise p; sep = optimise sep }
70 | SepBy1 { p; sep; loc } ->
71 SepBy1 { loc; p = optimise p; sep = optimise sep }
72 | EndBy { p; sep; loc } ->
73 EndBy { loc; p = optimise p; sep = optimise sep }
74 | EndBy1 { p; sep; loc } ->
75 EndBy1 { loc; p = optimise p; sep = optimise sep }
76 | ManyTill { p; end_; loc } ->
77 ManyTill { loc; p = optimise p; end_ = optimise end_ }
78 | Count { n; p; loc } ->
79 Count { loc; n; p = optimise p }
80 | Between { open_; close; p; loc } ->
81 Between { loc; open_ = optimise open_; close = optimise close; p = optimise p }
82 | ChainL { p; op; loc } ->
83 ChainL { loc; p = optimise p; op = optimise op }
84 | ChainL1 { p; op; loc } ->
85 ChainL1 { loc; p = optimise p; op = optimise op }
86 | ChainR { p; op; loc } ->
87 ChainR { loc; p = optimise p; op = optimise op }
88 | ChainR1 { p; op; loc } ->
89 ChainR1 { loc; p = optimise p; op = optimise op }
90 | Choice { ps; label; loc } ->
91 let ps' = List.map optimise ps in
92 let ps'' = List.filter (function Fail _ -> false | _ -> true) ps' in
93 Choice { loc; ps = (if ps'' = [] then ps' else ps''); label }
94 | Label { p; label; loc } ->
95 Label { loc; p = optimise p; label }
96 | Memo { name; p; loc } ->
97 Memo { loc; name; p = optimise p }
98
99 | Pure _ | Fail _ | Satisfy _ | Any _ | Eof _ | Token _ | Tokens _
100 | OneOf _ | NoneOf _ | Cut _ | Fix _ | Var _ -> expr