Oct 12, 2025 · Oct 12, 2025 · Oct 12, 2025 · Oct 13, 2025 · Oct 13, 2025 · Oct 13, 2025
diff --git a/compiler/bsc/rescript_compiler_main.ml b/compiler/bsc/rescript_compiler_main.ml
      string_call (fun s ->
          Js_config.collect_embeds := true;
          let s = String.trim s in
          if s = "all" then (
            Js_config.embed_collect_all := true;
            Js_config.embed_tags := [])
          else
            Js_config.embed_tags :=
              Ext_string.split_by ~keep_empty:false (fun c -> c = ',') s
              |> List.map String.trim),
      "*internal* Collect embed extension occurrences (csv of tags or 'all')" );
          Js_config.embed_tags :=
            Ext_string.split_by ~keep_empty:false (fun c -> c = ',') s
            |> List.map String.trim),
      "*internal* Collect embed extension occurrences (csv of tags)" );
    (* single-pass embed rewrite via PPX; no separate -rewrite-embeds entry *)
    ( "-reprint-source",
      string_call reprint_source_file,
diff --git a/compiler/common/js_config.ml b/compiler/common/js_config.ml

 (* Embed indexing and rewrite configuration *)
 let collect_embeds = ref false
 let embed_collect_all = ref false
 let embed_tags : string list ref = ref []

 let self_stack : string Stack.t = Stack.create ()
diff --git a/compiler/common/js_config.mli b/compiler/common/js_config.mli
 val collect_embeds : bool ref
 (** When true, emit per-module embed index artifacts during parse *)

 val embed_collect_all : bool ref
 (** When true, collect all extension tags; otherwise restrict to [embed_tags] *)

 val embed_tags : string list ref
 (** Comma-separated list of tags to collectwhen [embed_collect_all] = false*)
 (** Comma-separated list of tags to collect *)

 val self_stack : string Stack.t
diff --git a/compiler/frontend/ast_exp_extension.ml b/compiler/frontend/ast_exp_extension.ml
       normalization runs within the literal. For all other extensions,
       leave payload untouched to avoid surprising side-effects. *)
    let is_embed_tag =
      !Js_config.collect_embeds
      && (!Js_config.embed_collect_all || List.mem txt !Js_config.embed_tags)
      !Js_config.collect_embeds && List.mem txt !Js_config.embed_tags
    in
    if is_embed_tag then
      let payload' = self.payload self payload in
