support flexible whitespace matching around delimiters

lib/kernel/comby_kernel.mli

@@ -486,6 +486,7 @@ module Matchers : sig
 
     type options =
       { nested : bool
+      ; strict : bool
       }
 
     val create

lib/kernel/matchers/alpha.ml

@@ -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

lib/kernel/matchers/omega.ml

@@ -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

lib/kernel/matchers/rule.ml

@@ -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

lib/kernel/matchers/syntax.ml

@@ -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 = "->"
 

test/common/dune

@@ -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

test/common/test_rule_options.ml

@@ -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  |}];