comby-tools/comby
1
1
Fork 0
mirror of https://github.com/comby-tools/comby.git synced 2024-08-16 16:50:37 +03:00
Code Issues Packages Projects Releases Wiki Activity

fix rewrite bug in alternative matcher

Browse Source
This commit is contained in:
Rijnard van Tonder 2021-05-19 02:39:32 -07:00
parent 22f98a193a
commit 7d9eb26c71
3 changed files with 14 additions and 46 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

5
lib/kernel/matchers/omega.ml
View File

@ -78,7 +78,6 @@ module Make (Language : Types.Language.S) (Meta : Metasyntax.S) = struct
| None -> Some (Environment.add ~range environment identifier matched)
| Some _ when String.(identifier = wildcard) -> Some environment
| Some existing_value ->
if debug then Format.printf "Existing: identifier: %s Value: %s@." identifier existing_value;
let Range.{ match_start = { offset; _ }; _ } = Option.value_exn (Environment.lookup_range environment identifier) in
if offset = range.match_start.offset then
(* case when already present from rest parser *)
@ -180,7 +179,7 @@ module Make (Language : Types.Language.S) (Meta : Metasyntax.S) = struct
if debug then Format.printf "No new_env@.";
if rewrite then Buffer.add_string actual match_context.matched
| Some env ->
if debug then Format.printf "Some new env@.";
if debug then Format.printf "Some new env %s@." @@ Match.Environment.to_string env;
current_environment_ref := env;
begin
let result, _ = Template.substitute (Template.parse !rewrite_template) !current_environment_ref in
@ -189,7 +188,7 @@ module Make (Language : Types.Language.S) (Meta : Metasyntax.S) = struct
shouldn't, and instead just ignore. *)
Buffer.add_string actual result;
end;
matches_ref := match_context :: !matches_ref
matches_ref := { match_context with environment = !current_environment_ref } :: !matches_ref
let multiline left right =
let open Parsers.Comments.Omega.Multiline in

19
test/common/test_helpers.ml
View File

@ -81,22 +81,3 @@ let run_all_matches (module M : Matchers.Matcher.S) ?(format = `Json) source ?ru
let matches = List.map l ~f:(Match.convert_offset ~fast:true ~source) in
Format.asprintf "%a" Match.pp (None, matches)
|> print_string
let run_rule (module E : Engine.S) source match_template rewrite_template rule =
let (module M : Matcher.S) = (module E.Generic) in
M.first ~configuration match_template source
|> function
| Error _ -> print_string "bad"
| Ok result ->
match result with
| ({ environment; _ } as m) ->
let e = Rule.(result_env @@ apply ~match_all:(M.all ~rule:[Ast.True]) rule environment) in
match e with
| None -> print_string "bad bad"
| Some e ->
{ m with environment = e }
|> List.return
|> Rewrite.all ~source ~rewrite_template
|> (fun x -> Option.value_exn x)
|> (fun { rewritten_source; _ } -> rewritten_source)
|> print_string

36
test/common/test_rewrite_rule.ml
View File

@ -13,14 +13,12 @@ let%expect_test "rewrite_rule" =
{|
where rewrite :[1] { "int" -> "expect" }
|}
|> Rule.create
|> Or_error.ok_exn
in
run_rule (module Alpha) source match_template rewrite_template rule;
run (module Alpha.Generic) source match_template rewrite_template ~rule;
[%expect_exact {|expect|}];
run_rule (module Omega) source match_template rewrite_template rule;
run (module Omega.Generic) source match_template rewrite_template ~rule;
[%expect_exact {|expect|}]
let%expect_test "sequenced_rewrite_rule" =
@ -34,14 +32,12 @@ let%expect_test "sequenced_rewrite_rule" =
rewrite :[a] { "a" -> "qqq" },
rewrite :[rest] { "{ b : { :[other] } }" -> "{ :[other] }" }
|}
|> Rule.create
|> Or_error.ok_exn
in
run_rule (module Alpha) source match_template rewrite_template rule;
run (module Alpha.Generic) source match_template rewrite_template ~rule;
[%expect_exact {|{ { qqq : { c : d } } }|}];
run_rule (module Omega) source match_template rewrite_template rule;
run (module Omega.Generic) source match_template rewrite_template ~rule;
[%expect_exact {|{ { qqq : { c : d } } }|}]
let%expect_test "rewrite_rule_for_list" =
@ -53,14 +49,12 @@ let%expect_test "rewrite_rule_for_list" =
{|
where rewrite :[contents] { ":[[x]]," -> ":[[x]];" }
|}
|> Rule.create
|> Or_error.ok_exn
in
run_rule (module Alpha) source match_template rewrite_template rule;
run (module Alpha.Generic) source match_template rewrite_template ~rule;
[%expect_exact {|[1; 2; 3; 4;]|}];
run_rule (module Omega) source match_template rewrite_template rule;
run (module Omega.Generic) source match_template rewrite_template ~rule;
[%expect_exact {|[1; 2; 3; 4;]|}]
let%expect_test "rewrite_rule_for_list_strip_last" =
@ -72,14 +66,12 @@ let%expect_test "rewrite_rule_for_list_strip_last" =
{|
where rewrite :[contents] { ":[x], " -> ":[x]; " }
|}
|> Rule.create
|> Or_error.ok_exn
in
run_rule (module Alpha) source match_template rewrite_template rule;
run (module Alpha.Generic) source match_template rewrite_template ~rule;
[%expect_exact {|[1; 2; 3; 4]|}];
run_rule (module Omega) source match_template rewrite_template rule;
run (module Omega.Generic) source match_template rewrite_template ~rule;
[%expect_exact {|[1; 2; 3; 4]|}]
let%expect_test "haskell_example" =
@ -96,18 +88,16 @@ let%expect_test "haskell_example" =
{|
where rewrite :[contents] { "," -> "++" }
|}
|> Rule.create
|> Or_error.ok_exn
in
run_rule (module Alpha) source match_template rewrite_template rule;
run (module Alpha.Generic) source match_template rewrite_template ~rule;
[%expect_exact {|
( "blah blah blah"
++ "blah"
)
|}];
run_rule (module Omega) source match_template rewrite_template rule;
run (module Omega.Generic) source match_template rewrite_template ~rule;
[%expect_exact {|
( "blah blah blah"
++ "blah"
@ -128,16 +118,14 @@ let%expect_test "rewrite_freeform_antecedent_pattern" =
{|
where rewrite :[contents] { concat [:[x]] -> "nice" }
|}
|> Rule.create
|> Or_error.ok_exn
in
run_rule (module Alpha) source match_template rewrite_template rule;
run (module Alpha.Generic) source match_template rewrite_template ~rule;
[%expect_exact {|(
(nice)
)|}];
run_rule (module Omega) source match_template rewrite_template rule;
run (module Omega.Generic) source match_template rewrite_template ~rule;
[%expect_exact {|(
(nice)
)|}]