diff --git a/compiler/frontend/embed_index.ml b/compiler/frontend/embed_index.ml
 open Parsetree

 let mkdirp path =
  let rec loop p =
    if Sys.file_exists p then ()
    else
      let parent = Filename.dirname p in
      if parent <> p then loop parent;
      try Unix.mkdir p 0o777 with Unix.Unix_error (_, _, _) -> ()
  in
  loop path

 let is_enabled () = !Js_config.collect_embeds

 let should_collect_tag (name : string) : bool =
  if !Js_config.embed_collect_all then true
  else List.mem name !Js_config.embed_tags
  List.mem name !Js_config.embed_tags

 let csv_hash (tag : string) (s : string) : string =
  Digest.(to_hex (string (tag ^ "\n" ^ s)))
  Ext_json_noloc.kvs
    [("start", pos_to_json loc.loc_start); ("end", pos_to_json loc.loc_end)]

 let normalize_slashes (s : string) : string =
  if Sys.win32 || Sys.cygwin then
    String.map (fun c -> if c = '\\' then '/' else c) s
  else s

 let rel_to_cwd (file : string) : string =
  let abs = Ext_path.absolute_cwd_path file in
  let from = Sys.getcwd () in
  let rel = Ext_path.rel_normalized_absolute_path ~from abs in
  let s = if rel = "" then Filename.basename abs else rel in
  normalize_slashes s

 (* Convert a restricted subset of expressions to JSON for config embeds *)
 let rec expr_to_json (e : Parsetree.expression) : Ext_json_noloc.t option =
  match e.pexp_desc with
  | _ -> None

 let write_structure_index ~outprefix ~sourcefile (ast : structure) : unit =
  if not (is_enabled ()) then ()
  else
    (* Skip generated embed files to prevent nested/embed loops *)
    let is_generated =
      try
        (* Fast path: any source under a __generated__ folder *)
        String.contains sourcefile '/'
        && Ext_string.contain_substring sourcefile "/__generated__/"
        ||
        (* Slower path: check for header markers in source text *)
        let ic = open_in sourcefile in
        let l1 = input_line ic in
        let l2 = try input_line ic with End_of_file -> "" in
        close_in_noerr ic;
        Ext_string.contain_substring l1 "@sourceHash"
        || Ext_string.contain_substring l2 "rewatch-embed:"
      with _ -> false
    in
    if is_generated then
      (* Do not emit any embed index for generated files *)
      ()
    else
      let entries = ref [] in
      let counts : (string, int) Hashtbl.t = Hashtbl.create 7 in
      let bump tag =
        let v =
          match Hashtbl.find_opt counts tag with
          | Some i -> i
          | None -> 0
        in
        let v' = v + 1 in
        Hashtbl.replace counts tag v';
        v'
  if is_enabled () then (
    let entries = ref [] in
    let counts : (string, int) Hashtbl.t = Hashtbl.create 7 in
    let bump tag =
      let v =
        match Hashtbl.find_opt counts tag with
        | Some i -> i
        | None -> 0
      in
      let add_entry ~tag ~context ~(data : Ext_json_noloc.t) ~(loc : Location.t)
          =
        let occurrence_index = bump tag in
        let data_str =
          match data with
          | Ext_json_noloc.Arr _ | Ext_json_noloc.Obj _ ->
            Ext_json_noloc.to_string data
          | _ -> Ext_json_noloc.to_string data
        in
        let literal_hash = csv_hash tag data_str in
        let entry =
          Ext_json_noloc.kvs
            [
              ("tag", Ext_json_noloc.str tag);
              ("context", Ext_json_noloc.str context);
              ( "occurrenceIndex",
                Ext_json_noloc.flo (string_of_int occurrence_index) );
              ("range", loc_to_json loc);
              ("data", data);
              ("literalHash", Ext_json_noloc.str literal_hash);
            ]
        in
        entries := entry :: !entries
      let v' = v + 1 in
      Hashtbl.replace counts tag v';
      v'
    in
    let add_entry ~tag ~context ~(data : Ext_json_noloc.t) ~(loc : Location.t) =
      let occurrence_index = bump tag in
      let data_str =
        match data with
        | Ext_json_noloc.Arr _ | Ext_json_noloc.Obj _ ->
          Ext_json_noloc.to_string data
        | _ -> Ext_json_noloc.to_string data
      in
      let normalize_tag (tag : string) : string =
        match Ext_embed.get_embed_tag tag with
        | Some t -> t
        | None -> tag
      let literal_hash = csv_hash tag data_str in
      let entry =
        Ext_json_noloc.kvs
          [
            ("tag", Ext_json_noloc.str tag);
            ("context", Ext_json_noloc.str context);
            ( "occurrenceIndex",
              Ext_json_noloc.flo (string_of_int occurrence_index) );
            ("range", loc_to_json loc);
            ("data", data);
            ("literalHash", Ext_json_noloc.str literal_hash);
          ]
      in
      let rec walk_mod (m : module_expr) (context_for_mod : string option) =
        match m.pmod_desc with
        | Pmod_extension ({txt = tag; loc = _}, payload) ->
          let base_tag = normalize_tag tag in
          if should_collect_tag base_tag then
            match payload_to_data payload with
            | Some (data, loc) ->
              let context =
                match context_for_mod with
                | Some c -> c
                | None -> "module"
              in
              add_entry ~tag:base_tag ~context ~data ~loc
            | None ->
              Location.raise_errorf ~loc:m.pmod_loc
                "%%%s expects a string literal or a JSON-serializable record \
                 literal"
                tag
          else ()
        | Pmod_structure s -> walk_str s
        | Pmod_functor (_name, _arg, body) -> walk_mod body None
        | Pmod_apply (m1, m2) ->
          walk_mod m1 None;
          walk_mod m2 None
        | _ -> ()
      and walk_str (s : structure) =
        List.iter
          (fun (si : structure_item) ->
      entries := entry :: !entries
    in
    let normalize_tag (tag : string) : string =
      match Ext_embed.get_embed_tag tag with
      | Some t -> t
      | None -> tag
    in
    let current_mod_context : string option ref = ref None in
    let with_context ctx f =
      let prev = !current_mod_context in
      current_mod_context := ctx;
      (try f ()
       with e ->
         current_mod_context := prev;
         raise e);
      current_mod_context := prev
    in
    let iter : Ast_iterator.iterator =
      let default_it = Ast_iterator.default_iterator in
      {
        default_it with
        module_expr =
          (fun self m ->
            (match m.pmod_desc with
            | Pmod_extension ({txt = tag; _}, payload) ->
              let base_tag = normalize_tag tag in
              if should_collect_tag base_tag then
                match payload_to_data payload with
                | Some (data, loc) ->
                  let context =
                    Option.value ~default:"module" !current_mod_context
                  in
                  add_entry ~tag:base_tag ~context ~data ~loc
                | None ->
                  Location.raise_errorf ~loc:m.pmod_loc
                    "%%%s expects a string literal or a JSON-serializable \
                     record literal"
                    tag
              else ()
            | _ -> ());
            let prev = !current_mod_context in
            current_mod_context := None;
            default_it.module_expr self m;
            current_mod_context := prev);
        structure_item =
          (fun self si ->
            match si.pstr_desc with
            | Pstr_module {pmb_expr; _} -> walk_mod pmb_expr None
            | Pstr_module {pmb_expr; _} ->
              with_context None (fun () -> self.module_expr self pmb_expr)
            | Pstr_recmodule mbs ->
              List.iter
                (fun ({pmb_expr; _} : module_binding) -> walk_mod pmb_expr None)
                (fun ({pmb_expr; _} : module_binding) ->
                  with_context None (fun () -> self.module_expr self pmb_expr))
                mbs
            | Pstr_include {pincl_mod; _} -> walk_mod pincl_mod (Some "include")
            | _ -> ())
          s
      in
      walk_str ast;
      let iter : Ast_iterator.iterator =
        let default_it = Ast_iterator.default_iterator in
        {
          default_it with
          expr =
            (fun self e ->
              (match e.pexp_desc with
              | Pexp_extension ({txt = tag; _}, payload) ->
                let base_tag = normalize_tag tag in
                if should_collect_tag base_tag then
                  match payload_to_data payload with
                  | Some (data, loc) ->
                    add_entry ~tag:base_tag ~context:"expr" ~data ~loc
                  | None ->
                    Location.raise_errorf ~loc:e.pexp_loc
                      "%%%s expects a string literal or a JSON-serializable \
                       record literal"
                      tag
                else ()
              | _ -> ());
              default_it.expr self e);
        }
      in
      iter.structure iter ast;
      let entries_json =
        !entries |> List.rev |> Array.of_list |> Ext_json_noloc.arr
      in
      let modulename = Ext_filename.module_name outprefix in
      let source_path = rel_to_cwd sourcefile in
      let json =
        Ext_json_noloc.kvs
          [
            ("version", Ext_json_noloc.flo "1");
            ("module", Ext_json_noloc.str modulename);
            ("sourcePath", Ext_json_noloc.str source_path);
            ("embeds", entries_json);
          ]
      in
      let out_dir = Filename.dirname (outprefix ^ Literals.suffix_ast) in
      mkdirp out_dir;
      Ext_json_noloc.to_file (outprefix ^ ".embeds.json") json
            | Pstr_include {pincl_mod; _} ->
              with_context (Some "include") (fun () ->
                  self.module_expr self pincl_mod)
            | _ -> default_it.structure_item self si);
        expr =
          (fun self e ->
            (match e.pexp_desc with
            | Pexp_extension ({txt = tag; _}, payload) ->
              let base_tag = normalize_tag tag in
              if should_collect_tag base_tag then
                match payload_to_data payload with
                | Some (data, loc) ->
                  add_entry ~tag:base_tag ~context:"expr" ~data ~loc
                | None ->
                  Location.raise_errorf ~loc:e.pexp_loc
                    "%%%s expects a string literal or a JSON-serializable \
                     record literal"
                    tag
              else ()
            | _ -> ());
            default_it.expr self e);
      }
    in
    iter.structure iter ast;
    let entries_json =
      !entries |> List.rev |> Array.of_list |> Ext_json_noloc.arr
    in
    let modulename = Ext_filename.module_name outprefix in
    let source_path = sourcefile in
    let json =
      Ext_json_noloc.kvs
        [
          ("version", Ext_json_noloc.flo "1");
          ("module", Ext_json_noloc.str modulename);
          ("sourcePath", Ext_json_noloc.str source_path);
          ("embeds", entries_json);
        ]
    in
    Ext_json_noloc.to_file (outprefix ^ ".embeds.json") json)
