Represent %raw, %ffi and %%raw with parsetree nodes

analysis/reanalyze/src/annotation.ml

@@ -61,7 +61,8 @@ let rec get_attribute_payload check_text (attributes : Typedtree.attributes) =
       match payload with
       | PStr [] -> Some UnrecognizedPayload
       | PStr ({pstr_desc = Pstr_eval (expr, _)} :: _) -> expr |> from_expr
-      | PStr ({pstr_desc = Pstr_extension _} :: _) -> Some UnrecognizedPayload
+      | PStr ({pstr_desc = Pstr_extension _ | Pstr_raw _} :: _) ->
+        Some UnrecognizedPayload
       | PStr ({pstr_desc = Pstr_value _} :: _) -> Some UnrecognizedPayload
       | PStr ({pstr_desc = Pstr_primitive _} :: _) -> Some UnrecognizedPayload
       | PStr ({pstr_desc = Pstr_type _} :: _) -> Some UnrecognizedPayload

analysis/src/completion_front_end.ml

@@ -210,8 +210,7 @@ let rec expr_to_context_path_inner ~(in_jsx_context : bool)
     (e : Parsetree.expression) =
   match e.pexp_desc with
   | Pexp_braces {expr} -> expr_to_context_path_inner ~in_jsx_context expr
-  | Pexp_constant (Pconst_string _ | Pconst_raw_source _) ->
-    Some Completable.CPString
+  | Pexp_constant (Pconst_string _) -> Some Completable.CPString
   | Pexp_template _ -> Some Completable.CPString
   | Pexp_tagged_template {tag} -> (
     match expr_to_context_path ~in_jsx_context tag with
@@ -1289,6 +1288,8 @@ let completion_with_parser1 ~debug ~offset ~pos_cursor ~kind_file
         | Pexp_object_literal fields ->
           List.iter (fun (_, e) -> iterator.expr iterator e) fields
         | Pexp_extension ({txt}, _) -> set_result (CextensionNode txt)
+        | Pexp_raw {kind} ->
+          set_result (CextensionNode (Ast_raw.extension_name kind))
         | Pexp_constant _ -> set_result Cnone
         | Pexp_ident lid ->
           let lid_path = flatten_lid_check_dot lid in

analysis/src/document_symbol.ml

@@ -20,8 +20,7 @@ let get_symbols ~source ~kind_file =
     | Pexp_fun _ -> Lsp.Types.SymbolKind.Function
     | Pexp_braces {expr} -> expr_kind expr
     | Pexp_constraint (e, _) -> expr_kind e
-    | Pexp_constant (Pconst_string _ | Pconst_raw_source _) ->
-      Lsp.Types.SymbolKind.String
+    | Pexp_constant (Pconst_string _) -> Lsp.Types.SymbolKind.String
     | Pexp_template _ -> Lsp.Types.SymbolKind.String
     | Pexp_constant (Pconst_float _ | Pconst_integer _) ->
       Lsp.Types.SymbolKind.Number

analysis/src/dump_ast.ml

@@ -51,7 +51,6 @@ let print_constant const =
     ^ ", semantic="
     ^ String_literal.string_semantic payload
     ^ ")"
-  | Pconst_raw_source source -> "Pconst_raw_source(" ^ source ^ ")"
   | Pconst_float (s, _) -> "Pconst_float(" ^ s ^ ")"
 
 let print_core_type typ ~pos =

analysis/src/utils.ml

@@ -117,6 +117,7 @@ let identify_pexp pexp =
   | Pexp_assert _ -> "Pexp_assert"
   | Pexp_pack _ -> "Pexp_pack"
   | Pexp_extension _ -> "Pexp_extension"
+  | Pexp_raw _ -> "Pexp_raw"
   | Pexp_open _ -> "Pexp_open"
   | Pexp_await _ -> "Pexp_await"
   | Pexp_jsx_element _ -> "Pexp_jsx_element"

changes/raw-extension-nodes.internal.md

@@ -0,0 +1 @@
+- Represent `%raw`, `%ffi` and `%%raw` with dedicated parsetree nodes. https://github.com/rescript-lang/rescript/pull/8879

changes/raw-template-ppx.fix.md

@@ -0,0 +1 @@
+- Fix template and braced payloads of `%raw` and `%ffi` compiling differently when a PPX is used. https://github.com/rescript-lang/rescript/pull/8879

compiler/core/js_implementation.ml

@@ -87,7 +87,8 @@ let all_module_alias (ast : Parsetree.structure) =
       | Pstr_attribute _ -> true
       | Pstr_eval _ | Pstr_value _ | Pstr_primitive _ | Pstr_type _
       | Pstr_typext _ | Pstr_exception _ | Pstr_module _ | Pstr_recmodule _
-      | Pstr_modtype _ | Pstr_open _ | Pstr_include _ | Pstr_extension _ ->
+      | Pstr_modtype _ | Pstr_open _ | Pstr_include _ | Pstr_extension _
+      | Pstr_raw _ ->
         false)
 
 let no_export (rest : Parsetree.structure) : Parsetree.structure =

