Skip to content
Draft
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension


Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
8 changes: 7 additions & 1 deletion Makefile
Original file line number Diff line number Diff line change
Expand Up @@ -19,6 +19,12 @@ rewatch:
cargo build --manifest-path rewatch/Cargo.toml --release
./scripts/copyExes.js --rewatch

# Generate EmbedLang JSON/OpenAPI schemas into docs/schemas
schemas: rewatch
@mkdir -p docs/schemas
@rewatch/target/release/rescript schema embeds --output-dir docs/schemas --openapi >/dev/null
@echo "Schemas written to docs/schemas"

ninja/ninja:
./scripts/buildNinjaBinary.js

Expand Down Expand Up @@ -99,4 +105,4 @@ dev-container:

.DEFAULT_GOAL := build

.PHONY: build watch rewatch ninja bench dce test test-syntax test-syntax-roundtrip test-gentype test-analysis test-tools test-all lib playground playground-cmijs playground-release artifacts format checkformat clean-gentype clean-rewatch clean clean-all dev-container
.PHONY: build watch rewatch ninja bench dce test test-syntax test-syntax-roundtrip test-gentype test-analysis test-tools test-all lib playground playground-cmijs playground-release artifacts format checkformat clean-gentype clean-rewatch clean clean-all dev-container schemas
9 changes: 9 additions & 0 deletions compiler/bsc/rescript_compiler_main.ml
Original file line number Diff line number Diff line change
Expand Up @@ -346,6 +346,15 @@ let command_line_flags : (string * Bsc_args.spec * string) array =
("-dparsetree", set Clflags.dump_parsetree, "*internal* debug parsetree");
("-drawlambda", set Clflags.dump_rawlambda, "*internal* debug raw lambda");
("-dsource", set Clflags.dump_source, "*internal* print source");
( "-embeds",
string_call (fun s ->
Js_config.collect_embeds := true;
let s = String.trim s in
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,
"*internal* transform the target ReScript file using PPXes provided, and \
Expand Down
5 changes: 5 additions & 0 deletions compiler/common/js_config.ml
Original file line number Diff line number Diff line change
Expand Up @@ -71,4 +71,9 @@ let jsx_module_of_string = function
| module_name -> Generic {module_name}

let as_pp = ref false

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

let self_stack : string Stack.t = Stack.create ()
7 changes: 7 additions & 0 deletions compiler/common/js_config.mli
Original file line number Diff line number Diff line change
Expand Up @@ -100,4 +100,11 @@ val jsx_module_of_string : string -> jsx_module

val as_pp : bool ref

(* Embed indexing and rewrite configuration *)
val collect_embeds : bool ref
(** When true, emit per-module embed index artifacts during parse *)

val embed_tags : string list ref
(** Comma-separated list of tags to collect *)

val self_stack : string Stack.t
8 changes: 7 additions & 1 deletion compiler/core/js_implementation.ml
Original file line number Diff line number Diff line change
Expand Up @@ -161,7 +161,13 @@ let implementation ~parser ppf ?outputprefix fname =
| Some x -> x
in
Res_compmisc.init_path ();
parser fname
let ast0 = parser fname in
(* Emit embed index (if enabled) alongside binary AST output prefix *)
(try
Embed_index.write_structure_index ~outprefix:outputprefix ~sourcefile:fname
ast0
with _ -> ());
ast0
|> Cmd_ppx_apply.apply_rewriters ~restore:false ~tool_name:Js_config.tool_name
Ml
|> Ppx_entry.rewrite_implementation
Expand Down
48 changes: 48 additions & 0 deletions compiler/ext/ext_embed.ml
Original file line number Diff line number Diff line change
@@ -0,0 +1,48 @@
let get_embed_tag (name : string) : string option =
let prefix = "embed." in
let plen = String.length prefix in
if String.length name > plen && String.sub name 0 plen = prefix then
Some (String.sub name plen (String.length name - plen))
else None

let is_valid_embed_id (s : string) : bool =
let len = String.length s in
if len = 0 then false
else
let lead = s.[0] in
let is_letter = function
| 'A' .. 'Z' | 'a' .. 'z' -> true
| _ -> false
in
let is_ident_char = function
| 'A' .. 'Z' | 'a' .. 'z' | '0' .. '9' | '_' -> true
| _ -> false
in
if not (is_letter lead) then false
else
let rec loop i =
if i >= len then true
else if is_ident_char s.[i] then loop (i + 1)
else false
in
loop 1

let invalid_id_error_message =
"Invalid `id` for embed. Embed `id` must start with a letter, and only \
contain letters, digits, and underscores."

let missing_id_error_message = "Embed config record must include `id: string`."

let invalid_payload_error_message =
"Embed payload must be either a string literal or a record literal."

let normalize_tag_for_symbol (tag : string) : string =
(* Embed tags are already validated by the parser as extension identifiers
(attr-id with optional dot-separated segments). We only need to make the
tag segment safe for inclusion in a single identifier by mapping '.' to
'_'. *)
let b = Bytes.of_string tag in
for i = 0 to Bytes.length b - 1 do
if Bytes.get b i = '.' then Bytes.set b i '_'
done;
Bytes.unsafe_to_string b
20 changes: 20 additions & 0 deletions compiler/ext/ext_embed.mli
Original file line number Diff line number Diff line change
@@ -0,0 +1,20 @@
val get_embed_tag : string -> string option
(** [get_embed_tag name] returns [Some base] when [name] starts with
the embed prefix "embed." and has a non-empty remainder; otherwise [None]. *)

val is_valid_embed_id : string -> bool
(** Validate embed `id`: must start with a letter and contain only
letters, digits, and underscores. *)

val invalid_id_error_message : string
(** Centralized error message for invalid embed `id`. *)

val missing_id_error_message : string
(** Error when a config record omits `id` or provides a non-string `id`. *)

val invalid_payload_error_message : string
(** Error when embed payload is not a string literal or record literal. *)

val normalize_tag_for_symbol : string -> string
(** Convert an embed tag (validated as an attribute id) into a safe fragment
for inclusion in a single identifier, by replacing '.' with '_'. *)
12 changes: 11 additions & 1 deletion compiler/frontend/ast_exp_extension.ml
Original file line number Diff line number Diff line change
Expand Up @@ -84,7 +84,17 @@ let handle_extension e (self : Bs_ast_mapper.mapper)
pexp_desc = Ast_util.record_as_js_object e.pexp_loc self label_exprs;
}
| _ -> Location.raise_errorf ~loc "Expect a record expression here")
| _ -> e
| _ ->
(* For configured embed tags, map the payload so that string
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 && List.mem txt !Js_config.embed_tags
in
if is_embed_tag then
let payload' = self.payload self payload in
{e with pexp_desc = Parsetree.Pexp_extension ({txt; loc}, payload')}
else e
(* For an unknown extension, we don't really need to process further*)
(* Exp.extension ~loc ~attrs:e.pexp_attributes (
self.extension self extension) *)
Expand Down
16 changes: 15 additions & 1 deletion compiler/frontend/bs_ast_invariant.ml
Original file line number Diff line number Diff line change
Expand Up @@ -90,8 +90,22 @@ let emit_external_warnings : iterator =
Example: type rec t = ..."
| _ -> super.structure_item self str_item);
expr =
(fun self ({pexp_loc = loc} as a) ->
(fun self ({pexp_loc = loc; pexp_attributes = attrs} as a) ->
match a.pexp_desc with
| Pexp_constant (Pconst_string (_s, Some delim))
when Ast_utf8_string_interp.is_unescaped delim ->
(* Skip the "uninterpreted delimiters" warning for template/backtick
strings that are still inside extension payloads or carry the
template attributes. These will either be rewritten later or have
already been marked as template literals. *)
let has_template_attr =
Ext_list.exists attrs (fun ({txt}, _) ->
match txt with
| "res.template" | "res.taggedTemplate" -> true
| _ -> false)
in
if not has_template_attr then
Bs_warnings.error_unescaped_delimiter loc delim
| Pexp_constant const -> check_constant loc const
| Pexp_variant (s, None) when Ext_string.is_valid_hash_number s -> (
try ignore (Ext_string.hash_number_as_i32_exn s : int32)
Expand Down
Loading
Loading