Original file line number	Diff line number	Diff line change
Expand Up		@@ -350,14 +350,10 @@ let command_line_flags : (string * Bsc_args.spec * string) array =
		string_call (fun s ->
		Js_config.collect_embeds := true;
		let s = String.trim s in
		if s = "all" then (
		Js_config.embed_collect_all := true;
		Js_config.embed_tags := [])
		else
		Js_config.embed_tags :=
		Ext_string.split_by ~keep_empty:false (fun c -> c = ',') s
		\|> List.map String.trim),
		"internal Collect embed extension occurrences (csv of tags or 'all')" );
		Js_config.embed_tags :=
		Ext_string.split_by ~keep_empty:false (fun c -> c = ',') s
		\|> List.map String.trim),
		"internal Collect embed extension occurrences (csv of tags)" );
		(* single-pass embed rewrite via PPX; no separate -rewrite-embeds entry *)
		( "-reprint-source",
		string_call reprint_source_file,
Expand Down
Original file line number	Diff line number	Diff line change
Expand Up		@@ -74,7 +74,6 @@ let as_pp = ref false

		(* Embed indexing and rewrite configuration *)
		let collect_embeds = ref false
		let embed_collect_all = ref false
		let embed_tags : string list ref = ref []

		let self_stack : string Stack.t = Stack.create ()
Original file line number	Diff line number	Diff line change
Expand Up		@@ -104,10 +104,7 @@ val as_pp : bool ref
		val collect_embeds : bool ref
		(** When true, emit per-module embed index artifacts during parse *)

		val embed_collect_all : bool ref
		(** When true, collect all extension tags; otherwise restrict to [embed_tags] *)

		val embed_tags : string list ref
		(** Comma-separated list of tags to collectwhen [embed_collect_all] = false*)
		(** Comma-separated list of tags to collect *)

		val self_stack : string Stack.t
Original file line number	Diff line number	Diff line change
Expand Up		@@ -89,8 +89,7 @@ let handle_extension e (self : Bs_ast_mapper.mapper)
		normalization runs within the literal. For all other extensions,
		leave payload untouched to avoid surprising side-effects. *)
		let is_embed_tag =
		!Js_config.collect_embeds
		&& (!Js_config.embed_collect_all \|\| List.mem txt !Js_config.embed_tags)
		!Js_config.collect_embeds && List.mem txt !Js_config.embed_tags
		in
		if is_embed_tag then
		let payload' = self.payload self payload in
