support reserved identifiers for variables (#274)

lib/app/comby.mli

@@ -268,7 +268,8 @@ module Matchers : sig
     (** A hole definition should comprise either a string prefix, suffix, or
         both which encloses an variable identifier. See example below. *)
     type hole_definition =
-        Delimited of string option * string option
+      | Delimited of string option * string option
+      | Reserved_identifiers of string list
 
     (** Defines syntax definitions for holes. Zero or more Hole sorts, excluding
         [Regex] should have an associated [hole_definition]. The [Regex] hole

lib/kernel/comby_kernel.mli

@@ -268,7 +268,8 @@ module Matchers : sig
     (** A hole definition should comprise either a string prefix, suffix, or
         both which encloses an variable identifier. See example below. *)
     type hole_definition =
-        Delimited of string option * string option
+      | Delimited of string option * string option
+      | Reserved_identifiers of string list
 
     (** Defines syntax definitions for holes. Zero or more Hole sorts, excluding
         [Regex] should have an associated [hole_definition]. The [Regex] hole

lib/kernel/matchers/alpha.ml

@@ -253,6 +253,8 @@ module Make (Language : Language.S) (Metasyntax : Metasyntax.S) = struct
     List.fold ~init:[] Metasyntax.syntax ~f:(fun acc -> function
         | Hole (sort, Delimited (left, right)) ->
           (sort, (p left >> hole_body () << p right))::acc
+        | Hole (sort, Reserved_identifiers l) ->
+          (sort, choice (List.map ~f:(fun s -> string s |>> fun s -> (false, s)) l))::acc
         | Regex (left, separator, right) ->
           (Regex, (p (Some left) >> regex_body separator right () << p (Some right)))::acc)
 
@@ -832,7 +834,7 @@ module Make (Language : Language.S) (Metasyntax : Metasyntax.S) = struct
     let open Hole in
     let hole_parser =
       let open Polymorphic_compare in
-      List.find_map hole_parsers ~f:(fun (sort', parser) -> Option.some_if (sort' = sort) parser)
+      List.fold ~init:[] hole_parsers ~f:(fun acc (sort', parser) -> if sort' = sort then parser::acc else acc)
     in
     let skip_signal hole = skip (string "_signal_hole") |>> fun () -> Hole hole in
     let at_depth =
@@ -846,9 +848,10 @@ module Make (Language : Language.S) (Metasyntax : Metasyntax.S) = struct
         | _ -> at_depth
     in
     match hole_parser with
-    | None -> fail "none" (* not defined *)
-    | Some p ->
-      p |>> function (optional, identifier) -> skip_signal { sort; identifier; dimension; optional; at_depth }
+    | [] -> fail "none" (* not defined *)
+    | l ->
+      choice l |>> function (optional, identifier) ->
+        skip_signal { sort; identifier; dimension; optional; at_depth }
 
   let generate_hole_for_literal dimension ~contents ~left_delimiter ~right_delimiter s =
     let holes = choice @@ List.map hole_parsers ~f:(fun (kind, _) -> attempt (hole_parser kind dimension)) in
@@ -863,8 +866,7 @@ module Make (Language : Language.S) (Metasyntax : Metasyntax.S) = struct
       choice
         [ holes
         ; (spaces1 |>> generate_pure_spaces_parser)
-        ; ((many1 (is_not (choice [reserved_holes; skip space] ))
-            |>> String.of_char_list) |>> generate_string_token_parser)
+        ; ((many1 (is_not (choice [reserved_holes; skip space] )) |>> String.of_char_list) |>> generate_string_token_parser)
         ]
     in
     match parse_string p contents (Match.create ()) with

lib/kernel/matchers/metasyntax.ml

@@ -1,5 +1,6 @@
 include Types.Metasyntax
 
+(* Format.printf "%s@." @@ Matchers.Metasyntax.(json Matchers.Metasyntax.default_metasyntax);; *)
 let default_syntax =
   [ Hole (Everything, Delimited (Some ":[", Some "]"))
   ; Hole (Expression, Delimited (Some ":[", Some ":e]"))
@@ -7,6 +8,8 @@ let default_syntax =
   ; Hole (Non_space, Delimited (Some ":[", Some ".]"))
   ; Hole (Line, Delimited (Some ":[", Some "\\n]"))
   ; Hole (Blank, Delimited (Some ":[ ", Some "]"))
+  ; Hole (Expression, Reserved_identifiers ["α"; "β"; "γ"; "δ"; "ε"; "ζ"; "η"; "θ"; "ι"; "κ"; "λ"; "μ"; "ξ"; "π"; "ρ"; "ς"; "σ"; "τ"; "υ"; "φ"; "χ"; "ψ"; "ω"])
+  ; Hole (Everything, Reserved_identifiers ["Γ"; "Δ"; "Θ"; "Λ"; "Ξ"; "Π"; "Σ"; "Φ"; "Ψ"; "Ω"])
   ; Regex (":[", '~', "]")
   ]
 

lib/kernel/matchers/types.ml

@@ -91,6 +91,7 @@ module Metasyntax = struct
 
   type hole_definition =
     | Delimited of string option * string option
+    | Reserved_identifiers of string list
   [@@deriving yojson]
 
   type hole_syntax =

lib/kernel/rewriter/rewrite_template.ml

@@ -90,6 +90,8 @@ module Make (Metasyntax : Matchers.Metasyntax.S) = struct
             fun (o, v) ->
             Format.sprintf "%s%s%s%s" (Option.value left ~default:"") (if o then "?" else "") v (Option.value right ~default:""),
             v
+          | Hole (_, Reserved_identifiers l) ->
+            choice (List.map l ~f:string) >>| fun v -> v, v
           | Regex (left, separator, right) ->
             p (Some left) *> regex_body separator right <* p (Some right) >>|
             fun ((_, v), expr) ->

test/alpha/test_custom_metasyntax.ml

@@ -165,4 +165,25 @@ let%expect_test "custom_metasyntax_rewrite" =
     | Nothing -> "nothing"
   in
   print_string output;
-  [%expect_exact {|1 2 2|}];
+  [%expect_exact {|1 2 2|}]
+
+let%expect_test "custom_metasyntax_greek_letters" =
+  let matcher = create
+      [ Hole (Alphanum, Reserved_identifiers ["α"; "β"])
+      ]
+  in
+
+  run matcher "simple(bar)" {|α(β)|} "";
+  [%expect_exact {|{"uri":null,"matches":[{"range":{"start":{"offset":0,"line":1,"column":1},"end":{"offset":11,"line":1,"column":12}},"environment":[{"variable":"α","value":"simple","range":{"start":{"offset":0,"line":1,"column":1},"end":{"offset":6,"line":1,"column":7}}},{"variable":"β","value":"bar","range":{"start":{"offset":7,"line":1,"column":8},"end":{"offset":10,"line":1,"column":11}}}],"matched":"simple(bar)"}]}
+|}]
+
+let%expect_test "custom_metasyntax_alphanum_test" =
+  let matcher = create
+      [ Hole (Alphanum, Delimited (Some "[:", Some ":]"))
+      ; Hole (Alphanum, Reserved_identifiers ["α"; "β"])
+      ]
+  in
+
+  run matcher "simple(bar)" {|[:A:](α)|} "";
+  [%expect_exact {|{"uri":null,"matches":[{"range":{"start":{"offset":0,"line":1,"column":1},"end":{"offset":11,"line":1,"column":12}},"environment":[{"variable":"A","value":"simple","range":{"start":{"offset":0,"line":1,"column":1},"end":{"offset":6,"line":1,"column":7}}},{"variable":"α","value":"bar","range":{"start":{"offset":7,"line":1,"column":8},"end":{"offset":10,"line":1,"column":11}}}],"matched":"simple(bar)"}]}
+|}]

test/common/test_cli.ml

@@ -1253,3 +1253,14 @@ let%expect_test "test_custom_metasyntax_partial_rule_support" =
   let result = read_expect_stdin_and_stdout command source in
   print_string result;
   [%expect "a b"]
+
+let%expect_test "test_custom_metasyntax_reserved_identifiers" =
+  let source = "fun f -> (fun x -> f (x x)) (fun x -> f (x x))" in
+  let metasyntax_path = "example" ^/ "metasyntax" ^/ "default.json" in
+  let command_args =
+    Format.sprintf {|'λ f -> α α' 'α' -stdin -custom-metasyntax %s -stdout|} metasyntax_path
+  in
+  let command = Format.sprintf "%s %s" binary_path command_args in
+  let result = read_expect_stdin_and_stdout command source in
+  print_string result;
+  [%expect "(fun x -> f (x x))"]

test/example/metasyntax/default.json

@@ -6,6 +6,26 @@
     [ "Hole", [ "Non_space" ], [ "Delimited", ":[", ".]" ] ],
     [ "Hole", [ "Line" ], [ "Delimited", ":[", "\\n]" ] ],
     [ "Hole", [ "Blank" ], [ "Delimited", ":[ ", "]" ] ],
+    [
+      "Hole",
+      [ "Expression" ],
+      [
+        "Reserved_identifiers",
+        [
+          "α", "β", "γ", "δ", "ε", "ζ", "η", "θ", "ι", "κ", "λ",
+          "μ", "ξ", "π", "ρ", "ς", "σ", "τ", "υ", "φ", "χ", "ψ",
+          "ω"
+        ]
+      ]
+    ],
+    [
+      "Hole",
+      [ "Everything" ],
+      [
+        "Reserved_identifiers",
+        [ "Γ", "Δ", "Θ", "Λ", "Ξ", "Π", "Σ", "Φ", "Ψ", "Ω" ]
+      ]
+    ],
     [ "Regex", ":[", "~", "]" ]
   ],
   "identifier":