diff --git a/lib/kernel/matchers/alpha.ml b/lib/kernel/matchers/alpha.ml index d3b1dee..6966173 100644 --- a/lib/kernel/matchers/alpha.ml +++ b/lib/kernel/matchers/alpha.ml @@ -213,9 +213,6 @@ module Make (Language : Language.S) (Metasyntax : Metasyntax.S) = struct >> string str >>= fun result -> f result - let is_optional () = - opt false (char '?' |>> fun _ -> true) - let identifier () = choice @@ List.map ~f:char (String.to_list Metasyntax.identifier) @@ -226,9 +223,7 @@ module Make (Language : Language.S) (Metasyntax : Metasyntax.S) = struct many1 (identifier ()) |>> String.of_char_list let hole_body () = - is_optional () >>= fun optional -> - identifier () >>= fun identifier -> - return (optional, identifier) + identifier () let regex_body separator suffix () = let rec expr s = @@ -243,7 +238,7 @@ module Make (Language : Language.S) (Metasyntax : Metasyntax.S) = struct in regex_identifier () >>= fun identifier -> if debug then Format.printf "Regex accepts %s@." identifier; - return (false, identifier) + return identifier let p = function | Some delim -> skip (string delim) @@ -254,7 +249,7 @@ module Make (Language : Language.S) (Metasyntax : Metasyntax.S) = struct | 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 + (sort, choice (List.map ~f:(fun s -> string s |>> fun s -> s) l))::acc | Regex (left, separator, right) -> (Regex, (p (Some left) >> regex_body separator right () << p (Some right)))::acc) @@ -613,10 +608,10 @@ module Make (Language : Language.S) (Metasyntax : Metasyntax.S) = struct fail "unsat" let turn_holes_into_matchers_for_this_level ?left_delimiter ?right_delimiter p_list = - List.foldi (List.rev p_list) ~init:[] ~f:(fun i acc p -> + List.fold (List.rev p_list) ~init:[] ~f:(fun acc p -> match parse_string p "_signal_hole" (Match.create ()) with | Failed _ -> p::acc - | Success Hole { sort; identifier; optional; dimension; at_depth } -> + | Success Hole { sort; identifier; dimension; at_depth } -> begin match sort with | Regex -> @@ -661,29 +656,7 @@ module Make (Language : Language.S) (Metasyntax : Metasyntax.S) = struct | Alphanum -> let allowed = choice [alphanum; char '_'] |>> String.of_char in let hole_semantics = many1 allowed in - begin match optional with - | false -> (record_matches identifier hole_semantics)::acc - | true -> - if debug then Format.printf "Optional active@."; - match acc with - | [] -> - let hole_semantics = opt [] (attempt hole_semantics) in - (record_matches identifier hole_semantics)::acc - | (suffix::rest) as acc -> - let optional_succeeds_parser = - record_matches identifier hole_semantics - >> sequence_chain acc - in - let optional_fails_parser = - record_matches identifier (return []) >>= fun _ -> - if coalesce_whitespace (prefix_parser p_list i) suffix then - sequence_chain rest - else - sequence_chain acc - in - [(attempt optional_succeeds_parser) - <|> optional_fails_parser] - end + (record_matches identifier hole_semantics)::acc | Non_space -> let allowed = @@ -698,12 +671,6 @@ module Make (Language : Language.S) (Metasyntax : Metasyntax.S) = struct | _ -> sequence_chain acc in let hole_semantics = many1 (not_followed_by rest "" >> allowed) in - let hole_semantics = - if not optional then - hole_semantics - else - opt [] (attempt hole_semantics) - in (record_matches identifier hole_semantics)::acc | Line -> @@ -712,23 +679,11 @@ module Make (Language : Language.S) (Metasyntax : Metasyntax.S) = struct |>> fun x -> [(String.of_char_list x)^"\n"] in let hole_semantics = allowed << char '\n' in - let hole_semantics = - if not optional then - hole_semantics - else - opt [] (attempt hole_semantics) - in (record_matches identifier hole_semantics)::acc | Blank -> let allowed = blank |>> String.of_char in let hole_semantics = many1 allowed in - let hole_semantics = - if not optional then - hole_semantics - else - opt [] (attempt hole_semantics) - in (record_matches identifier hole_semantics)::acc | Expression -> @@ -768,64 +723,15 @@ module Make (Language : Language.S) (Metasyntax : Metasyntax.S) = struct raw_literal_grammar ~right_delimiter | Comment -> failwith "Unimplemented" in - match optional with - | false -> - let rest = - match acc with - | [] -> eof >>= fun () -> f [""] - | _ -> sequence_chain acc - in - (* Continue until rest, but don't consume rest. acc will - propagate the rest that needs to be consumed. *) - let hole_semantics = many (not_followed_by rest "" >> matcher) in - (record_matches identifier hole_semantics)::acc - | true -> - if debug then Format.printf "Optional active@."; + let rest = match acc with - | [] -> - let rest = eof >>= fun () -> f [""] in - let hole_semantics = many (not_followed_by rest "" >> matcher) in - (* Try match ordinary hole semantics, but if the parser - fails, just let it pass which leads to assigning "" to - identifier *) - let hole_semantics = opt [] (attempt hole_semantics) in - (record_matches identifier hole_semantics)::acc - | (suffix::rest) as acc -> - let after = sequence_chain acc in - let hole_semantics = many (not_followed_by after "" >> matcher) in - (* The logic goes: Try to match ordinary hole semantics, and - propagate acc if it succeeds. If ordinary semantics fail, - let it pass and coalesce whitespace with prefix/suffix if - needed and only propagate 'rest', since we remove the - suffix by coalescing. *) - let optional_succeeds_parser = - (* This parser can succeed but does not consume after. - After must still be consumed (acc must be propagated). - *) - record_matches identifier hole_semantics - >>= fun _ -> - if debug then Format.printf "Optional record succeeds.@."; - sequence_chain acc >>= fun r -> - if debug then Format.printf "Rest succeeds.@."; - return r - in - let optional_fails_parser = - if debug then Format.printf "Optional fail case@."; - (* The optional parser that kicks in if - optional_succeeds_parser fails. It does not consume - anything. *) - (record_matches identifier (return [])) >>= fun _ -> - (* Record matches succeeded for optional hole, empty - match. No going back now. Consume suffix if prefix and - suffix are whitespace and propagate rest. Otherwise, - propagate acc. *) - if coalesce_whitespace (prefix_parser p_list i) suffix then - sequence_chain rest - else - sequence_chain acc - in - [(attempt optional_succeeds_parser) - <|> optional_fails_parser] + | [] -> eof >>= fun () -> f [""] + | _ -> sequence_chain acc + in + (* Continue until rest, but don't consume rest. acc will + propagate the rest that needs to be consumed. *) + let hole_semantics = many (not_followed_by rest "" >> matcher) in + (record_matches identifier hole_semantics)::acc end | Success Unit -> acc (* for comment *) | Success _ -> failwith "Hole expected") @@ -850,8 +756,8 @@ module Make (Language : Language.S) (Metasyntax : Metasyntax.S) = struct match hole_parser with | [] -> fail "none" (* not defined *) | l -> - choice l |>> function (optional, identifier) -> - skip_signal { sort; identifier; dimension; optional; at_depth } + choice l |>> function identifier -> + skip_signal { sort; identifier; dimension; 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 diff --git a/lib/kernel/matchers/omega.ml b/lib/kernel/matchers/omega.ml index a23bdab..fb4e832 100644 --- a/lib/kernel/matchers/omega.ml +++ b/lib/kernel/matchers/omega.ml @@ -51,13 +51,6 @@ let substitute template env = ; ":[", "\\n]" ; ":[[", "]]" ; ":[", "]" - (* optional syntax *) - ; ":[? ", "]" - ; ":[ ?", "]" - ; ":[?", ".]" - ; ":[?", "\\n]" - ; ":[[?", "]]" - ; ":[?", "]" ] in Match.Environment.vars env @@ -699,7 +692,7 @@ module Make (Language : Language.S) (Unimplemented : Metasyntax.S) = struct | Regex -> regex_hole_parser () in let skip_signal hole = skip_unit (string "_signal_hole") |>> fun () -> (Hole hole, acc) in - hole_parser |>> fun identifier -> skip_signal { sort; identifier; dimension; optional = false; at_depth = None } + hole_parser |>> fun identifier -> skip_signal { sort; identifier; dimension; at_depth = None } let reserved_holes () = [ single_hole_parser () diff --git a/lib/kernel/matchers/types.ml b/lib/kernel/matchers/types.ml index ecb964e..1d0fcb5 100644 --- a/lib/kernel/matchers/types.ml +++ b/lib/kernel/matchers/types.ml @@ -70,7 +70,6 @@ module Hole = struct { sort : sort ; identifier : string ; dimension : dimension - ; optional : bool ; at_depth : int option } diff --git a/test/alpha/dune b/test/alpha/dune index 4c6ed6d..7bc022b 100644 --- a/test/alpha/dune +++ b/test/alpha/dune @@ -3,7 +3,6 @@ (package comby) (modules test_custom_metasyntax - test_optional_holes test_special_matcher_cases test_substring_disabled) (inline_tests) diff --git a/test/alpha/test_custom_metasyntax.ml b/test/alpha/test_custom_metasyntax.ml index 0dc075c..9f9b1d1 100644 --- a/test/alpha/test_custom_metasyntax.ml +++ b/test/alpha/test_custom_metasyntax.ml @@ -111,7 +111,7 @@ let%expect_test "custom_metasyntax_equivalence" = in run matcher "foo(foo)" {|$A($A~\w+$)|} ""; - [%expect_exact {|{"uri":null,"matches":[{"range":{"start":{"offset":0,"line":1,"column":1},"end":{"offset":8,"line":1,"column":9}},"environment":[{"variable":"!@#$000000000006_A_equal","value":"foo","range":{"start":{"offset":4,"line":1,"column":5},"end":{"offset":7,"line":1,"column":8}}},{"variable":"A","value":"foo","range":{"start":{"offset":0,"line":1,"column":1},"end":{"offset":3,"line":1,"column":4}}}],"matched":"foo(foo)"}]} + [%expect_exact {|{"uri":null,"matches":[{"range":{"start":{"offset":0,"line":1,"column":1},"end":{"offset":8,"line":1,"column":9}},"environment":[{"variable":"!@#$000000000002_A_equal","value":"foo","range":{"start":{"offset":4,"line":1,"column":5},"end":{"offset":7,"line":1,"column":8}}},{"variable":"A","value":"foo","range":{"start":{"offset":0,"line":1,"column":1},"end":{"offset":3,"line":1,"column":4}}}],"matched":"foo(foo)"}]} |}] let%expect_test "custom_metasyntax_definition_order" = diff --git a/test/alpha/test_optional_holes.ml b/test/alpha/test_optional_holes.ml deleted file mode 100644 index 292d2ec..0000000 --- a/test/alpha/test_optional_holes.ml +++ /dev/null @@ -1,218 +0,0 @@ -open Core - -open Matchers -open Rewriter - -open Matchers.Alpha - -let configuration = Configuration.create ~match_kind:Fuzzy () - -let run ?(configuration = configuration) source match_template rewrite_template = - Generic.all ~configuration ~template:match_template ~source () - |> function - | [] -> print_string "No matches." - | results -> - Option.value_exn (Rewrite.all ~source ~rewrite_template results) - |> (fun { rewritten_source; _ } -> rewritten_source) - |> print_string - -let%expect_test "optional_holes_basic_match" = - let source = {||} in - let match_template = {|:[[?x]]|} in - let rewrite_template = {|/:[?x]/|} in - run source match_template rewrite_template; - [%expect_exact {|//|}]; - - let source = {||} in - let match_template = {|:[[?x]]:[[?y]]|} in - let rewrite_template = {|/:[?x]/:[?y]/|} in - run source match_template rewrite_template; - [%expect_exact {|///|}]; - - let source = {|a |} in - let match_template = {|:[[x]] :[[?y]]|} in - let rewrite_template = {|/:[x]/:[?y]/|} in - run source match_template rewrite_template; - [%expect_exact {|/a//|}]; - - let source = {|a |} in - let match_template = {|:[[x]] :[[?y]]|} in - let rewrite_template = {|/:[x]/:[?y]/|} in - run source match_template rewrite_template; - [%expect_exact {|/a//|}]; - - let source = {|(foo )|} in - let match_template = {|(:[[?x]] :[[?y]])|} in - let rewrite_template = {|/:[?x]/:[?y]/|} in - run source match_template rewrite_template; - [%expect_exact {|/foo//|}]; - - let source = {|(foo)|} in - let match_template = {|(:[[?x]]:[ ?w])|} in - let rewrite_template = {|/:[?x]/:[?w]/|} in - run source match_template rewrite_template; - [%expect_exact {|/foo//|}]; - - let source = {|()|} in - let match_template = {|(:[[?x]]:[ ?w]:[?y]:[?z.])|} in - let rewrite_template = {|/:[?x]/:[?w]/:[?y]|} in - run source match_template rewrite_template; - [%expect_exact {|///|}]; - - let source = {|()|} in - let match_template = {|(:[?s\n])|} in - let rewrite_template = {|/:[?s]/|} in - run source match_template rewrite_template; - [%expect_exact {|//|}] - -let%expect_test "optional_holes_match_over_coalesced_whitespace" = - let source = {|a c|} in - let match_template = {|:[[a]] :[[?b]] :[[c]]|} in - let rewrite_template = {|/:[?a]/:[?b]/:[?c]|} in - run source match_template rewrite_template; - [%expect_exact {|/a//c|}]; - - let source = {|a c|} in - let match_template = {|:[[a]] :[[?b]]:[[c]]|} in - let rewrite_template = {|/:[?a]/:[?b]/:[?c]|} in - run source match_template rewrite_template; - [%expect_exact {|/a//c|}]; - - let source = {|a c|} in - let match_template = {|:[[a]]:[[?b]]:[[c]]|} in - let rewrite_template = {|/:[?a]/:[?b]/:[?c]|} in - run source match_template rewrite_template; - [%expect_exact {|No matches.|}]; - - let source = {|a c|} in - let match_template = {|:[[a]]:[[?b]] :[[?c]]|} in - let rewrite_template = {|/:[?a]/:[?b]/:[?c]|} in - run source match_template rewrite_template; - [%expect_exact {|/a//c|}]; - - let source = {|a c|} in - let match_template = {|a :[?b] c|} in - let rewrite_template = {|/:[?b]/|} in - run source match_template rewrite_template; - [%expect_exact {|//|}]; - - let source = {|a c|} in - let match_template = {|a :[?b] c|} in - let rewrite_template = {|/:[?b]/|} in - run source match_template rewrite_template; - [%expect_exact {|//|}]; - - let source = {| - -a - - c - -|} in - let match_template = {| a :[?b] c |} in - let rewrite_template = {|/:[?b]/|} in - run source match_template rewrite_template; - [%expect_exact {|//|}]; - - let source = {|func foo(bar) {}|} in - let match_template = {|func :[?receiver] foo(:[args])|} in - let rewrite_template = {|/:[receiver]/:[args]/|} in - run source match_template rewrite_template; - [%expect_exact {|//bar/ {}|}]; - - let source = {|func foo(bar) {}|} in - let match_template = {|func :[?receiver] foo(:[args])|} in - let rewrite_template = {|/:[receiver]/:[args]/|} in - run source match_template rewrite_template; - [%expect_exact {|//bar/ {}|}]; - - let source = {|func (r *receiver) foo(bar) {}|} in - let match_template = {|func :[?receiver] foo(:[args])|} in - let rewrite_template = {|/:[receiver]/:[args]/|} in - run source match_template rewrite_template; - [%expect_exact {|/(r *receiver)/bar/ {}|}]; - - let source = {|func foo()|} in - let match_template = {|func :[?receiver] foo()|} in - let rewrite_template = {|/:[receiver]/|} in - run source match_template rewrite_template; - [%expect_exact {|//|}]; - - let source = {|a l|} in - let match_template = {|a :[?b]asdfasdfsadf|} in - let rewrite_template = {|/:[?b]/|} in - run source match_template rewrite_template; - [%expect_exact {|No matches.|}]; - - let source = {|func foo (1, 3)|} in - let match_template = {|func :[?receiver] foo (1, :[?args] 3)|} in - let rewrite_template = {|/:[receiver]/:[args]/|} in - run source match_template rewrite_template; - [%expect_exact {|///|}]; - - let source = {| -try { - foo() -} catch (Exception e) { - logger.error(e) - hey -} -|} in - let match_template = {| -catch (:[type] :[var]) { -:[?anything] -logger.:[logMethod](:[var]) -:[?something] -} -|} in - let rewrite_template = {| -catch (:[type] :[var]) { -:[anything] -logger.:[logMethod]("", :[var]) -:[something] -} -|} in - run source match_template rewrite_template; - [%expect_exact {| -try { - foo() -} -catch (Exception e) { - -logger.error("", e) -hey -} -|}]; - - let source = {|
content
more content
|} in - let match_template = {||} in - run source match_template rewrite_template; - [%expect_exact {|
content
more content
|}] - -let%expect_test "optional_holes_match_over_coalesced_whitespace_in_strings" = - let source = {|"a c"|} in - let match_template = {|"a :[?b] c"|} in - let rewrite_template = {|/:[?b]/|} in - run source match_template rewrite_template; - [%expect_exact {|//|}]; - - let source = {|"a c"|} in - let match_template = {|"a :[?b] c"|} in - let rewrite_template = {|/:[?b]/|} in - run source match_template rewrite_template; - [%expect_exact {|//|}]; - - (* As of 0.18.0, whitespace is no longer significant for matching inside strings *) - let source = {|"a c"|} in - let match_template = {|"a :[?b] c"|} in - let rewrite_template = {|/:[?b]/|} in - run source match_template rewrite_template; - [%expect_exact {|//|}] - -let%expect_test "optional_holes_substitute" = - let source = {|()|} in - let match_template = {|(:[[?x]]:[ ?w]:[?y]:[?z.])|} in - let rewrite_template = {|/:[x]/:[w]/:[y]/:[z]|} in - run source match_template rewrite_template; - [%expect_exact {|////|}] diff --git a/test/common/test_helpers.ml b/test/common/test_helpers.ml index c68d6d6..e2a862a 100644 --- a/test/common/test_helpers.ml +++ b/test/common/test_helpers.ml @@ -32,7 +32,7 @@ let run ?(configuration = configuration) (module M : Matchers.Matcher.S) source | None -> Language.Rule.create "where true" |> Or_error.ok_exn in M.all ~configuration ~template:match_template ~source () - |> List.filter ~f:(fun { Match.environment; _ } -> Language.Rule.(sat @@ apply rule environment)) + |> List.filter ~f:(fun { Match.environment; _ } -> Language.Rule.(sat @@ apply ~matcher:(module M) rule environment)) |> function | [] -> print_string "No matches." | results ->