vm.fail
OCaml parser combinator that compiles to direct recursive descent
4.1 kB
115 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 let p' = match p' with
18 | Many { p = inner; loc = l } -> SkipMany { loc = l; p = inner }
19 | Some_ { p = inner; loc = l } -> SkipSome { loc = l; p = inner }
20 | _ -> p'
21 in
22 (match p' with
23 | Pure _ -> q'
24 | _ -> SeqRight { loc; p = p'; q = q' })
25
26 | SeqLeft { p; q; loc } ->
27 let p' = optimise p in
28 let q' = optimise q in
29 let q' = match q' with
30 | Many { p = inner; loc = l } -> SkipMany { loc = l; p = inner }
31 | Some_ { p = inner; loc = l } -> SkipSome { loc = l; p = inner }
32 | _ -> q'
33 in
34 (match q' with
35 | Pure _ -> p'
36 | _ -> SeqLeft { loc; p = p'; q = q' })
37
38 | Apply { pf; px; loc } ->
39 let pf' = optimise pf in
40 let px' = optimise px in
41 (match pf', px' with
42 | Pure { value = f; _ }, Pure { value = x; _ } ->
43 Pure { loc; value = [%expr [%e f] [%e x]] }
44 | Pure { value = f; _ }, _ ->
45 Map { loc; f; p = px' }
46 | _, Pure { value = x; _ } ->
47 Map { loc; f = [%expr fun f -> f [%e x]]; p = pf' }
48 | _ -> Apply { loc; pf = pf'; px = px' })
49
50 | Alt { p; q; loc } ->
51 let p' = optimise p in
52 let q' = optimise q in
53 (match p' with
54 | Fail _ -> q'
55 | _ -> Alt { loc; p = p'; q = q' })
56
57 | Bind { p; f; loc } ->
58 let p' = optimise p in
59 (match p' with
60 | Pure { value; _ } ->
61 Bind { loc; p = Pure { loc; value = [%expr ()] }; f = [%expr fun () -> [%e f] [%e value]] }
62 | _ -> Bind { loc; p = p'; f })
63
64 | Attempt { p; loc } ->
65 Attempt { loc; p = optimise p }
66 | Lookahead { p; loc } ->
67 Lookahead { loc; p = optimise p }
68 | NotFollowedBy { p; loc } ->
69 NotFollowedBy { loc; p = optimise p }
70 | Many { p; loc } ->
71 Many { loc; p = optimise p }
72 | Some_ { p; loc } ->
73 Some_ { loc; p = optimise p }
74 | SkipMany { p; loc } ->
75 SkipMany { loc; p = optimise p }
76 | SkipSome { p; loc } ->
77 SkipSome { loc; p = optimise p }
78 | TakeWhile _ -> expr
79 | Optional { p; loc } ->
80 Optional { loc; p = optimise p }
81 | Option { default; p; loc } ->
82 Option { loc; default; p = optimise p }
83 | SepBy { p; sep; loc } ->
84 SepBy { loc; p = optimise p; sep = optimise sep }
85 | SepBy1 { p; sep; loc } ->
86 SepBy1 { loc; p = optimise p; sep = optimise sep }
87 | EndBy { p; sep; loc } ->
88 EndBy { loc; p = optimise p; sep = optimise sep }
89 | EndBy1 { p; sep; loc } ->
90 EndBy1 { loc; p = optimise p; sep = optimise sep }
91 | ManyTill { p; end_; loc } ->
92 ManyTill { loc; p = optimise p; end_ = optimise end_ }
93 | Count { n; p; loc } ->
94 Count { loc; n; p = optimise p }
95 | Between { open_; close; p; loc } ->
96 Between { loc; open_ = optimise open_; close = optimise close; p = optimise p }
97 | ChainL { p; op; loc } ->
98 ChainL { loc; p = optimise p; op = optimise op }
99 | ChainL1 { p; op; loc } ->
100 ChainL1 { loc; p = optimise p; op = optimise op }
101 | ChainR { p; op; loc } ->
102 ChainR { loc; p = optimise p; op = optimise op }
103 | ChainR1 { p; op; loc } ->
104 ChainR1 { loc; p = optimise p; op = optimise op }
105 | Choice { ps; label; loc } ->
106 let ps' = List.map optimise ps in
107 let ps'' = List.filter (function Fail _ -> false | _ -> true) ps' in
108 Choice { loc; ps = (if ps'' = [] then ps' else ps''); label }
109 | Label { p; label; loc } ->
110 Label { loc; p = optimise p; label }
111 | Memo { name; p; loc } ->
112 Memo { loc; name; p = optimise p }
113
114 | Pure _ | Fail _ | Satisfy _ | Any _ | Eof _ | Token _ | Tokens _
115 | OneOf _ | NoneOf _ | Cut _ | Fix _ | Var _ -> expr