Expand Down
Original file line number	Diff line number	Diff line change
		@@ -1,20 +1,9 @@
		open Parsetree

		let mkdirp path =
		let rec loop p =
		if Sys.file_exists p then ()
		else
		let parent = Filename.dirname p in
		if parent <> p then loop parent;
		try Unix.mkdir p 0o777 with Unix.Unix_error (_, _, _) -> ()
		in
		loop path

		let is_enabled () = !Js_config.collect_embeds

		let should_collect_tag (name : string) : bool =
		if !Js_config.embed_collect_all then true
		else List.mem name !Js_config.embed_tags
		List.mem name !Js_config.embed_tags

		let csv_hash (tag : string) (s : string) : string =
		Digest.(to_hex (string (tag ^ "\n" ^ s)))
Expand All		@@ -30,18 +19,6 @@ let loc_to_json (loc : Location.t) =
		Ext_json_noloc.kvs
		[("start", pos_to_json loc.loc_start); ("end", pos_to_json loc.loc_end)]

		let normalize_slashes (s : string) : string =
		if Sys.win32 \|\| Sys.cygwin then
		String.map (fun c -> if c = '\\' then '/' else c) s
		else s

		let rel_to_cwd (file : string) : string =
		let abs = Ext_path.absolute_cwd_path file in
		let from = Sys.getcwd () in
		let rel = Ext_path.rel_normalized_absolute_path ~from abs in
		let s = if rel = "" then Filename.basename abs else rel in
		normalize_slashes s

		(* Convert a restricted subset of expressions to JSON for config embeds *)
		let rec expr_to_json (e : Parsetree.expression) : Ext_json_noloc.t option =
		match e.pexp_desc with
