Represent regexp literals with a dedicated AST node

Signed-off-by: Christoph Knittel <ck@cca.io>

^ Conflicts:
^	tests/ounit_tests/ounit_lambda_constant_tests.ml

Author: cknitt

CHANGELOG.md

@@ -80,6 +80,7 @@
 
 #### :house: Internal
 
+- Give regexp literals a dedicated AST node. https://github.com/rescript-lang/rescript/pull/8610
 - Developer playground: Make panes resizable with wrapping text. https://github.com/rescript-lang/rescript/pull/8628
 - Normalize Lambda terms where they are built: a match guard stays structured data until its fallthrough is known, and `apply` and `mk_builtin` go through the folding constructors. https://github.com/rescript-lang/rescript/pull/8615
 - Replace non-escaping local mutable blocks with scalar bindings when all uses are direct field accesses, generalizing reference unboxing to multi-field records and references captured by JavaScript closures. https://github.com/rescript-lang/rescript/pull/8617

analysis/src/dump_ast.ml

@@ -267,6 +267,8 @@ and print_expr_item expr ~pos ~indentation =
     ^ ")"
   | Pexp_extension (({txt} as loc), _) ->
     "Pexp_extension(%" ^ (loc |> print_loc_denominator_loc ~pos) ^ txt ^ ")"
+  | Pexp_regexp {pattern; flags} ->
+    "Pexp_regexp(/" ^ pattern ^ "/" ^ flags ^ ")"
   | Pexp_template {source_segments; values} ->
     "Pexp_template(source_segments=["
     ^ String.concat ", " (List.map (fun {Asttypes.txt} -> txt) source_segments)

analysis/src/utils.ml

@@ -118,6 +118,7 @@ let identify_pexp pexp =
   | Pexp_open _ -> "Pexp_open"
   | Pexp_await _ -> "Pexp_await"
   | Pexp_jsx_element _ -> "Pexp_jsx_element"
+  | Pexp_regexp _ -> "Pexp_regexp"
   | Pexp_template _ -> "Pexp_template"
   | Pexp_tagged_template _ -> "Pexp_tagged_template"
 

compiler/ext/config.ml

@@ -2,9 +2,9 @@ let cmi_magic_number = "Caml1999I034"
 
 (* Magic numbers for marshaled values of the *current* parsetree, whose layout
    changes across compiler versions. *)
-and ast_impl_magic_number = "ResImpl01307"
+and ast_impl_magic_number = "ResImpl01308"
 
