mirror of
https://github.com/comby-tools/comby.git
synced 2024-08-16 16:50:37 +03:00
support flexible whitespace matching around delimiters
This commit is contained in:
parent
5cf2e20d34
commit
aeff64a4be
@ -486,6 +486,7 @@ module Matchers : sig
|
||||
|
||||
type options =
|
||||
{ nested : bool
|
||||
; strict : bool
|
||||
}
|
||||
|
||||
val create
|
||||
|
@ -960,7 +960,7 @@ module Make (Lang : Types.Language.S) (Meta : Types.Metasyntax.S) (Ext : Types.E
|
||||
|
||||
let all ?configuration ?filepath ?(rule = [Types.Ast.True]) ~template ~source:original_source () : Match.t list =
|
||||
let _ : string option = filepath in
|
||||
let Rule.{ nested } = Rule.options rule in
|
||||
let Rule.{ nested; _ } = Rule.options rule in
|
||||
let template, rule =
|
||||
Preprocess.map_aliases
|
||||
(module Meta)
|
||||
@ -1126,7 +1126,7 @@ module Make (Lang : Types.Language.S) (Meta : Types.Metasyntax.S) (Ext : Types.E
|
||||
?filepath
|
||||
rule
|
||||
env =
|
||||
let Rule.{ nested } = Rule.options rule in
|
||||
let Rule.{ nested; _ } = Rule.options rule in
|
||||
let subrule = if nested then [Types.Ast.True; Option "nested"] else [Types.Ast.True] in
|
||||
Evaluate.apply
|
||||
?substitute_in_place
|
||||
|
@ -578,6 +578,35 @@ module Make (Language : Types.Language.S) (Meta : Metasyntax.S) (Ext : External.
|
||||
quoted string in the template to a parser list should \
|
||||
not fail here"
|
||||
|
||||
let loose_whitespace g =
|
||||
let loose_constants direction p =
|
||||
match parse_string ~consume:All p "_signal_hole" with
|
||||
| Ok (Hole _, _) -> p (* Hole: let it consume spaces *)
|
||||
| Ok _
|
||||
| Error _ ->
|
||||
match direction, parse_string ~consume:All p " " with
|
||||
| _, Ok _ -> p (* Explicit space: let this consume spaces, don't inject stuff *)
|
||||
| `Left, _ -> option "" spaces1 *> p
|
||||
| `Right, _ -> p <* option "" spaces1
|
||||
in
|
||||
let rec aux acc i =
|
||||
function
|
||||
| [] -> acc
|
||||
| [last] ->
|
||||
let p = loose_constants `Right last in
|
||||
acc @ [p]
|
||||
| hd::tl when i = 0 ->
|
||||
let p = loose_constants `Left hd in
|
||||
aux (acc @ [p]) (i + 1) tl
|
||||
| hd::tl ->
|
||||
aux (acc @ [hd]) (i + 1) tl
|
||||
in
|
||||
match g with
|
||||
| [] -> g
|
||||
| [p] ->
|
||||
[loose_constants `Right (loose_constants `Left p)]
|
||||
| l -> aux [] 0 l
|
||||
|
||||
let general_parser_generator rule : (production * 'a) t t =
|
||||
let spaces : (production * 'a) t t =
|
||||
lift
|
||||
@ -593,6 +622,7 @@ module Make (Language : Types.Language.S) (Meta : Metasyntax.S) (Ext : External.
|
||||
|> List.map ~f:(fun (sort, _) -> hole_parser sort Code)
|
||||
|> choice
|
||||
in
|
||||
let strict = Option.(value ~default:false (rule >>| Rule.is_strict)) in
|
||||
fix (fun (generator : (production * 'a) t list t) ->
|
||||
if debug then Format.printf "Descends@.";
|
||||
let nested =
|
||||
@ -604,16 +634,16 @@ module Make (Language : Types.Language.S) (Meta : Metasyntax.S) (Ext : External.
|
||||
if debug then Format.printf "G size: %d; delim %s@." (List.length g) left_delimiter;
|
||||
return @@
|
||||
sequence_chain' @@
|
||||
[string left_delimiter >>= fun result -> r acc (Template_string result)]
|
||||
@ g
|
||||
[ string left_delimiter >>= fun result -> r acc (Template_string result)]
|
||||
@ (if strict then g else loose_whitespace g)
|
||||
@ [ string right_delimiter >>= fun result -> r acc (Template_string result)])
|
||||
in
|
||||
many @@ choice
|
||||
[ code_holes
|
||||
; raw_string_literal_parser (generate_hole_for_literal Raw_string_literal ())
|
||||
; escapable_string_literal_parser (generate_hole_for_literal Escapable_string_literal ())
|
||||
; spaces
|
||||
; nested
|
||||
; spaces
|
||||
; other
|
||||
]
|
||||
>>= fun x ->
|
||||
@ -738,7 +768,7 @@ module Make (Language : Types.Language.S) (Meta : Metasyntax.S) (Ext : External.
|
||||
filepath_ref := filepath;
|
||||
push_matches_ref := !matches_ref;
|
||||
configuration_ref := Option.value configuration ~default:!configuration_ref;
|
||||
let Rule.{ nested } = Rule.options rule in
|
||||
let Rule.{ nested; _ } = Rule.options rule in
|
||||
let template, rule =
|
||||
Preprocess.map_aliases
|
||||
(module Meta)
|
||||
@ -845,8 +875,16 @@ module Make (Language : Types.Language.S) (Meta : Metasyntax.S) (Ext : External.
|
||||
?filepath
|
||||
rule
|
||||
env =
|
||||
let Rule.{ nested } = Rule.options rule in
|
||||
let subrule = if nested then [Types.Ast.True; Option "nested"] else [Types.Ast.True] in
|
||||
let Rule.{ nested; strict } = Rule.options rule in
|
||||
let subrule =
|
||||
let open Types.Ast in
|
||||
[ True ] @
|
||||
match nested, strict with
|
||||
| true, true -> [ Option "nested"; Option "strict"]
|
||||
| true, false -> [ Option "nested" ]
|
||||
| false, true -> [ Option "strict" ]
|
||||
| _ -> []
|
||||
in
|
||||
Evaluate.apply
|
||||
?substitute_in_place
|
||||
?metasyntax
|
||||
|
@ -127,7 +127,10 @@ module Make (Metasyntax : Types.Metasyntax.S) (External : Types.External.S) = st
|
||||
let optional_trailing c = option () (skip (Char.equal c))
|
||||
|
||||
let option_parser =
|
||||
lift (fun _ -> Option "nested") (spaces *> (string Syntax.option_nested) <* spaces)
|
||||
choice
|
||||
[ lift (fun _ -> Option "nested") (spaces *> (string Syntax.option_nested) <* spaces)
|
||||
; lift (fun _ -> Option "strict") (spaces *> (string Syntax.option_strict) <* spaces)
|
||||
]
|
||||
|
||||
let true' = lift (fun _ -> True) (spaces *> string Syntax.true' <* spaces)
|
||||
|
||||
@ -222,9 +225,15 @@ let create
|
||||
|
||||
type options =
|
||||
{ nested : bool
|
||||
; strict : bool
|
||||
}
|
||||
|
||||
let options rule =
|
||||
List.fold rule ~init:{ nested = false } ~f:(fun acc -> function
|
||||
| Types.Ast.Option name when String.(name = Syntax.option_nested) -> { nested = true }
|
||||
List.fold rule ~init:{ nested = false; strict = false } ~f:(fun acc -> function
|
||||
| Types.Ast.Option name when String.(name = Syntax.option_nested) -> { acc with nested = true }
|
||||
| Types.Ast.Option name when String.(name = Syntax.option_strict) -> { acc with strict = true }
|
||||
| _ -> acc)
|
||||
|
||||
let is_strict rule =
|
||||
let { strict; _ } = options rule in
|
||||
strict
|
||||
|
@ -6,6 +6,7 @@ let not_equal = "!="
|
||||
let true' = "true"
|
||||
let false' = "false"
|
||||
let option_nested = "nested"
|
||||
let option_strict = "strict"
|
||||
let pipe_operator = "|"
|
||||
let arrow = "->"
|
||||
|
||||
|
@ -17,6 +17,7 @@
|
||||
test_rewrite_rule
|
||||
test_integration
|
||||
test_match_rule
|
||||
test_rule_options
|
||||
test_python_string_literals
|
||||
test_hole_extensions
|
||||
test_match_offsets
|
||||
|
48
test/common/test_rule_options.ml
Normal file
48
test/common/test_rule_options.ml
Normal file
@ -0,0 +1,48 @@
|
||||
open Core
|
||||
|
||||
open Test_helpers
|
||||
open Comby_kernel
|
||||
open Matchers
|
||||
|
||||
let%expect_test "strict_rule_no_holes" =
|
||||
let source = {|
|
||||
foo( bar) foo(bar) foo( bar ) foo(bar )
|
||||
foo(
|
||||
bar
|
||||
)
|
||||
|} in
|
||||
let match_template = {|foo(bar)|} in
|
||||
let rewrite_template = {|>yes<|} in
|
||||
let rule = "where true" in
|
||||
|
||||
run (module Omega.Generic) source match_template rewrite_template ~rule;
|
||||
[%expect_exact {|
|
||||
>yes< >yes< >yes< >yes<
|
||||
>yes<
|
||||
|}];
|
||||
|
||||
let rule = "where strict" in
|
||||
run (module Omega.Generic) source match_template rewrite_template ~rule;
|
||||
[%expect_exact {|
|
||||
foo( bar) >yes< foo( bar ) foo(bar )
|
||||
foo(
|
||||
bar
|
||||
)
|
||||
|}]
|
||||
|
||||
let%expect_test "strict_rule_with_holes" =
|
||||
let source = {|foo( bar )|} in
|
||||
let match_template = {|foo(:[1])|} in
|
||||
let rewrite_template = {|:[1]|} in
|
||||
let rule = "where true" in
|
||||
|
||||
run (module Omega.Generic) source match_template rewrite_template ~rule;
|
||||
[%expect_exact {| bar |}];
|
||||
|
||||
let source = {|foo( bar,x )|} in
|
||||
let match_template = {|foo(bar,:[1])|} in
|
||||
let rewrite_template = {|:[1]|} in
|
||||
let rule = "where true" in
|
||||
|
||||
run (module Omega.Generic) source match_template rewrite_template ~rule;
|
||||
[%expect_exact {|x |}];
|
Loading…
Reference in New Issue
Block a user