From 98df3f795d33315be689cffd5e9e916f95f3e905 Mon Sep 17 00:00:00 2001 From: Rijnard van Tonder Date: Mon, 19 Apr 2021 02:43:04 -0700 Subject: [PATCH] support reserved identifiers for variables (#274) --- lib/app/comby.mli | 3 ++- lib/kernel/comby_kernel.mli | 3 ++- lib/kernel/matchers/alpha.ml | 14 ++++++----- lib/kernel/matchers/metasyntax.ml | 3 +++ lib/kernel/matchers/types.ml | 1 + lib/kernel/rewriter/rewrite_template.ml | 2 ++ test/alpha/test_custom_metasyntax.ml | 23 ++++++++++++++++++- test/common/test_cli.ml | 11 +++++++++ .../{default-metasyntax.json => default.json} | 20 ++++++++++++++++ 9 files changed, 71 insertions(+), 9 deletions(-) rename test/example/metasyntax/{default-metasyntax.json => default.json} (52%) diff --git a/lib/app/comby.mli b/lib/app/comby.mli index 08cd670..99671f3 100644 --- a/lib/app/comby.mli +++ b/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 diff --git a/lib/kernel/comby_kernel.mli b/lib/kernel/comby_kernel.mli index 68fbd02..51bfc55 100644 --- a/lib/kernel/comby_kernel.mli +++ b/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 diff --git a/lib/kernel/matchers/alpha.ml b/lib/kernel/matchers/alpha.ml index 2062890..d3b1dee 100644 --- a/lib/kernel/matchers/alpha.ml +++ b/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 diff --git a/lib/kernel/matchers/metasyntax.ml b/lib/kernel/matchers/metasyntax.ml index c4c6fbf..136367a 100644 --- a/lib/kernel/matchers/metasyntax.ml +++ b/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 (":[", '~', "]") ] diff --git a/lib/kernel/matchers/types.ml b/lib/kernel/matchers/types.ml index 471b59d..ecb964e 100644 --- a/lib/kernel/matchers/types.ml +++ b/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 = diff --git a/lib/kernel/rewriter/rewrite_template.ml b/lib/kernel/rewriter/rewrite_template.ml index 0b21381..85c2cff 100644 --- a/lib/kernel/rewriter/rewrite_template.ml +++ b/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) -> diff --git a/test/alpha/test_custom_metasyntax.ml b/test/alpha/test_custom_metasyntax.ml index 49e41cc..0dc075c 100644 --- a/test/alpha/test_custom_metasyntax.ml +++ b/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)"}]} +|}] diff --git a/test/common/test_cli.ml b/test/common/test_cli.ml index d1d9c8e..94be98e 100644 --- a/test/common/test_cli.ml +++ b/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))"] diff --git a/test/example/metasyntax/default-metasyntax.json b/test/example/metasyntax/default.json similarity index 52% rename from test/example/metasyntax/default-metasyntax.json rename to test/example/metasyntax/default.json index 40bf216..31eb08a 100644 --- a/test/example/metasyntax/default-metasyntax.json +++ b/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":