vm.fail
OCaml parser combinator that compiles to direct recursive descent
3.2 kB
103 lines
1open Ir
2
3type first =
4 | Epsilon
5 | Predicate of Ppxlib.expression
6 | Token of Ppxlib.expression
7 | Tokens of Ppxlib.expression
8 | OneOf of Ppxlib.expression
9 | Any
10 | Unknown
11
12type t = {
13 firsts : first list;
14 nullable : bool;
15}
16
17let empty = { firsts = []; nullable = false }
18let epsilon = { firsts = [Epsilon]; nullable = true }
19let any = { firsts = [Any]; nullable = false }
20let unknown = { firsts = [Unknown]; nullable = false }
21
22let of_predicate e = { firsts = [Predicate e]; nullable = false }
23let of_token e = { firsts = [Token e]; nullable = false }
24let of_tokens e = { firsts = [Tokens e]; nullable = false }
25let of_one_of e = { firsts = [OneOf e]; nullable = false }
26
27let union a b = {
28 firsts = a.firsts @ b.firsts;
29 nullable = a.nullable || b.nullable;
30}
31
32let seq a b =
33 if a.nullable then union { a with nullable = false } b
34 else a
35
36let rec compute env = function
37 | Pure _ -> epsilon
38 | Fail _ -> empty
39 | Satisfy { pred; _ } -> of_predicate pred
40 | Any _ -> any
41 | Eof _ -> epsilon
42 | Token { tok; _ } -> of_token tok
43 | Tokens { toks; _ } -> of_tokens toks
44 | OneOf { toks; _ } -> of_one_of toks
45 | NoneOf _ -> unknown
46 | Bind { p; _ } -> compute env p
47 | Map { p; _ } -> compute env p
48 | Apply { pf; px; _ } -> seq (compute env pf) (compute env px)
49 | SeqLeft { p; q; _ } -> seq (compute env p) (compute env q)
50 | SeqRight { p; q; _ } -> seq (compute env p) (compute env q)
51 | Alt { p; q; _ } -> union (compute env p) (compute env q)
52 | Attempt { p; _ } -> compute env p
53 | Cut _ -> epsilon
54 | Lookahead { p; _ } -> { (compute env p) with nullable = true }
55 | NotFollowedBy _ -> epsilon
56 | Many _ -> epsilon
57 | Some_ { p; _ } -> compute env p
58 | Optional { p; _ } -> { (compute env p) with nullable = true }
59 | Option { p; _ } -> { (compute env p) with nullable = true }
60 | SepBy _ -> epsilon
61 | SepBy1 { p; _ } -> compute env p
62 | EndBy _ -> epsilon
63 | EndBy1 { p; _ } -> compute env p
64 | ManyTill { p; _ } -> union (compute env p) epsilon
65 | Count { p; _ } -> compute env p
66 | Between { open_; _ } -> compute env open_
67 | ChainL _ -> epsilon
68 | ChainL1 { p; _ } -> compute env p
69 | ChainR _ -> epsilon
70 | ChainR1 { p; _ } -> compute env p
71 | Choice { ps; _ } -> List.fold_left (fun acc p -> union acc (compute env p)) empty ps
72 | Label { p; _ } -> compute env p
73 | Fix { names; _ } ->
74 List.fold_left (fun acc name ->
75 match List.assoc_opt name env with
76 | Some fs -> union acc fs
77 | None -> acc
78 ) empty names
79 | Var { name; _ } ->
80 (match List.assoc_opt name env with
81 | Some fs -> fs
82 | None -> unknown)
83
84let has_unknown t = List.exists (function Unknown -> true | _ -> false) t.firsts
85
86let definitely_disjoint a b =
87 if has_unknown a || has_unknown b then false
88 else if a.nullable && b.nullable then false
89 else
90 let singleton_token = function
91 | [Token _] -> true
92 | [OneOf _] -> true
93 | _ -> false
94 in
95 singleton_token a.firsts && singleton_token b.firsts
96
97let is_static = function
98 | Token _ -> true
99 | Tokens _ -> true
100 | OneOf _ -> true
101 | _ -> false
102
103let all_static t = List.for_all is_static t.firsts