vm.fail
OCaml parser combinator that compiles to direct recursive descent
3.7 kB
105 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 | SkipMany { p; loc } ->
65 SkipMany { loc; p = optimise p }
66 | SkipSome { p; loc } ->
67 SkipSome { loc; p = optimise p }
68 | TakeWhile _ -> expr
69 | Optional { p; loc } ->
70 Optional { loc; p = optimise p }
71 | Option { default; p; loc } ->
72 Option { loc; default; p = optimise p }
73 | SepBy { p; sep; loc } ->
74 SepBy { loc; p = optimise p; sep = optimise sep }
75 | SepBy1 { p; sep; loc } ->
76 SepBy1 { loc; p = optimise p; sep = optimise sep }
77 | EndBy { p; sep; loc } ->
78 EndBy { loc; p = optimise p; sep = optimise sep }
79 | EndBy1 { p; sep; loc } ->
80 EndBy1 { loc; p = optimise p; sep = optimise sep }
81 | ManyTill { p; end_; loc } ->
82 ManyTill { loc; p = optimise p; end_ = optimise end_ }
83 | Count { n; p; loc } ->
84 Count { loc; n; p = optimise p }
85 | Between { open_; close; p; loc } ->
86 Between { loc; open_ = optimise open_; close = optimise close; p = optimise p }
87 | ChainL { p; op; loc } ->
88 ChainL { loc; p = optimise p; op = optimise op }
89 | ChainL1 { p; op; loc } ->
90 ChainL1 { loc; p = optimise p; op = optimise op }
91 | ChainR { p; op; loc } ->
92 ChainR { loc; p = optimise p; op = optimise op }
93 | ChainR1 { p; op; loc } ->
94 ChainR1 { loc; p = optimise p; op = optimise op }
95 | Choice { ps; label; loc } ->
96 let ps' = List.map optimise ps in
97 let ps'' = List.filter (function Fail _ -> false | _ -> true) ps' in
98 Choice { loc; ps = (if ps'' = [] then ps' else ps''); label }
99 | Label { p; label; loc } ->
100 Label { loc; p = optimise p; label }
101 | Memo { name; p; loc } ->
102 Memo { loc; name; p = optimise p }
103
104 | Pure _ | Fail _ | Satisfy _ | Any _ | Eof _ | Token _ | Tokens _
105 | OneOf _ | NoneOf _ | Cut _ | Fix _ | Var _ -> expr