compiler/ext/config.ml

@@ -1,10 +1,10 @@
-let cmi_magic_number = "Caml1999I037"
+let cmi_magic_number = "Caml1999I038"
 
 (* Magic numbers for marshaled values of the *current* parsetree, whose layout
    changes across compiler versions. *)
-and ast_impl_magic_number = "ResImpl01316"
+and ast_impl_magic_number = "ResImpl01317"
 
-and ast_intf_magic_number = "ResIntf01316"
+and ast_intf_magic_number = "ResIntf01317"
 
 (* 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
@@ -13,7 +13,7 @@ and ast0_impl_magic_number = "Caml1999M022"
 
 and ast0_intf_magic_number = "Caml1999N022"
 
-and cmt_magic_number = "Caml1999T044"
+and cmt_magic_number = "Caml1999T045"
 
 let get_load_path () = (Compiler_request_state.current ()).load_path
 let set_load_path path = (Compiler_request_state.current ()).load_path <- path

compiler/frontend/ast_exp_handle_external.ml

@@ -34,100 +34,101 @@ let handle_debugger loc (payload : Ast_payload.t) =
   | _ ->
     Location.raise_errorf ~loc "%%debugger extension doesn't accept arguments"
 
+let raw_type () =
+  Ast_helper.Typ.arrow
+    [Parg_type {attrs = []; lbl = Nolabel; typ = Ast_helper.Typ.any ()}]
+    (Ast_helper.Typ.any ())
+
+(* [exp] is the string constant holding the JavaScript source. *)
+let raw_expression loc ~is_function (exp : Parsetree.expression) =
+  {
+    exp with
+    pexp_desc =
+      Ast_external_mk.local_external_apply loc
+        ~pval_prim:(Prim_name "#raw_expr") ~pval_type:(raw_type ()) [exp];
+    pexp_attributes =
+      (match !is_function with
+      | None -> exp.pexp_attributes
+      | Some _ -> Ast_attributes.internal_expansive :: exp.pexp_attributes);
+  }
+
+let ffi_error loc =
+  Location.raise_errorf ~loc
+    "%%ffi extension can only be applied to a string containing a JavaScript \
+     function such as \"(x) => ...\""
+
+let ffi_expression loc ~is_function (exp : Parsetree.expression) =
+  (* Wrap a type constraint based on arity.
+     E.g. for arity 2 constrain to type (_, _) => _ *)
+  let wrap_type_constraint (e : Parsetree.expression) =
+    let loc = e.pexp_loc in
+    let any = Ast_helper.Typ.any ~loc:e.pexp_loc () in
+    let arrow ~arity =
+      let effective_arity = if arity = 0 then 1 else arity in
+      let args =
+        Ext_list.init effective_arity (fun _ ->
+            Parsetree.Parg_type {attrs = []; lbl = Nolabel; typ = any})
+      in
+      Ast_helper.Typ.arrow ~loc args any
+    in
+    match !is_function with
+    | Some arity -> Ast_helper.Exp.constraint_ ~loc e (arrow ~arity)
+    | _ -> ffi_error loc
+  in
+  match !is_function with
+  | None -> ffi_error loc
+  | Some _ -> wrap_type_constraint (raw_expression loc ~is_function exp)
+
+let raw_structure loc (exp : Parsetree.expression) =
+  Ast_helper.Str.eval
+    {
+      exp with
+      pexp_desc =
+        Ast_external_mk.local_external_apply loc
+          ~pval_prim:(Prim_name "#raw_stmt") ~pval_type:(raw_type ()) [exp];
+    }
+
 let handle_raw loc payload =
   let is_function = ref None in
   match
     Ast_payload.raw_as_string_exp_exn ~kind:Raw_exp ~is_function payload
   with
   | None ->
     Location.raise_errorf ~loc "%%raw extension can only be applied to a string"
-  | Some exp ->
-    {
-      exp with
-      pexp_desc =
-        Ast_external_mk.local_external_apply loc
-          ~pval_prim:(Prim_name "#raw_expr")
-          ~pval_type:
-            (Ast_helper.Typ.arrow
-               [
-                 Parg_type
-                   {attrs = []; lbl = Nolabel; typ = Ast_helper.Typ.any ()};
-               ]
-               (Ast_helper.Typ.any ()))
-          [exp];
-      pexp_attributes =
-        (match !is_function with
-        | None -> exp.pexp_attributes
-        | Some _ -> Ast_attributes.internal_expansive :: exp.pexp_attributes);
-    }
+  | Some exp -> raw_expression loc ~is_function exp
 
 let handle_ffi ~loc ~payload =
   let is_function = ref None in
-  let err () =
-    Location.raise_errorf ~loc
-      "%%ffi extension can only be applied to a string containing a JavaScript \
-       function such as \"(x) => ...\""
-  in
   match
     Ast_payload.raw_as_string_exp_exn ~kind:Raw_exp ~is_function payload
   with
-  | None -> err ()
-  | Some exp ->
-    (* Wrap a type constraint based on arity.
-       E.g. for arity 2 constrain to type (_, _) => _ *)
-    let wrap_type_constraint (e : Parsetree.expression) =
-      let loc = e.pexp_loc in
-      let any = Ast_helper.Typ.any ~loc:e.pexp_loc () in
-      let arrow ~arity =
-        let effective_arity = if arity = 0 then 1 else arity in
-        let args =
-          Ext_list.init effective_arity (fun _ ->
-              Parsetree.Parg_type {attrs = []; lbl = Nolabel; typ = any})
-        in
-        Ast_helper.Typ.arrow ~loc args any
-      in
-      match !is_function with
-      | Some arity -> Ast_helper.Exp.constraint_ ~loc e (arrow ~arity)
-      | _ -> err ()
-    in
-    wrap_type_constraint
-      {
-        exp with
-        pexp_desc =
-          Ast_external_mk.local_external_apply loc
-            ~pval_prim:(Prim_name "#raw_expr")
-            ~pval_type:
-              (Ast_helper.Typ.arrow
-                 [
-                   Parg_type
-                     {attrs = []; lbl = Nolabel; typ = Ast_helper.Typ.any ()};
-                 ]
-                 (Ast_helper.Typ.any ()))
-            [exp];
-        pexp_attributes =
-          (match !is_function with
-          | None -> exp.pexp_attributes
-          | Some _ -> Ast_attributes.internal_expansive :: exp.pexp_attributes);
-      }
+  | None -> ffi_error loc
+  | Some exp -> ffi_expression loc ~is_function exp
 
 let handle_raw_structure loc payload =
   match Ast_payload.raw_as_string_exp_exn ~kind:Raw_program payload with
-  | Some exp ->
-    Ast_helper.Str.eval
-      {
-        exp with
-        pexp_desc =
-          Ast_external_mk.local_external_apply loc
-            ~pval_prim:(Prim_name "#raw_stmt")
-            ~pval_type:
-              (Ast_helper.Typ.arrow
-                 [
-                   Parg_type
-                     {attrs = []; lbl = Nolabel; typ = Ast_helper.Typ.any ()};
-                 ]
-                 (Ast_helper.Typ.any ()))
-            [exp];
-      }
+  | Some exp -> raw_structure loc exp
   | None ->
     Location.raise_errorf ~loc
       "%%%%raw extension can only be applied to a string"
+
+(* The string constant holding the JavaScript source of a raw node, validated
+   like a raw payload. *)
+let raw_source_expression ~(kind : Js_raw_info.raw_kind) ?is_function
+    (source : Parsetree.raw_source) =
+  let str = Ast_raw.js_source source in
+  let loc = Ast_raw.payload_loc source in
+  Ast_payload.validate_raw_source ~kind ?is_function ~loc
+    ~offset:(Bs_flow_ast_utils.flow_deli_offset (Some "js"))
+    str;
+  Ast_helper.Exp.constant ~loc (Ast_helper.Const.string str)
+
+let handle_raw_node ~loc (kind : Parsetree.raw_kind) source =
+  let is_function = ref None in
+  let exp = raw_source_expression ~kind:Raw_exp ~is_function source in
+  match kind with
+  | Raw_expression -> raw_expression loc ~is_function exp
+  | Raw_function -> ffi_expression loc ~is_function exp
+
+let handle_raw_structure_node ~loc source =
+  raw_structure loc (raw_source_expression ~kind:Raw_program source)

compiler/frontend/ast_exp_handle_external.mli

@@ -30,3 +30,14 @@ val handle_raw : Location.t -> Ast_payload.t -> Parsetree.expression
 
 val handle_raw_structure :
   Location.t -> Ast_payload.t -> Parsetree.structure_item
+
+val handle_raw_node :
+  loc:Location.t ->
+  Parsetree.raw_kind ->
+  Parsetree.raw_source ->
+  Parsetree.expression
+(** Lower [%raw] or [%ffi], located at [loc]. *)
+
+val handle_raw_structure_node :
+  loc:Location.t -> Parsetree.raw_source -> Parsetree.structure_item
+(** Lower [%%raw], located at [loc]. *)

compiler/frontend/bs_builtin_ppx.ml

@@ -143,14 +143,16 @@ let expr_mapper ~async_context ~in_function_def (self : mapper)
                Parg_type {attrs = []; lbl = Nolabel; typ = Ast_helper.Typ.any ()};
              ]
              (Ast_helper.Typ.any ()))