Expand DownExpand Up		@@ -88,146 +65,130 @@ let payload_to_data (payload : Ast_payload.t) :
		\| _ -> None

		let write_structure_index ~outprefix ~sourcefile (ast : structure) : unit =
		if not (is_enabled ()) then ()
		else
		(* Skip generated embed files to prevent nested/embed loops *)
		let is_generated =
		try
		(* Fast path: any source under a __generated__ folder *)
		String.contains sourcefile '/'
		&& Ext_string.contain_substring sourcefile "/__generated__/"
		\|\|
		(* Slower path: check for header markers in source text *)
		let ic = open_in sourcefile in
		let l1 = input_line ic in
		let l2 = try input_line ic with End_of_file -> "" in
		close_in_noerr ic;
		Ext_string.contain_substring l1 "@sourceHash"
		\|\| Ext_string.contain_substring l2 "rewatch-embed:"
		with _ -> false
		in
		if is_generated then
		(* Do not emit any embed index for generated files *)
		()
		else
		let entries = ref [] in
		let counts : (string, int) Hashtbl.t = Hashtbl.create 7 in
		let bump tag =
		let v =
		match Hashtbl.find_opt counts tag with
		\| Some i -> i
		\| None -> 0
		in
		let v' = v + 1 in
		Hashtbl.replace counts tag v';
		v'
		if is_enabled () then (
		let entries = ref [] in
		let counts : (string, int) Hashtbl.t = Hashtbl.create 7 in
		let bump tag =
		let v =
		match Hashtbl.find_opt counts tag with
		\| Some i -> i
		\| None -> 0
		in
		let add_entry ~tag ~context ~(data : Ext_json_noloc.t) ~(loc : Location.t)
		=
		let occurrence_index = bump tag in
		let data_str =
		match data with
		\| Ext_json_noloc.Arr _ \| Ext_json_noloc.Obj _ ->
		Ext_json_noloc.to_string data
		\| _ -> Ext_json_noloc.to_string data
		in
		let literal_hash = csv_hash tag data_str in
		let entry =
		Ext_json_noloc.kvs
		[
		("tag", Ext_json_noloc.str tag);
		("context", Ext_json_noloc.str context);
		( "occurrenceIndex",
		Ext_json_noloc.flo (string_of_int occurrence_index) );
		("range", loc_to_json loc);
		("data", data);
		("literalHash", Ext_json_noloc.str literal_hash);
		]
		in
		entries := entry :: !entries
		let v' = v + 1 in
		Hashtbl.replace counts tag v';
		v'
		in
		let add_entry ~tag ~context ~(data : Ext_json_noloc.t) ~(loc : Location.t) =
		let occurrence_index = bump tag in
		let data_str =
		match data with
		\| Ext_json_noloc.Arr _ \| Ext_json_noloc.Obj _ ->
		Ext_json_noloc.to_string data
		\| _ -> Ext_json_noloc.to_string data
		in
		let normalize_tag (tag : string) : string =
		match Ext_embed.get_embed_tag tag with
		\| Some t -> t
		\| None -> tag
		let literal_hash = csv_hash tag data_str in
		let entry =
		Ext_json_noloc.kvs
		[
		("tag", Ext_json_noloc.str tag);
		("context", Ext_json_noloc.str context);
		( "occurrenceIndex",
		Ext_json_noloc.flo (string_of_int occurrence_index) );
		("range", loc_to_json loc);
		("data", data);
		("literalHash", Ext_json_noloc.str literal_hash);
		]
		in
		let rec walk_mod (m : module_expr) (context_for_mod : string option) =
		match m.pmod_desc with
		\| Pmod_extension ({txt = tag; loc = _}, payload) ->
		let base_tag = normalize_tag tag in
		if should_collect_tag base_tag then
		match payload_to_data payload with
		\| Some (data, loc) ->
		let context =
		match context_for_mod with
		\| Some c -> c
		\| None -> "module"
		in
		add_entry ~tag:base_tag ~context ~data ~loc
		\| None ->
		Location.raise_errorf ~loc:m.pmod_loc
		"%%%s expects a string literal or a JSON-serializable record \
		literal"
		tag
		else ()
		\| Pmod_structure s -> walk_str s
		\| Pmod_functor (_name, _arg, body) -> walk_mod body None
		\| Pmod_apply (m1, m2) ->
		walk_mod m1 None;
		walk_mod m2 None
		\| _ -> ()
		and walk_str (s : structure) =
		List.iter
		(fun (si : structure_item) ->
		entries := entry :: !entries
		in
		let normalize_tag (tag : string) : string =
		match Ext_embed.get_embed_tag tag with
		\| Some t -> t
		\| None -> tag
		in
		let current_mod_context : string option ref = ref None in
		let with_context ctx f =
		let prev = !current_mod_context in
		current_mod_context := ctx;
		(try f ()
		with e ->
		current_mod_context := prev;
		raise e);
		current_mod_context := prev
		in
		let iter : Ast_iterator.iterator =
		let default_it = Ast_iterator.default_iterator in
		{
		default_it with
		module_expr =
		(fun self m ->
		(match m.pmod_desc with
		\| Pmod_extension ({txt = tag; _}, payload) ->
		let base_tag = normalize_tag tag in
		if should_collect_tag base_tag then
		match payload_to_data payload with
		\| Some (data, loc) ->
		let context =
		Option.value ~default:"module" !current_mod_context
		in
		add_entry ~tag:base_tag ~context ~data ~loc
		\| None ->
		Location.raise_errorf ~loc:m.pmod_loc
		"%%%s expects a string literal or a JSON-serializable \
		record literal"
		tag
		else ()
		\| _ -> ());
		let prev = !current_mod_context in
		current_mod_context := None;
		default_it.module_expr self m;
		current_mod_context := prev);
		structure_item =
		(fun self si ->
		match si.pstr_desc with
		\| Pstr_module {pmb_expr; _} -> walk_mod pmb_expr None
		\| Pstr_module {pmb_expr; _} ->
		with_context None (fun () -> self.module_expr self pmb_expr)
		\| Pstr_recmodule mbs ->
		List.iter
		(fun ({pmb_expr; _} : module_binding) -> walk_mod pmb_expr None)
		(fun ({pmb_expr; _} : module_binding) ->
		with_context None (fun () -> self.module_expr self pmb_expr))
		mbs
		\| Pstr_include {pincl_mod; _} -> walk_mod pincl_mod (Some "include")
		\| _ -> ())
		s
		in
		walk_str ast;
		let iter : Ast_iterator.iterator =
		let default_it = Ast_iterator.default_iterator in
		{
		default_it with
		expr =
		(fun self e ->
		(match e.pexp_desc with
		\| Pexp_extension ({txt = tag; _}, payload) ->
		let base_tag = normalize_tag tag in
		if should_collect_tag base_tag then
		match payload_to_data payload with
		\| Some (data, loc) ->
		add_entry ~tag:base_tag ~context:"expr" ~data ~loc
		\| None ->
		Location.raise_errorf ~loc:e.pexp_loc
		"%%%s expects a string literal or a JSON-serializable \
		record literal"
		tag
		else ()
		\| _ -> ());
		default_it.expr self e);
		}
		in
		iter.structure iter ast;
		let entries_json =
		!entries \|> List.rev \|> Array.of_list \|> Ext_json_noloc.arr
		in
		let modulename = Ext_filename.module_name outprefix in
		let source_path = rel_to_cwd sourcefile in
		let json =
		Ext_json_noloc.kvs
		[
		("version", Ext_json_noloc.flo "1");
		("module", Ext_json_noloc.str modulename);
		("sourcePath", Ext_json_noloc.str source_path);
		("embeds", entries_json);
		]
		in
		let out_dir = Filename.dirname (outprefix ^ Literals.suffix_ast) in
		mkdirp out_dir;
		Ext_json_noloc.to_file (outprefix ^ ".embeds.json") json
		\| Pstr_include {pincl_mod; _} ->
		with_context (Some "include") (fun () ->
		self.module_expr self pincl_mod)
		\| _ -> default_it.structure_item self si);
		expr =
		(fun self e ->
		(match e.pexp_desc with
		\| Pexp_extension ({txt = tag; _}, payload) ->
		let base_tag = normalize_tag tag in
		if should_collect_tag base_tag then
		match payload_to_data payload with
		\| Some (data, loc) ->
		add_entry ~tag:base_tag ~context:"expr" ~data ~loc
		\| None ->
		Location.raise_errorf ~loc:e.pexp_loc
		"%%%s expects a string literal or a JSON-serializable \
		record literal"
		tag
		else ()
		\| _ -> ());
		default_it.expr self e);
		}
		in
		iter.structure iter ast;
		let entries_json =
		!entries \|> List.rev \|> Array.of_list \|> Ext_json_noloc.arr
		in
		let modulename = Ext_filename.module_name outprefix in
		let source_path = sourcefile in
		let json =
		Ext_json_noloc.kvs
		[
		("version", Ext_json_noloc.flo "1");
		("module", Ext_json_noloc.str modulename);
		("sourcePath", Ext_json_noloc.str source_path);
		("embeds", entries_json);
		]
		in
		Ext_json_noloc.to_file (outprefix ^ ".embeds.json") json)