Source file common.ml

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
type capture_key = Capture_idx of int | Capture_name of string

module IntMap = Map.Make (Int)

type capture = { capture_name : string option; capture_patterns : rule list }
and regex = Oniguruma.Encoding.utf8 Oniguruma.t

and match_ = {
  name : string option;
  pattern_source : string;
  pattern : regex;
  captures : (capture_key, capture) Hashtbl.t;
}

and delim_kind = End | While

and delim = {
  delim_begin_source : string;
  delim_begin : regex;
  delim_end : string; (* Either an end or a while pattern *)
  delim_patterns : rule list;
  delim_name : string option;
  delim_content_name : string option;
  delim_begin_captures : (capture_key, capture) Hashtbl.t;
  delim_end_captures : (capture_key, capture) Hashtbl.t;
  delim_apply_end_pattern_last : bool;
  delim_kind : delim_kind;
}

and rule =
  | Match of match_
  | Delim of delim
  | Scope_patterns of { scope_name : string option; child_patterns : rule list }
  | Include_local of string
  | Include_scope of string
  | Include_self
  | Include_base

type repo_item_kind = Repo_rule of rule | Repo_patterns of rule list

type repo_item = {
  repo_item_kind : repo_item_kind;
  repo_inner : (string, repo_item) Hashtbl.t;
}

type injection_selector = {
  selector_segments : string list;
  selector_left : bool;
}

type grammar = {
  name : string option;
  scope_name : string;
  injection_selector : string option;
  filetypes : string list;
  patterns : rule list;
  repository : (string, repo_item) Hashtbl.t;
  injections : (injection_selector * rule list) list;
}

type t = {
  by_name : (string, grammar) Hashtbl.t;
  by_scope_name : (string, grammar) Hashtbl.t;
  by_filetype : (string, grammar) Hashtbl.t;
}

type union =
  [ `Bool of bool
  | `Data of string
  | `Date of float * float option
  | `Float of float
  | `Int of int
  | `String of string
  | `Array of union list
  | `Dict of (string * union) list
  | `Null
  | `A of union list
  | `O of (string * union) list
  | `Assoc of (string * union) list
  | `List of union list ]

type plist =
  [ `Bool of bool
  | `Data of string
  | `Date of float * float option
  | `Float of float
  | `Int of int
  | `String of string
  | `Array of plist list
  | `Dict of (string * plist) list ]

type ezjsonm =
  [ `Null
  | `Bool of bool
  | `Float of float
  | `String of string
  | `A of ezjsonm list
  | `O of (string * ezjsonm) list ]

type yojson =
  [ `Null
  | `Bool of bool
  | `Int of int
  | `Float of float
  | `String of string
  | `Assoc of (string * yojson) list
  | `List of yojson list ]

exception Error of string

let compile_regex ?error_context re =
  match
    Oniguruma.create re Oniguruma.Options.none Oniguruma.Encoding.utf8
      Oniguruma.Syntax.default
  with
  | Ok re ->
      re
  | Error msg ->
      let prefix =
        match error_context with
        | None ->
            re
        | Some context ->
            context ^ ": " ^ re
      in
      raise (Error (prefix ^ ": " ^ msg))

let create () =
  {
    by_name = Hashtbl.create 23;
    by_scope_name = Hashtbl.create 23;
    by_filetype = Hashtbl.create 23;
  }

let add_grammar t grammar =
  ( match grammar.name with
  | Some name ->
      Hashtbl.replace t.by_name (String.lowercase_ascii name) grammar
  | None ->
      ()
  );
  Hashtbl.replace t.by_scope_name grammar.scope_name grammar;
  List.iter
    (fun filetype -> Hashtbl.replace t.by_filetype filetype grammar)
    grammar.filetypes

let find_by_name t name =
  Hashtbl.find_opt t.by_name (String.lowercase_ascii name)

let find_by_scope_name t = Hashtbl.find_opt t.by_scope_name
let find_by_filetype t = Hashtbl.find_opt t.by_filetype
let error msg = raise (Error msg)