-        [Ast_helper.Exp.constant ~loc (Pconst_raw_source source)]
+        [Ast_helper.Exp.constant ~loc (Ast_helper.Const.string 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_raw {kind; name_loc; source} ->
+    Ast_exp_handle_external.handle_raw_node ~loc:name_loc kind source
   | Pexp_constant (Pconst_integer (s, Some 'l')) ->
     {e with pexp_desc = Pexp_constant (Pconst_integer (s, None))}
   (* End rewriting *)
@@ -752,6 +754,9 @@ let rec structure_mapper ~await_context (self : mapper) (stru : Ast_structure.t)
     | Pstr_extension (({txt = "raw"; loc}, payload), _attrs) ->
       Ast_exp_handle_external.handle_raw_structure loc payload
       :: structure_mapper ~await_context self rest
+    | Pstr_raw {name_loc; source} ->
+      Ast_exp_handle_external.handle_raw_structure_node ~loc:name_loc source
+      :: structure_mapper ~await_context self rest
     (* | Pstr_extension (({txt = "i"}, _),_)
        ->
        structure_mapper self rest *)

compiler/gentype/annotation.ml

@@ -73,7 +73,8 @@ let rec get_attribute_payload check_text (attributes : Typedtree.attributes) =
       match payload with
       | PStr [] -> Some UnrecognizedPayload
       | PStr ({pstr_desc = Pstr_eval (expr, _)} :: _) -> expr |> from_expr
-      | PStr ({pstr_desc = Pstr_extension _} :: _) -> Some UnrecognizedPayload
+      | PStr ({pstr_desc = Pstr_extension _ | Pstr_raw _} :: _) ->
+        Some UnrecognizedPayload
       | PStr ({pstr_desc = Pstr_value _} :: _) -> Some UnrecognizedPayload
       | PStr ({pstr_desc = Pstr_primitive _} :: _) -> Some UnrecognizedPayload
       | PStr ({pstr_desc = Pstr_type _} :: _) -> Some UnrecognizedPayload

compiler/ml/ast_helper.ml

@@ -194,6 +194,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 raw ?loc ?attrs ~name_loc kind source =
+    mk ?loc ?attrs (Pexp_raw {kind; name_loc; source})
   let regexp ?loc ?attrs pattern flags =
     mk ?loc ?attrs (Pexp_regexp {pattern; flags})
   let template ?loc ?attrs source_segments values =
@@ -318,6 +320,8 @@ module Str = struct
   let open_ ?loc a = mk ?loc (Pstr_open a)
   let include_ ?loc a = mk ?loc (Pstr_include a)
   let extension ?loc ?(attrs = []) a = mk ?loc (Pstr_extension (a, attrs))
+  let raw ?loc ?(attrs = []) ~name_loc source =
+    mk ?loc (Pstr_raw {name_loc; source; attrs})
   let attribute ?loc a = mk ?loc (Pstr_attribute a)
 end
 

compiler/ml/ast_helper.mli

@@ -238,6 +238,13 @@ module Exp : sig
   val open_ :
     ?loc:loc -> ?attrs:attrs -> override_flag -> lid -> expression -> expression
   val extension : ?loc:loc -> ?attrs:attrs -> extension -> expression
+  val raw :
+    ?loc:loc ->
+    ?attrs:attrs ->
+    name_loc:loc ->
+    raw_kind ->
+    raw_source ->
+    expression
   val tagged_template :
     ?loc:loc ->
     ?attrs:attrs ->
@@ -439,6 +446,8 @@ module Str : sig
   val open_ : ?loc:loc -> open_description -> structure_item
   val include_ : ?loc:loc -> include_declaration -> structure_item
   val extension : ?loc:loc -> ?attrs:attrs -> extension -> structure_item
+  val raw :
+    ?loc:loc -> ?attrs:attrs -> name_loc:loc -> raw_source -> structure_item
   val attribute : ?loc:loc -> attribute -> structure_item
 end
 

compiler/ml/ast_iterator.ml

@@ -278,6 +278,10 @@ module M = struct
     | Pstr_extension (x, attrs) ->
       sub.extension sub x;
       sub.attributes sub attrs
+    | Pstr_raw {name_loc; source; attrs} ->
+      sub.location sub name_loc;
+      sub.location sub (Ast_raw.source_loc source);
+      sub.attributes sub attrs
     | Pstr_attribute x -> sub.attribute sub x
 end
 
@@ -416,6 +420,9 @@ module E = struct
       iter_loc sub lid;
       sub.expr sub e
     | Pexp_extension x -> sub.extension sub x
+    | Pexp_raw {name_loc; source} ->
+      sub.location sub name_loc;
+      sub.location sub (Ast_raw.source_loc source)
     | Pexp_regexp _ -> ()
     | Pexp_template {values} -> List.iter (sub.expr sub) values
     | Pexp_tagged_template {tag; values} ->