changing %mik to have anchoring behavior, new extensions

- extensions ending in `_i` are case insensitive, as before
- extensions with an `s` are `search` extensions, meaning, they aren't
  anchored (`^` is not automatically added)
- fixed issue with type conversion when there was only one capture

Author: zazedd

MIK.md

@@ -96,7 +96,7 @@ Values are also available at the guard level:
 let%mik num = {| digit+ |}
 
 let do_something = function%mik
-  | {|/ ... (num as n) ... /|} when n = 123 -> ...
+  | {|/ ... (num as n) ... /|} when n = "123" -> ...
   | _ -> ...
 ```
 
@@ -107,7 +107,7 @@ It is possible to convert variables to `int` of `float` on the fly:
 let%mik num = {| digit+ |}
 
 let do_something = function%mik
-  | {|/ 'd' (num as n : int) ... /|} -> ... (* (n : int) available here *)
+  | {|/ 'd' (num as n : int) ... /|} when n = 123 -> ... (* (n : int) available here *)
   | {|/ 'f' (num as n : float) ... /|} -> ... (* (n : float) available here *)
   | _ -> ...
 ```
@@ -175,6 +175,33 @@ function%mik
 This match expression will compile all of the REs in the branches into one, and use marks to find which branch was executed.  
 Efficient if you have multiple branches.
 
+#### `match%miks` and `function%miks` (search, not anchored)
+
+The previous extension was **anchored**, meaning, it will only match at the beginning of the string.
+
+This version is not, meaning, for example:
+
+```ocaml
+let mik_test = function%mik
+  | {|/ (digit+ as num) /|} -> ...
+  ...
+  | _ -> failwith "no match"
+
+let () = mik_test "123" ...     (* match *)
+let () = mik_test "test123" ... (* ERROR: no match *)
+
+(* but, with %miks... *)
+let miks_test = function%miks
+  | {|/ (digit+ as num) /|} -> ...
+  ...
+  | _ -> failwith "no match"
+
+let () = miks_test "123" ...     (* match *)
+let () = miks_test "test123" ... (* match *)
+```
+
+Similar for `%miks_i`, except it is case insensitive.
+
 #### General match/function
 
 ```ocaml
@@ -183,11 +210,17 @@ function
   | {%mik|/ some regex /|} -> ...
   ...
   | "another string" -> ...
+  | {%miks|/ some regex /|} -> ... (* non-anchored *)
+  ...
+  | "yet another string" -> ...
   | {%mik_i|/ another regex /|} -> ... (* case insensitive *)
+  ...
+  | "would you guess it" -> ...
+  | {%miks_i|/ another regex /|} -> ... (* non-anchored, case insensitive *)
   | _ -> ...
 ```
 
 This match expression will compile all of the REs **individually**, and test each one in sequence.  
 Recommended if you only matching one RE. It is less efficient than the first option for more than one RE, but allows raw string matching.
 
