Add options '--strip' and '--normalize' to further facilitate the comparison

of two versions of the same grammar.

Author: mjambon

src/gen/bin/Ocaml_tree_sitter_main.ml

@@ -25,6 +25,7 @@ type to_js_conf = {
   output_path: string option;
   sort_choices: bool;
   sort_rules: bool;
+  strip: bool;
 }
 
 type cmd_conf =
@@ -66,6 +67,7 @@ let to_js (conf : to_js_conf) =
   To_JS.run
     ~sort_choices:conf.sort_choices
     ~sort_rules:conf.sort_rules
+    ~strip:conf.strip
     conf.input_path conf.output_path
 
 let run conf =
@@ -179,6 +181,23 @@ let to_js_cmd =
     in
     Arg.value (Arg.flag info) in
 
+  let strip_term : bool Term.t =
+    let info = Arg.info ["strip"]
+        ~doc:"Remove elements that don't affect the generated OCaml types \
+              such as precedences."
+    in
+    Arg.value (Arg.flag info) in
+
+  let normalize_term : bool Term.t =
+    let info = Arg.info ["normalize"]
+        ~doc:"Shorthand for all the options that rearrange the grammar \
+              so as to make them easier to compare while ignoring the parts \
+              that don't affect the generated types in file 'CST.ml'. \
+              It currently combines --sort-choices, --sort-rules, \
+              and --strip."
+    in
+    Arg.value (Arg.flag info) in
+
   let doc =
     "recover a tree-sitter grammar.js from grammar.json" in
 
@@ -191,15 +210,22 @@ let to_js_cmd =
         https://github.com/returntocorp/ocaml-tree-sitter/issues.";
   ] in
   let info = Term.info ~doc ~man "to-js" in
-  let config input_path output_path sort_choices sort_rules =
-    To_JS { input_path; output_path; sort_choices; sort_rules }
+  let config input_path output_path sort_choices sort_rules strip normalize =
+    let sort_choices, sort_rules, strip =
+      normalize || sort_choices,
+      normalize || sort_rules,
+      normalize || strip
+    in
+    To_JS { input_path; output_path; sort_choices; sort_rules; strip }
   in
   let cmdline_term = Term.(
     const config
     $ input_path_term
     $ output_path_term
     $ sort_choices_term
-    $ sort_rules_term) in
+    $ sort_rules_term
+    $ strip_term
+    $ normalize_term) in
   (cmdline_term, info)
 
 let gen_cmd =

src/gen/lib/To_JS.ml

@@ -224,14 +224,50 @@ let pp_grammar ~sort_choices ~sort_rules (x : grammar) : Indent.t =
     Line "});";
   ]
 
-let run ~sort_choices ~sort_rules input_path output_path =
+let rec strip (body : rule_body) =
+  match body with
+  | SYMBOL _
+  | STRING _
+  | PATTERN _
+  | BLANK -> body
+  | REPEAT x -> REPEAT (strip x)
+  | REPEAT1 x -> REPEAT1 (strip x)
+  | CHOICE xs -> CHOICE (List.map strip xs)
+  | SEQ xs -> SEQ (List.map strip xs)
+  | PREC (_prec_value, x) -> strip x
+  | PREC_DYNAMIC (_n, x) -> strip x
+  | PREC_LEFT (_opt_prec_value, x) -> strip x
+  | PREC_RIGHT (_opt_prec_value, x) -> strip x
+  | ALIAS x -> strip x.content
+  | FIELD (_name, x) -> strip x
+  | IMMEDIATE_TOKEN x -> strip x
+  | TOKEN x -> strip x
+
+(*
+   Eliminate all the constructs that don't affect the structure of the
+   tree as reflected by the types in the generated file CST.ml.
+*)
+let strip_grammar (grammar : grammar) =
+  {
+    grammar with
+    extras = List.map strip grammar.extras;
+    inline = [];
+    conflicts = [];
+    precedences = [];
+    externals = (* is this useful to keep? *) List.map strip grammar.externals;
+    supertypes = [];
+    rules = List.map (fun (name, body) -> (name, strip body)) grammar.rules;
+  }
+
+let run ~sort_choices ~sort_rules ~strip input_path output_path =
   let grammar =
     match input_path with
     | None ->
         Atdgen_runtime.Util.Json.from_channel Tree_sitter_j.read_grammar stdin
     | Some file ->
         Atdgen_runtime.Util.Json.from_file Tree_sitter_j.read_grammar file
   in
+  let grammar = if strip then strip_grammar grammar else grammar in
   let tree = pp_grammar ~sort_choices ~sort_rules grammar in
   match output_path with
   | None -> Indent.to_channel stdout tree

src/gen/lib/To_JS.mli

@@ -16,4 +16,5 @@
 val run :
   sort_choices:bool ->
   sort_rules:bool ->
+  strip:bool ->
   string option -> string option -> unit