-and ast_intf_magic_number = "ResIntf01307"
+and ast_intf_magic_number = "ResIntf01308"
 
 (* Magic numbers of the frozen Parsetree0 (OCaml 4.06) layout used on the
    external-PPX wire. They must never be written in front of a

compiler/frontend/bs_builtin_ppx.ml

@@ -112,6 +112,23 @@ let expr_mapper ~async_context ~in_function_def (self : mapper)
   in_function_def := false;
   match e.pexp_desc with
   (* Its output should not be rewritten anymore *)
+  | Pexp_regexp {pattern; flags} ->
+    let loc = e.pexp_loc in
+    let source = "/" ^ pattern ^ "/" ^ flags in
+    Ast_payload.validate_raw_source ~kind:Raw_re ~loc ~offset:0 source;
+    let raw =
+      Ast_external_mk.local_external_apply loc
+        ~pval_prim:(Prim_name "#raw_expr")
+        ~pval_type:
+          (Ast_helper.Typ.arrow
+             [{attrs = []; lbl = Nolabel; typ = Ast_helper.Typ.any ()}]
+             (Ast_helper.Typ.any ()))
+        [Ast_helper.Exp.constant ~loc (Pconst_raw_source source)]
+    in
+    Ast_helper.Exp.constraint_ ~loc
+      ~attrs:(self.attributes self e.pexp_attributes)
+      {e with pexp_desc = raw; pexp_attributes = []}
+      (Ast_comb.to_regexp_type loc)
   | Pexp_extension extension ->
     Ast_exp_extension.handle_extension e self extension
   | Pexp_constant (Pconst_integer (s, Some 'l')) ->

compiler/ml/ast_helper.ml

@@ -205,6 +205,8 @@ module Exp = struct
   let pack ?loc ?attrs a = mk ?loc ?attrs (Pexp_pack a)
   let open_ ?loc ?attrs a b c = mk ?loc ?attrs (Pexp_open (a, b, c))
   let extension ?loc ?attrs a = mk ?loc ?attrs (Pexp_extension a)
+  let regexp ?loc ?attrs pattern flags =
+    mk ?loc ?attrs (Pexp_regexp {pattern; flags})
   let template ?loc ?attrs source_segments values =
     mk ?loc ?attrs (Pexp_template {source_segments; values})
   let tagged_template ?loc ?attrs tag raw_sources values =

compiler/ml/ast_helper.mli

@@ -226,6 +226,8 @@ module Exp : sig
   val object_literal :
     ?loc:loc -> ?attrs:attrs -> (str * expression) list -> expression
 
+  val regexp : ?loc:loc -> ?attrs:attrs -> string -> string -> expression
+
   val template :
     ?loc:loc -> ?attrs:attrs -> str list -> expression list -> expression
   val letmodule :

compiler/ml/ast_iterator.ml

@@ -390,6 +390,7 @@ module E = struct
       iter_loc sub lid;
       sub.expr sub e
     | Pexp_extension x -> sub.extension sub x
+    | Pexp_regexp _ -> ()
     | Pexp_template {values} -> List.iter (sub.expr sub) values
     | Pexp_tagged_template {tag; values} ->
       sub.expr sub tag;

compiler/ml/ast_mapper.ml

@@ -352,6 +352,7 @@ module E = struct
     | Pexp_for_await_of (p, e1, e2) ->
       Exp.mk ~loc ~attrs
         (Pexp_for_await_of (sub.pat sub p, sub.expr sub e1, sub.expr sub e2))
+    | Pexp_regexp {pattern; flags} -> regexp ~loc ~attrs pattern flags
     | Pexp_template {source_segments; values} ->
       Exp.template ~loc ~attrs
         (List.map (map_loc sub) source_segments)

compiler/ml/ast_mapper_from0.ml

@@ -123,7 +123,7 @@ let map_pattern_constant ~loc = function
   | constant -> map_constant ~loc constant
 
 let is_raw_source_extension = function
-  | "raw" | "ffi" | "re" -> true
+  | "raw" | "ffi" -> true
   | _ -> false
 
 let map_raw_source_payload sub = function
@@ -1132,6 +1132,49 @@ module E = struct
     | Pexp_pack me -> pack ~loc ~attrs (sub.module_expr sub me)
     | Pexp_open (ovf, lid, e) ->
       open_ ~loc ~attrs ovf (map_loc sub lid) (sub.expr sub e)
+    | Pexp_extension ({txt = "re"}, payload) -> (
+      let malformed ~loc =
+        Location.raise_errorf ~loc
+          "A PPX returned a malformed regexp payload. Expected a string \
+           containing one regexp literal."
+      in
+      match payload with
+      | PStr
+          [
+            {
+              pstr_desc =
+                Pstr_eval
+                  ( {
+                      pexp_desc = Pexp_constant (Pconst_string (source, _));
+                      pexp_loc = source_loc;
+                      pexp_attributes = source_attrs;
+                    },
+                    eval_attrs );
+            };
+          ] -> (
+        let env = Parser_env.init_env None source in
+        let (_, expression), errors =
+          Parser_flow.do_parse env Parser_flow.Parse.expression false
+        in
+        match expression with
+        | Flow_ast.Expression.RegExpLiteral {pattern; raw}
+          when errors = [] && Parser_env.Peek.token env = Token.T_EOF ->
+          (* Flow filters unknown flags in its [flags] field. Keep the raw
+             spelling so the bridge never silently changes a PPX's regexp. *)
+          let flags_start = String.length pattern + 2 in
+          let flags =
+            String.sub raw flags_start (String.length raw - flags_start)
+          in
+          (* Payload wrappers disappear at this boundary. Keep the expression's
+             location and transfer both levels of payload attributes to it. *)
+          regexp ~loc
+            ~attrs:
+              (attrs
+              @ sub.attributes sub eval_attrs
+              @ sub.attributes sub source_attrs)
+            pattern flags
+        | _ -> malformed ~loc:(sub.location sub source_loc))
+      | _ -> malformed ~loc)
     | Pexp_extension x -> extension ~loc ~attrs (sub.extension sub x)
     | Pexp_unreachable -> assert false
 end
@@ -1369,6 +1412,9 @@ let default_mapper =
     location = (fun _this l -> l);
     extension =
       (fun this (s, payload) ->
+        if s.txt = "re" then
+          Location.raise_errorf ~loc:(this.location this s.loc)
+            "A PPX returned a regexp extension outside an expression.";
         let payload =
           if is_raw_source_extension s.txt then
             match map_raw_source_payload this payload with