-It keeps all of the features of the previous extension, explored in [Semantics](#Semantics_and_Examples)
+It keeps all of the features (guards and such) of the previous extension, explored in [Semantics](#Semantics_and_Examples)

ppx_regexp/ppx_regexp.ml

@@ -67,26 +67,42 @@ let transformation ctx =
         | _ -> Util.error ~loc "[%%pcre] and [%%mik] only apply to match, function and global let declarations of strings."
       in
       match e_ext.pexp_desc with
-      (* match%mik/match%pcre and function%mik/function%pcre*)
+      (* match%mik/match%pcre and function%mik/function%pcre, anchored *)
       | Pexp_extension ({ txt = ("pcre" | "mik" | "pcre_i" | "mik_i") as ext; _ }, PStr [ { pstr_desc = Pstr_eval (e, _); _ } ]) ->
         let mode = if String.starts_with ~prefix:"pcre" ext then `Pcre else `Mik in
-        let opts = if String.ends_with ~suffix:"_i" ext then [ `Caseless ] else [] in
+        let opts =
+          if String.ends_with ~suffix:"_i" ext then `Caseless :: `Anchored :: Util.default_opts else `Anchored :: Util.default_opts
+        in
+        let loc = e.pexp_loc in
+        make_transformations ~mode ~opts ~loc e.pexp_desc
+      (* match%miks/match%pcres and function%miks/function%pcres, non anchored (search) *)
+      | Pexp_extension ({ txt = ("pcres" | "miks" | "pcres_i" | "miks_i") as ext; _ }, PStr [ { pstr_desc = Pstr_eval (e, _); _ } ]) ->
+        let mode = if String.starts_with ~prefix:"pcre" ext then `Pcre else `Mik in
+        let opts = if String.ends_with ~suffix:"_i" ext then `Caseless :: Util.default_opts else Util.default_opts in
         let loc = e.pexp_loc in
         make_transformations ~mode ~opts ~loc e.pexp_desc
       (* match smth with | {%mik|some regex|} -> ...*)
       | Pexp_match (matched_expr, cases) ->
         let has_ext_case =
           List.exists
-            (fun case ->
-              match case.pc_lhs.ppat_desc with Ppat_extension ({ txt = "pcre" | "mik" | "pcre_i" | "mik_i"; _ }, _) -> true | _ -> false)
+            begin
+              fun case ->
+                match case.pc_lhs.ppat_desc with
+                | Ppat_extension ({ txt = "pcre" | "pcres" | "mik" | "miks" | "pcre_i" | "pcres_i" | "mik_i" | "miks_i"; _ }, _) -> true
+                | _ -> false
+            end
             cases
         in
         if has_ext_case then Transformations.transform_mixed_match ~loc:e_ext.pexp_loc ~ctx ~matched_expr cases acc else e_ext, acc
       | Pexp_function cases ->
         let has_ext_case =
           List.exists
-            (fun case ->
-              match case.pc_lhs.ppat_desc with Ppat_extension ({ txt = "pcre" | "mik" | "pcre_i" | "mik_i"; _ }, _) -> true | _ -> false)
+            begin
+              fun case ->
+                match case.pc_lhs.ppat_desc with
+                | Ppat_extension ({ txt = "pcre" | "pcres" | "mik" | "miks" | "pcre_i" | "pcres_i" | "mik_i" | "miks_i"; _ }, _) -> true
+                | _ -> false
+            end
             cases
         in
         if has_ext_case then Transformations.transform_mixed_match ~loc:e_ext.pexp_loc ~ctx cases acc else e_ext, acc

ppx_regexp/transformations.ml

@@ -26,7 +26,7 @@ module Regexp = struct
           nG', ((res, None, Some (Pipe_all_func func), must_match) :: inner_bs) @ bs
       | Call _ -> Util.error ~loc "(&...) is not implemented for %%pcre and %%mik."
     in
-    function { Location.txt = Capture_as (idr, _, e); _ } -> recurse true e (0, [ idr, None, None, true ]) | e -> recurse true e (0, [])
+    function { Location.txt = Capture_as (idr, conv, e); _ } -> recurse true e (0, [ idr, None, conv, true ]) | e -> recurse true e (0, [])
 
   let to_string ~ctx =
     let p_alt, p_seq, p_suffix, p_atom = 0, 1, 2, 3 in
@@ -129,6 +129,12 @@ let rec separate_defaults acc = function
   | ({ pc_lhs = { ppat_desc = Ppat_var _; _ }; _ } as case) :: rest -> acc, case :: rest
   | case :: rest -> separate_defaults (case :: acc) rest
 
+let rec create_opts ~loc = function
+  | [] -> [%expr []]
+  | `Caseless :: xs -> [%expr `Caseless :: [%e create_opts ~loc xs]]
+  | `Anchored :: xs -> [%expr `Anchored :: [%e create_opts ~loc xs]]
+  | `Dollar_endonly :: xs -> [%expr `Dollar_endonly :: [%e create_opts ~loc xs]]
+
 let extract_bindings ~(parser : ?pos:position -> string -> string Regexp_types.t) ~ctx ~pos s =
   let r = parser ~pos s in
   let nG, bs = Regexp.bindings r in
@@ -241,7 +247,7 @@ let transform_cases ~mode ~opts ~loc ~ctx cases =
 
   let res = pexp_array ~loc @@ List.map (fun (re, _, _) -> re) processed_cases in
 
-  let opts_expr = match opts with [] -> [%expr []] | [ `Caseless ] -> [%expr [ `Caseless ]] | _ -> failwith "Unknown option" in
+  let opts_expr = create_opts ~loc opts in
 
   let comp =
     [%expr
@@ -319,10 +325,23 @@ let transform_mixed_match ~loc ~ctx ?matched_expr cases acc =
     match case.pc_lhs.ppat_desc with
     | Ppat_extension
         ( { txt = ("pcre" | "mik" | "pcre_i" | "mik_i") as ext; _ },
+          (* anchored *)
+          PStr [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_constant (Pconst_string (pat, str_loc, _)); _ }, _); _ } ] ) ->
+      let pos = str_loc.loc_start in
+      let mode = if String.starts_with ~prefix:"pcre" ext then `Pcre else `Mik in
+      let opts =
+        if String.ends_with ~suffix:"_i" ext then `Caseless :: `Anchored :: Util.default_opts else `Anchored :: Util.default_opts
+      in
+      let parser = match mode with `Pcre -> Regexp.parse_exn ~target:`Match | `Mik -> Regexp.parse_mik_exn ~target:`Match in
+      let re, bs, nG = extract_bindings ~parser ~pos ~ctx pat in
+      `Mik (opts, re, nG, bs, case.pc_rhs, case.pc_guard)
+    | Ppat_extension
+        ( { txt = ("pcres" | "miks" | "pcres_i" | "miks_i") as ext; _ },
+          (* search, non anchored *)
           PStr [ { pstr_desc = Pstr_eval ({ pexp_desc = Pexp_constant (Pconst_string (pat, str_loc, _)); _ }, _); _ } ] ) ->
       let pos = str_loc.loc_start in
       let mode = if String.starts_with ~prefix:"pcre" ext then `Pcre else `Mik in
-      let opts = if String.ends_with ~suffix:"_i" ext then [ `Caseless ] else [] in
+      let opts = if String.ends_with ~suffix:"_i" ext then `Caseless :: Util.default_opts else Util.default_opts in
       let parser = match mode with `Pcre -> Regexp.parse_exn ~target:`Match | `Mik -> Regexp.parse_mik_exn ~target:`Match in
       let re, bs, nG = extract_bindings ~parser ~pos ~ctx pat in
       `Mik (opts, re, nG, bs, case.pc_rhs, case.pc_guard)
@@ -344,9 +363,7 @@ let transform_mixed_match ~loc ~ctx ?matched_expr cases acc =
             match case with
             | `Mik (opts, re, _, _, _, _) ->
               let comp_var = Util.fresh_var () in
-              let opts_expr =
-                match opts with [] -> [%expr []] | [ `Caseless ] -> [%expr [ `Caseless ]] | _ -> failwith "Unknown option"
-              in
+              let opts_expr = create_opts ~loc opts in
               let comp_expr = [%expr Re.compile (Re.Perl.re ~opts:[%e opts_expr] [%e re])] in
               let binding = value_binding ~loc ~pat:(ppat_var ~loc { txt = comp_var; loc }) ~expr:comp_expr in
               Some (i, comp_var, binding)

ppx_regexp/util.ml

@@ -1,6 +1,7 @@
 open Ppxlib
 open Ast_builder.Default
 
+let default_opts = [ `Dollar_endonly ]
 let error = Location.raise_errorf
 
 let warn ~loc msg e =
@@ -72,6 +73,13 @@ let check_unbounded_recursion ~mode var_name content =
     let n_as_conv = Printf.sprintf {|\(\b%s\b as [^)]*:[^)]*\)|} var_name in
     contains_regex u content || contains_regex n_as content || contains_regex n_as_conv content
 
+let pp_conv = function
+  | None -> "NONE"
+  | Some Regexp_types.Int -> "INT"
+  | Some Regexp_types.Float -> "FLOAT"
+  | Some (Regexp_types.Func func_name) -> Format.sprintf "FUNC_NAME: %s." func_name
+  | Some (Regexp_types.Pipe_all_func func_name) -> Format.sprintf "PIPE_FUNC_NAME: %s" func_name
+
 (* debugging *)
 let rec debug_re indent (ast : string Regexp_types.t) =
   let spaces = String.make indent ' ' in
@@ -97,14 +105,13 @@ let rec debug_re indent (ast : string Regexp_types.t) =
     Printf.printf "%sCapture(\n" spaces;
     debug_re (indent + 2) expr;
     Printf.printf "%s)\n" spaces
-  | Capture_as (name, _, expr) ->
-    Printf.printf "%sCapture_as(%s,\n" spaces name.txt;
+  | Capture_as (name, conv, expr) ->
+    Printf.printf "%sCapture_as(%s, %s,\n" spaces (pp_conv conv) name.txt;
     debug_re (indent + 2) expr;
     Printf.printf "%s)\n" spaces
-  | Named_subs (name, alias, _, expr) ->
-    Printf.printf "%sNamed_subs(%s, %s,\n" spaces name.txt (match alias with Some a -> a.txt | None -> "None");
+  | Named_subs (name, alias, conv, expr) ->
+    Printf.printf "%sNamed_subs(%s, %s, %s,\n" spaces name.txt (pp_conv conv) (match alias with Some a -> a.txt | None -> "None");
     debug_re (indent + 2) expr;
     Printf.printf "%s)\n" spaces
-  | Call longident ->
-    Printf.printf "%sCall(%s)\n" spaces (match longident.txt with Longident.Lident s -> s | _ -> "complex")
+  | Call longident -> Printf.printf "%sCall(%s)\n" spaces (match longident.txt with Longident.Lident s -> s | _ -> "complex")
   | _ -> Printf.printf "%sOther\n" spaces