From cce8a731bf1b76c178a469d281b65f1e8c3bfda2 Mon Sep 17 00:00:00 2001 From: Christoph Knittel Date: Thu, 3 Sep 2026 14:24:08 +0200 Subject: [PATCH 1/3] Add %raw external arguments and parsetree representation Signed-off-by: Christoph Knittel --- CHANGELOG.md | 1 + analysis/src/completion_front_end.ml | 2 +- analysis/src/document_symbol.ml | 2 +- analysis/src/dump_ast.ml | 1 - analysis/src/signature_help.ml | 59 ++--- compiler/core/j.ml | 7 +- compiler/core/js_analyzer.ml | 4 +- compiler/core/js_dump.ml | 6 +- compiler/core/js_exp_make.ml | 6 +- compiler/core/js_exp_make.mli | 2 +- compiler/core/js_record_fold.ml | 2 +- compiler/core/js_record_iter.ml | 2 +- compiler/core/js_record_map.ml | 2 +- compiler/core/lam_compile_const.ml | 4 +- compiler/frontend/ast_attributes.ml | 80 ++++--- compiler/frontend/ast_attributes.mli | 2 +- compiler/frontend/ast_config.ml | 1 - compiler/frontend/ast_derive_abstract.ml | 24 +- compiler/frontend/ast_derive_js_mapper.ml | 13 +- compiler/frontend/ast_derive_projector.ml | 8 +- compiler/frontend/ast_exp_extension.ml | 1 - compiler/frontend/ast_exp_handle_external.ml | 19 +- compiler/frontend/ast_external_process.ml | 90 ++++--- compiler/frontend/bs_builtin_ppx.ml | 6 - compiler/frontend/ppx_entry.ml | 24 -- compiler/ml/ast_helper.ml | 5 +- compiler/ml/ast_iterator.ml | 6 +- compiler/ml/ast_mapper.ml | 6 +- compiler/ml/ast_mapper_from0.ml | 34 ++- compiler/ml/ast_mapper_to0.ml | 33 ++- compiler/ml/ast_payload.ml | 91 +++++-- compiler/ml/ast_payload.mli | 9 +- compiler/ml/ast_untagged_variants.ml | 1 - compiler/ml/builtin_attributes.ml | 4 +- compiler/ml/depend.ml | 6 +- compiler/ml/external_arg_spec.ml | 10 +- compiler/ml/external_arg_spec.mli | 10 +- compiler/ml/parsetree.ml | 12 +- compiler/ml/pprintast.ml | 27 ++- compiler/ml/printast.ml | 14 +- compiler/ml/translcore.ml | 4 +- compiler/ml/typecore.ml | 22 +- compiler/ml/typecore.mli | 1 - compiler/ml/typetexp.ml | 28 +-- compiler/syntax/src/jsx_v4.ml | 5 +- compiler/syntax/src/res_ast_debugger.ml | 13 +- compiler/syntax/src/res_comments_table.ml | 35 ++- compiler/syntax/src/res_core.ml | 225 ++++++++++++++++-- compiler/syntax/src/res_parsetree_viewer.ml | 2 +- compiler/syntax/src/res_printer.ml | 37 +-- packages/@rescript/belt/src/Belt_Array.res | 2 +- packages/@rescript/belt/src/Belt_Array.resi | 2 +- packages/@rescript/belt/src/Belt_Int.res | 2 +- packages/@rescript/runtime/Stdlib_Array.res | 2 +- packages/@rescript/runtime/Stdlib_Array.resi | 2 +- packages/@rescript/runtime/Stdlib_Dict.res | 8 +- packages/@rescript/runtime/Stdlib_Dict.resi | 8 +- packages/@rescript/runtime/Stdlib_JSON.res | 4 +- packages/@rescript/runtime/Stdlib_JSON.resi | 4 +- packages/@rescript/runtime/Stdlib_Object.res | 6 +- packages/@rescript/runtime/Stdlib_RegExp.res | 4 +- packages/@rescript/runtime/Stdlib_RegExp.resi | 4 +- packages/dev-playground/src/Bindings.res | 6 +- tests/ERROR_VARIANTS.md | 1 - .../deadcode/expected/deadcode.txt | 2 +- tests/build_tests/react_ppx/src/React.res | 12 +- .../expected/json_literal_inline.res.expected | 9 - .../json_literal_inline_payload.res.expected | 9 - ...json_literal_outside_external.res.expected | 8 - .../json_literal_todo_payload.res.expected | 8 - ...ntaxErrors_json_interpolation.res.expected | 8 +- .../fixtures/json_literal_inline.res | 2 - .../fixtures/json_literal_inline_payload.res | 2 - .../json_literal_outside_external.res | 1 - .../fixtures/json_literal_todo_payload.res | 1 - .../dependencies/rescript-react/src/React.res | 15 +- .../rescript-react/src/ReactDOMStyle.res | 4 +- .../src/RescriptReactRouter.res | 4 +- tests/ounit_tests/ounit_ast_mapper0_tests.ml | 14 +- .../ounit_tests/ounit_string_literal_tests.ml | 88 ++++--- .../data/ast-mapping/FixedExternal.res | 5 + .../expected/FixedExternal.res.txt | 17 ++ .../expected/FunctionsAndArrows.res.txt | 15 +- .../expected/fixedExternalDuplicate.res.txt | 10 + .../expected/fixedExternalPosition.res.txt | 11 + .../expected/fixedExternalTyped.res.txt | 10 + .../errors/typexpr/fixedExternalDuplicate.res | 1 + .../errors/typexpr/fixedExternalPosition.res | 1 + .../errors/typexpr/fixedExternalTyped.res | 1 + .../expressions/expected/es6template.res.txt | 2 +- .../ffi/expected/fixedExternal.res.txt | 38 +++ .../data/printer/ffi/fixedExternal.res | 14 ++ .../printer/other/expected/attributes.res.txt | 80 ++++++- tests/tests/src/AsInUncurriedExternals.mjs | 9 +- tests/tests/src/AsInUncurriedExternals.res | 15 +- tests/tests/src/UncurriedExternals.res | 2 +- tests/tests/src/bs_auto_uncurry.res | 4 +- tests/tests/src/bs_splice_partial.res | 4 +- tests/tests/src/external_ppx.mjs | 2 +- tests/tests/src/external_ppx.res | 8 +- tests/tests/src/external_ppx2.res | 2 +- tests/tests/src/ffi_js_test.res | 4 +- tests/tests/src/gpr_1170.res | 4 +- tests/tests/src/gpr_1484.res | 2 +- tests/tests/src/mario_game.res | 2 +- tests/tests/src/prepend_data_ffi.mjs | 10 +- tests/tests/src/prepend_data_ffi.res | 47 ++-- tests/tests/src/record_name_test.res | 4 +- tests/tests/src/tagged_template_test.mjs | 39 +-- tests/tests/src/tagged_template_test.res | 11 + tools/src/tools.ml | 1 - 111 files changed, 1090 insertions(+), 535 deletions(-) delete mode 100644 tests/build_tests/super_errors/expected/json_literal_inline.res.expected delete mode 100644 tests/build_tests/super_errors/expected/json_literal_inline_payload.res.expected delete mode 100644 tests/build_tests/super_errors/expected/json_literal_outside_external.res.expected delete mode 100644 tests/build_tests/super_errors/expected/json_literal_todo_payload.res.expected delete mode 100644 tests/build_tests/super_errors/fixtures/json_literal_inline.res delete mode 100644 tests/build_tests/super_errors/fixtures/json_literal_inline_payload.res delete mode 100644 tests/build_tests/super_errors/fixtures/json_literal_outside_external.res delete mode 100644 tests/build_tests/super_errors/fixtures/json_literal_todo_payload.res create mode 100644 tests/syntax_tests/data/ast-mapping/FixedExternal.res create mode 100644 tests/syntax_tests/data/ast-mapping/expected/FixedExternal.res.txt create mode 100644 tests/syntax_tests/data/parsing/errors/typexpr/expected/fixedExternalDuplicate.res.txt create mode 100644 tests/syntax_tests/data/parsing/errors/typexpr/expected/fixedExternalPosition.res.txt create mode 100644 tests/syntax_tests/data/parsing/errors/typexpr/expected/fixedExternalTyped.res.txt create mode 100644 tests/syntax_tests/data/parsing/errors/typexpr/fixedExternalDuplicate.res create mode 100644 tests/syntax_tests/data/parsing/errors/typexpr/fixedExternalPosition.res create mode 100644 tests/syntax_tests/data/parsing/errors/typexpr/fixedExternalTyped.res create mode 100644 tests/syntax_tests/data/printer/ffi/expected/fixedExternal.res.txt create mode 100644 tests/syntax_tests/data/printer/ffi/fixedExternal.res diff --git a/CHANGELOG.md b/CHANGELOG.md index 4dcfb0ee52a..8a5d538952a 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -27,6 +27,7 @@ #### :rocket: New Feature +- Add `%raw(...)` arguments for externals, for example `external assign: (%raw("{}"), t) => t = "Object.assign"`. The string contains the raw JavaScript value supplied by the binding, and the argument is omitted at call sites. The legacy `` @as(json`...`) _ ``, `@as("...") _`, and `@as(1) _` forms now emit a deprecation warning and are formatted as `%raw(...)`. https://github.com/rescript-lang/rescript/pull/8606 - Support UTF-16 surrogate-pair escapes such as `"\uD83D\uDE00"` in ordinary string literals. https://github.com/rescript-lang/rescript/pull/8606 - Support dynamic imports of external bindings annotated with `@scope`; the generated import follows the complete property path. These imports were previously rejected. https://github.com/rescript-lang/rescript/pull/8582 - Add `@res.hoistedFunction` for emitting nested module functions as flat JavaScript exports. https://github.com/rescript-lang/rescript/pull/8402 diff --git a/analysis/src/completion_front_end.ml b/analysis/src/completion_front_end.ml index a3ed213e9ff..5a4fe90791f 100644 --- a/analysis/src/completion_front_end.ml +++ b/analysis/src/completion_front_end.ml @@ -209,7 +209,7 @@ let find_arg_completables ~(args : arg list) ~end_pos ~pos_before_cursor let rec expr_to_context_path_inner ~(in_jsx_context : bool) (e : Parsetree.expression) = match e.pexp_desc with - | Pexp_constant (Pconst_string _ | Pconst_json _ | Pconst_raw_source _) -> + | Pexp_constant (Pconst_string _ | Pconst_raw_source _) -> Some Completable.CPString | Pexp_template _ -> Some Completable.CPString | Pexp_tagged_template {tag} -> ( diff --git a/analysis/src/document_symbol.ml b/analysis/src/document_symbol.ml index 3ef53933e54..3405c87384f 100644 --- a/analysis/src/document_symbol.ml +++ b/analysis/src/document_symbol.ml @@ -19,7 +19,7 @@ let get_symbols ~source ~kind_file = match exp.pexp_desc with | Pexp_fun _ -> Lsp.Types.SymbolKind.Function | Pexp_constraint (e, _) -> expr_kind e - | Pexp_constant (Pconst_string _ | Pconst_json _ | Pconst_raw_source _) -> + | Pexp_constant (Pconst_string _ | Pconst_raw_source _) -> Lsp.Types.SymbolKind.String | Pexp_template _ -> Lsp.Types.SymbolKind.String | Pexp_constant (Pconst_float _ | Pconst_integer _) -> diff --git a/analysis/src/dump_ast.ml b/analysis/src/dump_ast.ml index 2eb536e7af0..f7d8d1a0b03 100644 --- a/analysis/src/dump_ast.ml +++ b/analysis/src/dump_ast.ml @@ -51,7 +51,6 @@ let print_constant const = ^ ", semantic=" ^ String_literal.string_semantic payload ^ ")" - | Pconst_json source -> "Pconst_json(" ^ source ^ ")" | Pconst_raw_source source -> "Pconst_raw_source(" ^ source ^ ")" | Pconst_float (s, _) -> "Pconst_float(" ^ s ^ ")" diff --git a/analysis/src/signature_help.ml b/analysis/src/signature_help.ml index d84fe61030c..16e9d63b77a 100644 --- a/analysis/src/signature_help.ml +++ b/analysis/src/signature_help.ml @@ -114,33 +114,38 @@ let extract_parameters ~signature ~type_str_for_parser ~label_prefix_len = Psig_value {pval_type = {ptyp_desc = Ptyp_arrow {params = args}}}; }; ] -> - List.map - (fun (arg : Parsetree.arg) -> - let start_loc = - (* For a labeled argument the label precedes the type. *) - match arg.lbl with - | Asttypes.Labelled {loc} | Optional {loc} -> loc |> Loc.start - | Nolabel -> arg.typ.ptyp_loc |> Loc.start - in - let start_offset = - start_loc |> Pos.position_to_offset type_str_for_parser |> Option.get - in - let end_offset = - arg.typ.ptyp_loc |> Loc.end_ - |> Pos.position_to_offset type_str_for_parser - |> Option.get - in - (* The AST locations does not account for "=?" of optional arguments, so add that to the offset here if needed. *) - let end_offset = - match arg.lbl with - | Asttypes.Optional _ -> end_offset + 2 - | _ -> end_offset - in - ( arg.lbl, - (* Remove the label prefix offset here, since we're not - showing that to the end user. *) - start_offset - label_prefix_len, - end_offset - label_prefix_len )) + List.filter_map + (function + | Parsetree.Parg_fixed _ -> None + | Parsetree.Parg_type {lbl; typ; _} -> + let start_loc = + (* For a labeled argument the label precedes the type. *) + match lbl with + | Asttypes.Labelled {loc} | Optional {loc} -> loc |> Loc.start + | Nolabel -> typ.ptyp_loc |> Loc.start + in + let start_offset = + start_loc + |> Pos.position_to_offset type_str_for_parser + |> Option.get + in + let end_offset = + typ.ptyp_loc |> Loc.end_ + |> Pos.position_to_offset type_str_for_parser + |> Option.get + in + (* The AST locations does not account for "=?" of optional arguments, so add that to the offset here if needed. *) + let end_offset = + match lbl with + | Asttypes.Optional _ -> end_offset + 2 + | _ -> end_offset + in + Some + ( lbl, + (* Remove the label prefix offset here, since we're not + showing that to the end user. *) + start_offset - label_prefix_len, + end_offset - label_prefix_len )) args | _ -> [] diff --git a/compiler/core/j.ml b/compiler/core/j.ml index bae9a7886a2..ca0d4c943ea 100644 --- a/compiler/core/j.ml +++ b/compiler/core/j.ml @@ -156,10 +156,9 @@ and expression_desc = optimizations. Both are required because preserving backquoted spelling is an output design goal. Tagged-template segments use [Tagged_template] instead because their escapes need not be valid. *) - | Json_literal of string - (** Validated JavaScript literal source from a supported external - [json`...`] payload. For [json`{"ok": true}`], the string contains - [{"ok": true}] as JavaScript source, not as a decoded ReScript + | Fixed_literal of string + (** Validated JavaScript literal source supplied by a fixed external + argument. The string is JavaScript source, not a decoded ReScript string. *) | Raw_js_code of Js_raw_info.t (** JavaScript source originating from [raw], [ffi], or [re]. For example, diff --git a/compiler/core/js_analyzer.ml b/compiler/core/js_analyzer.ml index f5062363c75..93cbfb62003 100644 --- a/compiler/core/js_analyzer.ml +++ b/compiler/core/js_analyzer.ml @@ -107,7 +107,7 @@ let rec no_side_effect_expression_desc (x : J.expression_desc) = | Undefined _ | Null | Bool _ | Var _ -> true | Fun _ -> true | Number _ -> true (* Can be refined later *) - | Json_literal _ -> true + | Fixed_literal _ -> true | Static_index (obj, (_name : string), (_pos : int32 option)) -> no_side_effect obj | String_index (a, b) | Array_index (a, b) -> @@ -256,7 +256,7 @@ let rec eq_expression ({expression_desc = x0} : J.expression) eq_expression_list ls0 ls1 && flag0 = flag1 && info0 = info1 | _ -> false) | Length _ | Is_null_or_undefined _ | String_append _ | Typeof _ | Js_not _ - | Js_bnot _ | In _ | Cond _ | New _ | Fun _ | Json_literal _ | Raw_js_code _ + | Js_bnot _ | In _ | Cond _ | New _ | Fun _ | Fixed_literal _ | Raw_js_code _ | Array _ | Caml_block_tag _ | Object _ | Tagged_template _ | Interpolated_template _ | Await _ | Record_rest _ -> false diff --git a/compiler/core/js_dump.ml b/compiler/core/js_dump.ml index d536189285e..0de7ae95e8d 100644 --- a/compiler/core/js_dump.ml +++ b/compiler/core/js_dump.ml @@ -139,7 +139,7 @@ let rec exp_need_paren ?(arrow = false) (e : J.expression) = | Blk_record_ext _ | Blk_record_inlined _ | Blk_constructor _ ) ) | Object _ -> true - | Json_literal _ -> true + | Fixed_literal _ -> true | Raw_js_code {code_info = Stmt _} | Length _ | Call _ | Caml_block_tag _ | Seq _ | Static_index _ | Cond _ | Bin _ | Is_null_or_undefined _ | String_index _ | Array_index _ @@ -737,7 +737,7 @@ and expression_desc cxt ~(level : int) f x : cxt = | Template_literal segment -> P.string f ("`" ^ String_literal.template_source segment ^ "`"); cxt - | Json_literal source -> + | Fixed_literal source -> P.string f source; cxt | Raw_js_code {code = s; code_info = info} -> ( @@ -1363,7 +1363,7 @@ and statement_desc top cxt f (s : J.statement_desc) : cxt = | Some s -> P.string f s | None -> ()); cxt - | Str _ | Template_literal _ | Json_literal _ -> cxt + | Str _ | Template_literal _ | Fixed_literal _ -> cxt | _ -> let cxt = (if exp_need_paren e then P.paren_group f 1 else P.group f 0) (fun _ -> diff --git a/compiler/core/js_exp_make.ml b/compiler/core/js_exp_make.ml index 32f46c2e398..b4d997dfd54 100644 --- a/compiler/core/js_exp_make.ml +++ b/compiler/core/js_exp_make.ml @@ -35,7 +35,7 @@ type t = J.expression *) let rec remove_pure_sub_exp (x : t) : t option = match x.expression_desc with - | Var _ | Str _ | Template_literal _ | Json_literal _ | Number _ -> + | Var _ | Str _ | Template_literal _ | Fixed_literal _ | Number _ -> None (* Can be refined later *) | Array_index (a, b) -> if is_pure_sub_exp a && is_pure_sub_exp b then None else Some x @@ -201,8 +201,8 @@ let str ?comment txt : t = let template_literal ?comment segment : t = {expression_desc = Template_literal segment; comment; source_loc = None} -let json_literal ?comment source : t = - {expression_desc = Json_literal source; comment; source_loc = None} +let fixed_literal ?comment source : t = + {expression_desc = Fixed_literal source; comment; source_loc = None} let raw_js_code ?comment info s : t = { diff --git a/compiler/core/js_exp_make.mli b/compiler/core/js_exp_make.mli index 2f090d348ff..0fd68b6ce32 100644 --- a/compiler/core/js_exp_make.mli +++ b/compiler/core/js_exp_make.mli @@ -83,7 +83,7 @@ val str : ?comment:string -> string -> t val template_literal : ?comment:string -> Asttypes.template_segment -> t -val json_literal : ?comment:string -> string -> t +val fixed_literal : ?comment:string -> string -> t val record_rest : ?comment:string -> J.record_rest_field list -> t -> t diff --git a/compiler/core/js_record_fold.ml b/compiler/core/js_record_fold.ml index f46bfa62ece..14c2cd87636 100644 --- a/compiler/core/js_record_fold.ml +++ b/compiler/core/js_record_fold.ml @@ -156,7 +156,7 @@ let expression_desc : 'a. ('a, expression_desc) fn = st | Str _ -> st | Template_literal _ -> st - | Json_literal _ -> st + | Fixed_literal _ -> st | Raw_js_code _ -> st | Array _x0 -> list _self.expression _self st _x0 | Optional_block (_x0, _x1) -> diff --git a/compiler/core/js_record_iter.ml b/compiler/core/js_record_iter.ml index 9eb68ae8e66..bc7f29f45fd 100644 --- a/compiler/core/js_record_iter.ml +++ b/compiler/core/js_record_iter.ml @@ -124,7 +124,7 @@ let expression_desc : expression_desc fn = _self.block _self body | Str _ -> () | Template_literal _ -> () - | Json_literal _ -> () + | Fixed_literal _ -> () | Raw_js_code _ -> () | Array _x0 -> list _self.expression _self _x0 | Optional_block (_x0, _x1) -> _self.expression _self _x0 diff --git a/compiler/core/js_record_map.ml b/compiler/core/js_record_map.ml index 42e54cfd674..1251c12db75 100644 --- a/compiler/core/js_record_map.ml +++ b/compiler/core/js_record_map.ml @@ -161,7 +161,7 @@ let expression_desc : expression_desc fn = Fun {fun_ with params; body} | Str _ as v -> v | Template_literal _ as v -> v - | Json_literal _ as v -> v + | Fixed_literal _ as v -> v | Raw_js_code _ as v -> v | Array _x0 -> let _x0 = list _self.expression _self _x0 in diff --git a/compiler/core/lam_compile_const.ml b/compiler/core/lam_compile_const.ml index b38a6a6492e..ce4a6306a56 100644 --- a/compiler/core/lam_compile_const.ml +++ b/compiler/core/lam_compile_const.ml @@ -75,6 +75,4 @@ and translate (x : Lambda.structured_constant) : J.expression = let translate_arg_cst (cst : External_arg_spec.cst) = match cst with - | Arg_int_lit i -> E.int (Int32.of_int i) - | Arg_string_lit s -> E.str s - | Arg_json_lit s -> E.json_literal s + | Arg_fixed_lit source -> E.fixed_literal source diff --git a/compiler/frontend/ast_attributes.ml b/compiler/frontend/ast_attributes.ml index 078cd29e152..705385efa9d 100644 --- a/compiler/frontend/ast_attributes.ml +++ b/compiler/frontend/ast_attributes.ml @@ -176,50 +176,58 @@ let iter_process_bs_int_as (attrs : t) = | _ -> ()); !st -type as_const_payload = Int of int | Str of string | Json of string +type as_const_payload = Fixed of string let iter_process_bs_string_or_int_as (attrs : Parsetree.attributes) = let st = ref None in Ext_list.iter attrs (fun (({txt; loc}, payload) as attr) -> + let set_fixed source = + match Classify_function.classify source with + | Js_literal _ -> st := Some (Fixed source) + | _ -> + Location.raise_errorf ~loc + "The fixed-value @as payload must be a JavaScript literal" + in match txt with | "as" -> if !st = None then ( Used_attributes.mark_used_attribute attr; - match Ast_payload.is_single_int payload with - | Some v -> st := Some (Int v) - | None -> ( - match Ast_payload.semantic_string_of_payload payload with - | Some s -> st := Some (Str s) - | None -> ( - match payload with - | PStr - [ - { - pstr_desc = - Pstr_eval - ( { - pexp_desc = Pexp_constant (Pconst_json s); - pexp_loc; - _; - }, - _ ); - _; - }; - ] -> ( - st := Some (Json s); - (* Check that it is a valid object literal. *) - match - Classify_function.classify - ~check: - ( pexp_loc, - Bs_flow_ast_utils.flow_deli_offset (Some "json") ) - s - with - | Js_literal _ -> () - | _ -> - Location.raise_errorf ~loc:pexp_loc - "an object literal expected") - | _ -> Bs_syntaxerr.err loc Expect_int_or_string_or_json_literal))) + let is_fixed_value_payload = + Ast_payload.is_single_int payload <> None + || Ast_payload.semantic_string_of_payload payload <> None + || + match payload with + | PStr + [ + { + pstr_desc = + Pstr_eval + ( { + pexp_desc = + Pexp_tagged_template + { + tag = + { + pexp_desc = + Pexp_ident {txt = Lident "json"}; + }; + raw_sources = [_]; + values = []; + }; + _; + }, + _ ); + _; + }; + ] -> + true + | _ -> false + in + if not is_fixed_value_payload then + Bs_syntaxerr.err loc Expect_int_or_string_or_json_literal; + match Ast_payload.fixed_source_of_payload payload with + | Some source -> set_fixed source + | None -> Bs_syntaxerr.err loc Expect_int_or_string_or_json_literal) else raise (Ast_untagged_variants.Error (loc, Duplicated_bs_as)) | _ -> ()); !st diff --git a/compiler/frontend/ast_attributes.mli b/compiler/frontend/ast_attributes.mli index 94bfae67bff..8b542f4ff06 100644 --- a/compiler/frontend/ast_attributes.mli +++ b/compiler/frontend/ast_attributes.mli @@ -46,7 +46,7 @@ val has_unwrap_attr : t -> bool val iter_process_bs_int_as : t -> int option -type as_const_payload = Int of int | Str of string | Json of string +type as_const_payload = Fixed of string val iter_process_bs_string_or_int_as : t -> as_const_payload option val process_derive_type : t -> derive_attr * t diff --git a/compiler/frontend/ast_config.ml b/compiler/frontend/ast_config.ml index 70d4547c181..d82d837379f 100644 --- a/compiler/frontend/ast_config.ml +++ b/compiler/frontend/ast_config.ml @@ -47,7 +47,6 @@ let process_directives str = |> List.iter (fun (item : Parsetree.structure_item) -> match item.pstr_desc with | Pstr_attribute ({txt = "directive"}, payload) -> ( - Ast_payload.reject_json_literal_payload payload; match Ast_payload.semantic_string_of_payload payload with | Some d -> Js_config.directives := !Js_config.directives @ [d] | None -> Bs_syntaxerr.err item.pstr_loc Expect_string_literal) diff --git a/compiler/frontend/ast_derive_abstract.ml b/compiler/frontend/ast_derive_abstract.ml index 70a8f0c826f..2e1d93e4223 100644 --- a/compiler/frontend/ast_derive_abstract.ml +++ b/compiler/frontend/ast_derive_abstract.ml @@ -85,8 +85,8 @@ let handle_tdcl light (tdcl : Parsetree.type_declaration) : (if has_optional_field then (* start with the implicit unit argument *) [ - ({attrs = []; lbl = Nolabel; typ = Ast_literal.type_unit ()} - : Parsetree.arg); + Parsetree.Parg_type + {attrs = []; lbl = Nolabel; typ = Ast_literal.type_unit ()}; ] else []), [] ) @@ -111,11 +111,11 @@ let handle_tdcl light (tdcl : Parsetree.type_declaration) : (* build the argument representing this field *) let field_arg = if is_optional then - ({attrs = []; lbl = Asttypes.Optional pld_name; typ = pld_type} - : Parsetree.arg) + Parsetree.Parg_type + {attrs = []; lbl = Asttypes.Optional pld_name; typ = pld_type} else - ({attrs = []; lbl = Asttypes.Labelled pld_name; typ = pld_type} - : Parsetree.arg) + Parsetree.Parg_type + {attrs = []; lbl = Asttypes.Labelled pld_name; typ = pld_type} in (* prepend to the maker argument list *) @@ -126,11 +126,11 @@ let handle_tdcl light (tdcl : Parsetree.type_declaration) : if is_optional then let optional_type = Ast_core_type.lift_option_type pld_type in Ast_helper.Typ.arrow ~loc - [{attrs = []; lbl = Nolabel; typ = core_type}] + [Parg_type {attrs = []; lbl = Nolabel; typ = core_type}] optional_type else Ast_helper.Typ.arrow ~loc - [{attrs = []; lbl = Nolabel; typ = core_type}] + [Parg_type {attrs = []; lbl = Nolabel; typ = core_type}] pld_type in let accessor_prim = @@ -172,10 +172,10 @@ let handle_tdcl light (tdcl : Parsetree.type_declaration) : let setter_type = Ast_helper.Typ.arrow ~loc:pld_loc [ - ({attrs = []; lbl = Nolabel; typ = core_type} - : Parsetree.arg); - ({attrs = []; lbl = Nolabel; typ = pld_type} - : Parsetree.arg); + Parsetree.Parg_type + {attrs = []; lbl = Nolabel; typ = core_type}; + Parsetree.Parg_type + {attrs = []; lbl = Nolabel; typ = pld_type}; ] (Ast_literal.type_unit ()) in diff --git a/compiler/frontend/ast_derive_js_mapper.ml b/compiler/frontend/ast_derive_js_mapper.ml index b8ccadda9e5..231bf436066 100644 --- a/compiler/frontend/ast_derive_js_mapper.ml +++ b/compiler/frontend/ast_derive_js_mapper.ml @@ -75,7 +75,9 @@ let erase_type_str = Str.primitive (Val.mk ~prim:(Parsetree.Prim_name "%identity") {loc = noloc; txt = erase_type_lit} - (Ast_helper.Typ.arrow [{attrs = []; lbl = Nolabel; typ = any}] any)) + (Ast_helper.Typ.arrow + [Parg_type {attrs = []; lbl = Nolabel; typ = any}] + any)) let unsafe_index = "_index" @@ -87,8 +89,8 @@ let unsafe_index_get = ~attrs:[Ast_attributes.get_index] (Ast_helper.Typ.arrow [ - {attrs = []; lbl = Nolabel; typ = any}; - {attrs = []; lbl = Nolabel; typ = any}; + Parg_type {attrs = []; lbl = Nolabel; typ = any}; + Parg_type {attrs = []; lbl = Nolabel; typ = any}; ] any)) @@ -137,7 +139,8 @@ let build_map (row_fields : Parsetree.row_field list) = in (data, rev_data, !has_bs_as) -let ( ->~ ) a b = Ast_helper.Typ.arrow [{attrs = []; lbl = Nolabel; typ = a}] b +let ( ->~ ) a b = + Ast_helper.Typ.arrow [Parg_type {attrs = []; lbl = Nolabel; typ = a}] b let raise_when_not_found_ident = Longident.Ldot (Lident Primitive_modules.util, "raiseWhenNotFound") @@ -293,7 +296,7 @@ let init () = let to_js_type result = Ast_comb.single_non_rec_val pat_to_js (Ast_helper.Typ.arrow - [{attrs = []; lbl = Nolabel; typ = core_type}] + [Parg_type {attrs = []; lbl = Nolabel; typ = core_type}] result) in let new_type, new_tdcl = diff --git a/compiler/frontend/ast_derive_projector.ml b/compiler/frontend/ast_derive_projector.ml index 3203b116087..8a3e5c11225 100644 --- a/compiler/frontend/ast_derive_projector.ml +++ b/compiler/frontend/ast_derive_projector.ml @@ -134,7 +134,9 @@ let init () = Ext_list.map label_declarations (fun {pld_name; pld_type} -> Ast_comb.single_non_rec_val ?attrs:gentype_attrs pld_name (Ast_helper.Typ.arrow - [{attrs = []; lbl = Nolabel; typ = core_type}] + [ + Parg_type {attrs = []; lbl = Nolabel; typ = core_type}; + ] pld_type (*arity will alwys be 1 since these are single param functions*))) | Ptype_variant constructor_declarations -> @@ -162,8 +164,8 @@ let init () = {loc; txt = Ext_string.uncapitalize_ascii con_name} (match Ext_list.map pcd_args (fun x -> - ({attrs = []; lbl = Nolabel; typ = x} - : Parsetree.arg)) + Parsetree.Parg_type + {attrs = []; lbl = Nolabel; typ = x}) with | [] -> (* zero-argument constructor: the accessor is a value *) diff --git a/compiler/frontend/ast_exp_extension.ml b/compiler/frontend/ast_exp_extension.ml index bc51df89a96..7c52cde804b 100644 --- a/compiler/frontend/ast_exp_extension.ml +++ b/compiler/frontend/ast_exp_extension.ml @@ -27,7 +27,6 @@ let handle_extension e (_self : Ast_mapper.mapper) (({txt; loc}, payload) : Parsetree.extension) = match txt with | "todo" -> - Ast_payload.reject_json_literal_payload payload; let todo_message = match Ast_payload.semantic_string_of_payload payload with | Some s -> Some s diff --git a/compiler/frontend/ast_exp_handle_external.ml b/compiler/frontend/ast_exp_handle_external.ml index 0607617bdc5..74572a82b60 100644 --- a/compiler/frontend/ast_exp_handle_external.ml +++ b/compiler/frontend/ast_exp_handle_external.ml @@ -28,7 +28,7 @@ let handle_debugger loc (payload : Ast_payload.t) = Ast_external_mk.local_external_apply loc ~pval_prim:(Prim_name "%debugger") ~pval_type: (Ast_helper.Typ.arrow - [{attrs = []; lbl = Nolabel; typ = Ast_helper.Typ.any ()}] + [Parg_type {attrs = []; lbl = Nolabel; typ = Ast_helper.Typ.any ()}] (Ast_literal.type_unit ())) [Ast_literal.val_unit ~loc ()] | _ -> @@ -56,7 +56,10 @@ let handle_raw ~kind loc payload = ~pval_prim:(Prim_name "#raw_expr") ~pval_type: (Ast_helper.Typ.arrow - [{attrs = []; lbl = Nolabel; typ = Ast_helper.Typ.any ()}] + [ + Parg_type + {attrs = []; lbl = Nolabel; typ = Ast_helper.Typ.any ()}; + ] (Ast_helper.Typ.any ())) [exp]; pexp_attributes = @@ -86,7 +89,7 @@ let handle_ffi ~loc ~payload = let effective_arity = if arity = 0 then 1 else arity in let args = Ext_list.init effective_arity (fun _ -> - ({attrs = []; lbl = Nolabel; typ = any} : Parsetree.arg)) + Parsetree.Parg_type {attrs = []; lbl = Nolabel; typ = any}) in Ast_helper.Typ.arrow ~loc args any in @@ -102,7 +105,10 @@ let handle_ffi ~loc ~payload = ~pval_prim:(Prim_name "#raw_expr") ~pval_type: (Ast_helper.Typ.arrow - [{attrs = []; lbl = Nolabel; typ = Ast_helper.Typ.any ()}] + [ + Parg_type + {attrs = []; lbl = Nolabel; typ = Ast_helper.Typ.any ()}; + ] (Ast_helper.Typ.any ())) [exp]; pexp_attributes = @@ -122,7 +128,10 @@ let handle_raw_structure loc payload = ~pval_prim:(Prim_name "#raw_stmt") ~pval_type: (Ast_helper.Typ.arrow - [{attrs = []; lbl = Nolabel; typ = Ast_helper.Typ.any ()}] + [ + Parg_type + {attrs = []; lbl = Nolabel; typ = Ast_helper.Typ.any ()}; + ] (Ast_helper.Typ.any ())) [exp]; } diff --git a/compiler/frontend/ast_external_process.ml b/compiler/frontend/ast_external_process.ml index b64aae652a8..b08da6f73c7 100644 --- a/compiler/frontend/ast_external_process.ml +++ b/compiler/frontend/ast_external_process.ml @@ -86,11 +86,7 @@ let refine_arg_type ~(nolabel : bool) (ptyp : Ast_core_type.t) : *) Bs_ast_invariant.warn_discarded_unused_attributes ptyp_attrs; match cst with - | Int i -> - (* This type is used in obj only to construct obj type*) - Arg_cst (External_arg_spec.cst_int i) - | Str s -> Arg_cst (External_arg_spec.cst_string s) - | Json s -> Arg_cst (External_arg_spec.cst_json s)) + | Fixed source -> Arg_cst (External_arg_spec.cst_fixed source)) else (* ([`a|`b] [@string]) *) spec_of_ptyp nolabel ptyp @@ -106,14 +102,7 @@ let refine_obj_arg_type ~(nolabel : bool) (ptyp : Ast_core_type.t) : Bs_ast_invariant.warn_discarded_unused_attributes ptyp_attrs; match payload with | None -> Bs_syntaxerr.err ptyp.ptyp_loc Invalid_underscore_type_in_external - | Some (Int i) -> - (* @as(24) *) - (* This type is used in obj only to construct obj type *) - Arg_cst (External_arg_spec.cst_int i) - | Some (Str s) -> - (* @as("foo") *) - Arg_cst (External_arg_spec.cst_string s) - | Some (Json s) -> Arg_cst (External_arg_spec.cst_json s)) + | Some (Fixed source) -> Arg_cst (External_arg_spec.cst_fixed source)) else (* ([`a|`b] [@string]) *) spec_of_ptyp nolabel ptyp @@ -210,7 +199,6 @@ let parse_external_attributes (no_arguments : bool) (prim_name_check : string) | PStr [] -> prim_name_or_pval_prim (* It is okay to have [@@val] without payload *) | _ -> ( - Ast_payload.reject_json_literal_payload payload; match Ast_payload.semantic_string_of_payload payload with | Some val_name -> {name = val_name; source = Payload} | None -> Location.raise_errorf ~loc "Invalid payload") @@ -406,6 +394,13 @@ type response = { no_inline_cross_module: bool; } +let fixed_arg_type ({txt = source; loc} : Parsetree.fixed_value) = + match Classify_function.classify source with + | Js_literal _ -> + External_arg_spec.Arg_cst (External_arg_spec.cst_fixed source) + | _ -> + Location.raise_errorf ~loc "The %%raw payload must be a JavaScript literal" + let process_obj (loc : Location.t) (st : external_desc) (prim_name : string) (arg_types_ty : Parsetree.arg list) (result_type : Ast_core_type.t) : int * Parsetree.core_type * External_ffi_types.t = @@ -437,8 +432,12 @@ let process_obj (loc : Location.t) (st : external_desc) (prim_name : string) param_type (arg_labels, (arg_types : Parsetree.arg list), result_types) -> - let arg_label = param_type.lbl in - let ty = param_type.typ in + let arg_label, param_attrs, ty, fixed = + match param_type with + | Parsetree.Parg_type {attrs; lbl; typ} -> (lbl, attrs, typ, None) + | Parsetree.Parg_fixed {attrs; lbl; value} -> + (lbl, attrs, Ast_helper.Typ.any ~loc:value.loc (), Some value) + in let new_arg_label, new_arg_types, output_tys = match arg_label with | Nolabel -> ( @@ -452,13 +451,15 @@ let process_obj (loc : Location.t) (st : external_desc) (prim_name : string) "expect label, optional, or unit here") | Labelled {txt = label} -> ( let field_name = - match - Ast_attributes.iter_process_bs_string_as param_type.attrs - with + match Ast_attributes.iter_process_bs_string_as param_attrs with | Some alias -> alias | None -> label in - let obj_arg_type = refine_obj_arg_type ~nolabel:false ty in + let obj_arg_type = + match fixed with + | Some value -> fixed_arg_type value + | None -> refine_obj_arg_type ~nolabel:false ty + in match obj_arg_type with | Ignore -> ( External_arg_spec.empty_kind obj_arg_type, @@ -511,13 +512,15 @@ let process_obj (loc : Location.t) (st : external_desc) (prim_name : string) "%@obj label %s does not support %@unwrap arguments" label) | Optional {txt = label} -> ( let field_name = - match - Ast_attributes.iter_process_bs_string_as param_type.attrs - with + match Ast_attributes.iter_process_bs_string_as param_attrs with | Some alias -> alias | None -> label in - let obj_arg_type = get_opt_arg_type ~nolabel:false ty in + let obj_arg_type = + match fixed with + | Some value -> fixed_arg_type value + | None -> get_opt_arg_type ~nolabel:false ty + in match obj_arg_type with | Ignore -> ( External_arg_spec.empty_kind obj_arg_type, @@ -921,14 +924,21 @@ let handle_attributes (loc : Bs_loc.t) (type_annotation : Parsetree.core_type) Ext_list.fold_right arg_types_ty (([], [], 0) : External_arg_spec.params * Parsetree.arg list * int) (fun param_type (arg_type_specs, arg_types, i) -> - let arg_label = param_type.lbl in - let ty = param_type.typ in + let arg_label, ty, fixed = + match param_type with + | Parsetree.Parg_type {lbl; typ} -> (lbl, typ, None) + | Parsetree.Parg_fixed {lbl; value} -> + (lbl, Ast_helper.Typ.any ~loc:value.loc (), Some value) + in (if i = 0 && splice then - match arg_label with - | Optional _ -> + match (arg_label, fixed) with + | _, Some value -> + Location.raise_errorf ~loc:value.loc + "%@variadic expect the last type to be an array" + | Optional _, None -> Location.raise_errorf ~loc "%@variadic expect the last type to be a non optional" - | Labelled _ | Nolabel -> ( + | (Labelled _ | Nolabel), None -> ( if ty.ptyp_desc = Ptyp_any then Location.raise_errorf ~loc "%@variadic expect the last type to be an array"; @@ -945,7 +955,11 @@ let handle_attributes (loc : Bs_loc.t) (type_annotation : Parsetree.core_type) new_arg_types ) = match arg_label with | Optional {txt = s} -> ( - let arg_type = get_opt_arg_type ~nolabel:false ty in + let arg_type = + match fixed with + | Some value -> fixed_arg_type value + | None -> get_opt_arg_type ~nolabel:false ty + in match arg_type with | Poly_var _ -> (* ?x:([`x of int ] [@string]) does not make sense *) @@ -955,14 +969,22 @@ let handle_attributes (loc : Bs_loc.t) (type_annotation : Parsetree.core_type) s | _ -> (Arg_optional, arg_type, param_type :: arg_types)) | Labelled _ -> ( - let arg_type = refine_arg_type ~nolabel:false ty in + let arg_type = + match fixed with + | Some value -> fixed_arg_type value + | None -> refine_arg_type ~nolabel:false ty + in ( Arg_label, arg_type, match arg_type with | Arg_cst _ -> arg_types | _ -> param_type :: arg_types )) | Nolabel -> ( - let arg_type = refine_arg_type ~nolabel:true ty in + let arg_type = + match fixed with + | Some value -> fixed_arg_type value + | None -> refine_arg_type ~nolabel:true ty + in ( Arg_empty, arg_type, match arg_type with @@ -984,7 +1006,9 @@ let handle_attributes (loc : Bs_loc.t) (type_annotation : Parsetree.core_type) (Location.mkloc (Longident.Lident "unit") loc) [] in - let unit_arg = {Parsetree.attrs = []; lbl = Nolabel; typ = unit_type} in + let unit_arg = + Parsetree.Parg_type {attrs = []; lbl = Nolabel; typ = unit_type} + in ( [unit_arg], arg_type_specs @ [{External_arg_spec.arg_label = Arg_empty; arg_type = Extern_unit}] diff --git a/compiler/frontend/bs_builtin_ppx.ml b/compiler/frontend/bs_builtin_ppx.ml index 25fc5eb04f2..ad1441f3fe3 100644 --- a/compiler/frontend/bs_builtin_ppx.ml +++ b/compiler/frontend/bs_builtin_ppx.ml @@ -94,9 +94,6 @@ let pat_mapper (self : mapper) (p : Parsetree.pattern) = match p.ppat_desc with | Ppat_constant (Pconst_integer (s, Some 'l')) -> {p with ppat_desc = Ppat_constant (Pconst_integer (s, None))} - | Ppat_constant (Pconst_json _) -> - Location.raise_errorf ~loc:p.ppat_loc - "Tagged template literals are not supported in patterns" | _ -> default_pat_mapper self p (* Unpack requires core_type package for type inference: @@ -562,9 +559,6 @@ let structure_item_mapper (self : mapper) (str : Parsetree.structure_item) : let has_inline_property = Ast_attributes.has_inline_payload pvb_attributes in - Option.iter - (fun (_, payload) -> Ast_payload.reject_json_literal_payload payload) - has_inline_property; match (has_inline_property, pvb_expr.pexp_desc) with | ( Some attr, ( Pexp_constant (Pconst_string _) diff --git a/compiler/frontend/ppx_entry.ml b/compiler/frontend/ppx_entry.ml index 701203f1b18..e86949064f7 100644 --- a/compiler/frontend/ppx_entry.ml +++ b/compiler/frontend/ppx_entry.ml @@ -24,28 +24,6 @@ let unsafe_mapper = Bs_builtin_ppx.mapper -(* [json] payloads are syntax-level expressions until built-in FFI processing - consumes valid [@as(json`...`)] occurrences. Reject anything left only - after that processing, so generic attributes and ordinary expressions - cannot reinterpret them as strings. *) -let unconsumed_json_iterator = - let default = Ast_iterator.default_iterator in - { - default with - expr = - (fun self expression -> - match expression.pexp_desc with - | Pexp_constant (Pconst_json _) -> - Ast_payload.reject_json_literal ~loc:expression.pexp_loc - | _ -> default.expr self expression); - pat = - (fun self pattern -> - match pattern.ppat_desc with - | Ppat_constant (Pconst_json _) -> - Ast_payload.reject_json_literal ~loc:pattern.ppat_loc - | _ -> default.pat self pattern); - } - let rewrite_signature (ast : Parsetree.signature) : Parsetree.signature = Bs_ast_invariant.iter_warnings_on_sigi ast; Ast_config.process_sig ast; @@ -61,7 +39,6 @@ let rewrite_signature (ast : Parsetree.signature) : Parsetree.signature = if !Js_config.no_builtin_ppx then ast else let result = unsafe_mapper.signature unsafe_mapper ast in - unconsumed_json_iterator.signature unconsumed_json_iterator result; (* Keep this check, since the check is not inexpensive*) Bs_ast_invariant.emit_external_warnings_on_signature result; result @@ -81,7 +58,6 @@ let rewrite_implementation (ast : Parsetree.structure) : Parsetree.structure = if !Js_config.no_builtin_ppx then ast else let result = unsafe_mapper.structure unsafe_mapper ast in - unconsumed_json_iterator.structure unconsumed_json_iterator result; (* Keep this check since it is not inexpensive*) Bs_ast_invariant.emit_external_warnings_on_structure result; result diff --git a/compiler/ml/ast_helper.ml b/compiler/ml/ast_helper.ml index 658095545ab..ed78c19b4aa 100644 --- a/compiler/ml/ast_helper.ml +++ b/compiler/ml/ast_helper.ml @@ -91,7 +91,10 @@ module Typ = struct { params = List.map - (fun (arg : Parsetree.arg) -> {arg with typ = loop arg.typ}) + (function + | Parsetree.Parg_type arg -> + Parsetree.Parg_type {arg with typ = loop arg.typ} + | Parsetree.Parg_fixed _ as arg -> arg) params; ret = loop ret; } diff --git a/compiler/ml/ast_iterator.ml b/compiler/ml/ast_iterator.ml index c94169eb0c6..3f20d7923ba 100644 --- a/compiler/ml/ast_iterator.ml +++ b/compiler/ml/ast_iterator.ml @@ -97,7 +97,11 @@ module T = struct match desc with | Ptyp_any | Ptyp_var _ -> () | Ptyp_arrow {params; ret} -> - List.iter (fun (arg : Parsetree.arg) -> sub.typ sub arg.typ) params; + List.iter + (function + | Parsetree.Parg_type {typ} -> sub.typ sub typ + | Parsetree.Parg_fixed _ -> ()) + params; sub.typ sub ret | Ptyp_tuple tyl -> List.iter (sub.typ sub) tyl | Ptyp_constr (lid, tl) -> diff --git a/compiler/ml/ast_mapper.ml b/compiler/ml/ast_mapper.ml index 99e54d2f4cf..f1159d336ad 100644 --- a/compiler/ml/ast_mapper.ml +++ b/compiler/ml/ast_mapper.ml @@ -94,7 +94,11 @@ module T = struct | Ptyp_arrow {params; ret} -> Typ.arrow ~loc ~attrs (List.map - (fun (arg : Parsetree.arg) -> {arg with typ = sub.typ sub arg.typ}) + (function + | Parsetree.Parg_type arg -> + Parsetree.Parg_type {arg with typ = sub.typ sub arg.typ} + | Parsetree.Parg_fixed arg -> + Parsetree.Parg_fixed {arg with value = map_loc sub arg.value}) params) (sub.typ sub ret) | Ptyp_tuple tyl -> Typ.tuple ~loc ~attrs (List.map (sub.typ sub) tyl) diff --git a/compiler/ml/ast_mapper_from0.ml b/compiler/ml/ast_mapper_from0.ml index 4d9af4ce7c7..29c0a38ee35 100644 --- a/compiler/ml/ast_mapper_from0.ml +++ b/compiler/ml/ast_mapper_from0.ml @@ -110,7 +110,7 @@ let map_constant ~loc = function Pconst_char {source = String_literal.encode_char_source semantic; semantic} | Pconst_string (s, Some ("js" | "*j")) -> source_string ~loc s | Pconst_string (s, None) -> semantic_string s - | Pconst_string (s, Some "json") -> Pconst_json s + | Pconst_string (s, Some "json") -> Pconst_raw_source s (* Other v0 quotation delimiters are syntax, not part of the string value. Tagged ReScript templates are represented as applications before PPX. *) | Pconst_string (semantic, Some _) -> semantic_string semantic @@ -226,9 +226,30 @@ module T = struct | Some (node_attrs, arg_attrs) -> (node_attrs, arg_attrs) | None -> ([], attrs) in - Typ.arrow ~loc ~attrs:node_attrs - [{attrs = arg_attrs; lbl; typ = sub.typ sub t1}] - (sub.typ sub t2) + let mapped_t1 = sub.typ sub t1 in + let rec extract_fixed rev_attrs = function + | [] -> None + | (({txt = "as"; loc}, payload) as attr) :: rest -> ( + match + (mapped_t1.ptyp_desc, Ast_payload.fixed_source_of_payload payload) + with + | Ptyp_any, Some source -> + Some + (Pt.Parg_fixed + { + attrs = List.rev_append rev_attrs rest; + lbl; + value = {txt = source; loc}; + }) + | _ -> extract_fixed (attr :: rev_attrs) rest) + | attr :: rest -> extract_fixed (attr :: rev_attrs) rest + in + let arg = + match extract_fixed [] arg_attrs with + | Some arg -> arg + | None -> Pt.Parg_type {attrs = arg_attrs; lbl; typ = mapped_t1} + in + Typ.arrow ~loc ~attrs:node_attrs [arg] (sub.typ sub t2) | Ptyp_tuple tyl -> Typ.tuple ~loc ~attrs (List.map (sub.typ sub) tyl) | Ptyp_constr (lid, tl) -> ( let typ0 = @@ -580,8 +601,11 @@ module E = struct let inner = sub.expr sub {e with pexp_attributes = inner_attrs0} in await ~loc ~attrs:(sub.attributes sub await_attrs0) inner | Pexp_ident x -> ident ~loc ~attrs (map_loc sub x) + | Pexp_constant (Pconst_string (source, Some "json")) -> + let tag = ident ~loc (Location.mkloc (Longident.Lident "json") loc) in + tagged_template ~loc ~attrs tag [{txt = source; loc}] [] | Pexp_constant (Pconst_string (text, delimiter)) - when has_template_attr attrs && delimiter <> Some "json" -> + when has_template_attr attrs -> let attrs = remove_template_attr attrs in let source = template_source_from0 (text, delimiter) in template ~loc ~attrs [{txt = source; loc}] [] diff --git a/compiler/ml/ast_mapper_to0.ml b/compiler/ml/ast_mapper_to0.ml index 030aa7fe597..f106cb8aa8a 100644 --- a/compiler/ml/ast_mapper_to0.ml +++ b/compiler/ml/ast_mapper_to0.ml @@ -82,7 +82,6 @@ let map_constant = function | Pconst_string payload -> Pconst_string (String_literal.string_source payload, Some "js") | Pconst_raw_source s -> Pconst_string (s, Some "js") - | Pconst_json s -> Pconst_string (s, Some "json") | Pconst_float (s, suffix) -> Pconst_float (s, suffix) let template_attr = (Location.mknoloc "res.template", Pt.PStr []) @@ -153,9 +152,29 @@ module T = struct let rec build (params : Parsetree.arg list) = match params with | [] -> sub.typ sub ret - | (arg : Parsetree.arg) :: rest -> - let lbl = Asttypes.to_noloc arg.lbl in - let arg_attrs = sub.attributes sub arg.attrs in + | arg :: rest -> + let lbl, arg_attrs, arg_type, arg_loc = + match arg with + | Parg_type {attrs; lbl; typ} -> + ( Asttypes.to_noloc lbl, + sub.attributes sub attrs, + sub.typ sub typ, + typ.ptyp_loc ) + | Parg_fixed {attrs; lbl; value} -> + let payload = + Pt.PStr + [ + Ast_helper0.Str.eval ~loc:value.loc + (Ast_helper0.Exp.constant ~loc:value.loc + (Pt.Pconst_string (value.txt, Some "json"))); + ] + in + ( Asttypes.to_noloc lbl, + sub.attributes sub attrs + @ [({txt = "as"; loc = value.loc}, payload)], + Ast_helper0.Typ.any ~loc:value.loc (), + value.loc ) + in let is_head = List.length rest = arity - 1 in let merged_attrs = if is_head && attrs <> [] then @@ -166,11 +185,9 @@ module T = struct else arg_attrs in let arrow_loc = - if is_head then loc - else {loc with loc_start = arg.typ.ptyp_loc.loc_start} + if is_head then loc else {loc with loc_start = arg_loc.loc_start} in - arrow ~loc:arrow_loc ~attrs:merged_attrs lbl (sub.typ sub arg.typ) - (build rest) + arrow ~loc:arrow_loc ~attrs:merged_attrs lbl arg_type (build rest) in let typ0 = build params in let arity_string = "Has_arity" ^ string_of_int arity in diff --git a/compiler/ml/ast_payload.ml b/compiler/ml/ast_payload.ml index 72f81567fbb..9d3bda95315 100644 --- a/compiler/ml/ast_payload.ml +++ b/compiler/ml/ast_payload.ml @@ -24,25 +24,6 @@ type t = Parsetree.payload -let json_literal_outside_external_message = - "A `json` literal can only be used in an external attribute such as `@as`" - -let reject_json_literal ~loc = - Location.raise_errorf ~loc "%s" json_literal_outside_external_message - -let reject_json_literal_payload (payload : t) = - match payload with - | PStr - [ - { - pstr_desc = - Pstr_eval - ({pexp_desc = Pexp_constant (Pconst_json _); pexp_loc; _}, _); - }; - ] -> - reject_json_literal ~loc:pexp_loc - | _ -> () - let semantic_string_of_expression (expression : Parsetree.expression) = match expression with | {pexp_desc = Pexp_constant (Pconst_string payload); _} -> @@ -63,6 +44,78 @@ let semantic_string_of_payload (x : t) = semantic_string_of_expression expression | _ -> None +let quote_js_string semantic = + "\"" ^ String_literal.encode_js_string semantic ^ "\"" + +let rec fixed_source_of_expression (expression : Parsetree.expression) = + let map_all f values = + let rec loop acc = function + | [] -> Some (List.rev acc) + | value :: rest -> ( + match f value with + | Some mapped -> loop (mapped :: acc) rest + | None -> None) + in + loop [] values + in + match expression.pexp_desc with + | Pexp_constant (Pconst_string payload) -> + Some (quote_js_string (String_literal.string_semantic payload)) + | Pexp_template {source_segments = [{txt = source}]; values = []} -> ( + match String_literal.decode_js_template_escapes source with + | Some semantic -> Some (quote_js_string semantic) + | None -> None) + | Pexp_constant (Pconst_integer (source, None)) -> Some source + | Pexp_constant (Pconst_integer (source, Some 'n')) -> Some (source ^ "n") + | Pexp_constant (Pconst_float (source, None)) -> Some source + | Pexp_tagged_template + { + tag = {pexp_desc = Pexp_ident {txt = Lident "json"}}; + raw_sources = [{txt = source}]; + values = []; + } -> + Some source + | Pexp_construct ({txt = Lident "true"}, None) -> Some "true" + | Pexp_construct ({txt = Lident "false"}, None) -> Some "false" + | Pexp_ident {txt = Lident "null"} -> Some "null" + | Pexp_ident {txt = Lident "undefined"} -> Some "undefined" + | Pexp_array values -> ( + match map_all fixed_source_of_expression values with + | Some values -> Some ("[" ^ String.concat "," values ^ "]") + | None -> None) + | Pexp_object_literal fields -> + let field_source + (({txt = name}, value) : string Location.loc * Parsetree.expression) = + match fixed_source_of_expression value with + | Some value -> Some (quote_js_string name ^ ":" ^ value) + | None -> None + in + begin match map_all field_source fields with + | Some fields -> Some ("{" ^ String.concat "," fields ^ "}") + | None -> None + end + | Pexp_record (fields, None) -> + let field_source + ({lid; x = value; opt} : Parsetree.expression Parsetree.record_element) + = + if opt then None + else + match (lid.txt, fixed_source_of_expression value) with + | Lident name, Some value -> Some (quote_js_string name ^ ":" ^ value) + | Ldot _, _ | _, None -> None + in + begin match map_all field_source fields with + | Some fields -> Some ("{" ^ String.concat "," fields ^ "}") + | None -> None + end + | _ -> None + +let fixed_source_of_payload (payload : t) = + match payload with + | PStr [{pstr_desc = Pstr_eval (expression, _); _}] -> + fixed_source_of_expression expression + | PStr _ | PSig _ | PTyp _ | PPat _ -> None + let is_single_int (x : t) : int option = match x with | PStr diff --git a/compiler/ml/ast_payload.mli b/compiler/ml/ast_payload.mli index ebaf2636d22..4faa5e567bb 100644 --- a/compiler/ml/ast_payload.mli +++ b/compiler/ml/ast_payload.mli @@ -31,10 +31,6 @@ type lid = string Asttypes.loc type action = lid * Parsetree.expression option -val json_literal_outside_external_message : string -val reject_json_literal : loc:Location.t -> 'a -val reject_json_literal_payload : t -> unit - val semantic_string_of_expression : Parsetree.expression -> string option (** Return the decoded value when the expression is an ordinary string or a non-interpolated backquoted string. *) @@ -43,6 +39,11 @@ val semantic_string_of_payload : t -> string option (** Return the decoded value of an ordinary or non-interpolated backquoted string. Other prefixed literals, such as [json], are not semantic strings. *) +val fixed_source_of_payload : t -> string option +(** Convert a recursively static literal payload to validated JavaScript source. + This does not accept calls, spreads, interpolation, or other executable + expressions. *) + val is_single_int : t -> int option val is_single_float : t -> string option diff --git a/compiler/ml/ast_untagged_variants.ml b/compiler/ml/ast_untagged_variants.ml index b0899646774..c38cc9cbb9d 100644 --- a/compiler/ml/ast_untagged_variants.ml +++ b/compiler/ml/ast_untagged_variants.ml @@ -197,7 +197,6 @@ let process_tag_name (attrs : Parsetree.attributes) = match txt with | "tag" -> if !st = None then ( - Ast_payload.reject_json_literal_payload payload; (match Ast_payload.semantic_string_of_payload payload with | None -> () | Some s -> st := Some s); diff --git a/compiler/ml/builtin_attributes.ml b/compiler/ml/builtin_attributes.ml index 9aa5c5756b6..0a58de40e2f 100644 --- a/compiler/ml/builtin_attributes.ml +++ b/compiler/ml/builtin_attributes.ml @@ -16,9 +16,7 @@ open Asttypes open Parsetree -let string_of_payload payload = - Ast_payload.reject_json_literal_payload payload; - Ast_payload.semantic_string_of_payload payload +let string_of_payload payload = Ast_payload.semantic_string_of_payload payload let string_of_opt_payload p = match string_of_payload p with diff --git a/compiler/ml/depend.ml b/compiler/ml/depend.ml index 50537890c53..395185aaf9b 100644 --- a/compiler/ml/depend.ml +++ b/compiler/ml/depend.ml @@ -100,7 +100,11 @@ let rec add_type bv ty = | Ptyp_any -> () | Ptyp_var _ -> () | Ptyp_arrow {params; ret} -> - List.iter (fun arg -> add_type bv arg.typ) params; + List.iter + (function + | Parg_type {typ} -> add_type bv typ + | Parg_fixed _ -> ()) + params; add_type bv ret | Ptyp_tuple tl -> List.iter (add_type bv) tl | Ptyp_constr (c, tl) -> diff --git a/compiler/ml/external_arg_spec.ml b/compiler/ml/external_arg_spec.ml index b8f2bb6302e..1246ae00eda 100644 --- a/compiler/ml/external_arg_spec.ml +++ b/compiler/ml/external_arg_spec.ml @@ -24,10 +24,7 @@ (** type definitions for arguments to a function declared external *) -type cst = - | Arg_int_lit of int - | Arg_string_lit of string - | Arg_json_lit of string +type cst = Arg_fixed_lit of string type label_noname = Arg_label | Arg_empty | Arg_optional @@ -69,10 +66,7 @@ type obj_params = obj_param list type params = param list -let cst_int i = Arg_int_lit i - -let cst_string s = Arg_string_lit s -let cst_json s = Arg_json_lit s +let cst_fixed source = Arg_fixed_lit source let empty_label = Obj_empty diff --git a/compiler/ml/external_arg_spec.mli b/compiler/ml/external_arg_spec.mli index 058be3c7f55..0a44c7224cb 100644 --- a/compiler/ml/external_arg_spec.mli +++ b/compiler/ml/external_arg_spec.mli @@ -22,10 +22,7 @@ * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. *) -type cst = private - | Arg_int_lit of int - | Arg_string_lit of string - | Arg_json_lit of string +type cst = private Arg_fixed_lit of string type attr = | Poly_var_string of {descr: (string * string) list} @@ -54,10 +51,7 @@ type obj_params = obj_param list type params = param list -val cst_int : int -> cst - -val cst_string : string -> cst -val cst_json : string -> cst +val cst_fixed : string -> cst val empty_label : label diff --git a/compiler/ml/parsetree.ml b/compiler/ml/parsetree.ml index 3044e9a08ba..7cbaee89648 100644 --- a/compiler/ml/parsetree.ml +++ b/compiler/ml/parsetree.ml @@ -47,12 +47,6 @@ type constant = legacy three-digit decimal escapes to hexadecimal escapes. Compiler-created Payloads are constructed through [String_literal], which validates this relationship. *) - | Pconst_json of string - (* The JavaScript source inside a non-interpolated [json`...`] literal. For - example, [@as(json`{"ok": true}`)] stores ["{\"ok\": true}"]. Built-in - FFI processing consumes this form in supported external attributes; - otherwise the frontend rejects it. The string is JavaScript source, not a - decoded ReScript string value. *) | Pconst_raw_source of string (* JavaScript source carried by a compiler extension such as [raw], [ffi], or [re]. For example, [%raw("x + 1")] stores ["x + 1"]. The extension @@ -101,7 +95,11 @@ and core_type = { ptyp_attributes: attributes; (* ... [@id1] [@id2] *) } -and arg = {attrs: attributes; lbl: arg_label; typ: core_type} +and fixed_value = string loc + +and arg = + | Parg_type of {attrs: attributes; lbl: arg_label; typ: core_type} + | Parg_fixed of {attrs: attributes; lbl: arg_label; value: fixed_value} and core_type_desc = | Ptyp_any (* _ *) diff --git a/compiler/ml/pprintast.ml b/compiler/ml/pprintast.ml index d421bc2b6f0..cdae359660d 100644 --- a/compiler/ml/pprintast.ml +++ b/compiler/ml/pprintast.ml @@ -255,8 +255,6 @@ let constant f = function | Pconst_string payload -> pp f "{js|%a|js}" print_string_with_byte_width (String_literal.string_source payload) - | Pconst_json source -> - pp f "{json|%a|json}" print_string_with_byte_width source | Pconst_raw_source source -> pp f "{js|%a|js}" print_string_with_byte_width source | Pconst_integer (i, None) -> paren (i.[0] = '-') (fun f -> pp f "%s") f i @@ -297,14 +295,23 @@ let tyvar_loc f str = pp f "'%s" str.txt let string_quot f x = pp f "`%s" x let rec type_with_label ctxt f arg = - match arg.lbl with - | Nolabel -> - pp f "%a%a" (core_type1 ctxt) arg.typ (attributes ctxt) arg.attrs - (* otherwise parenthesize *) - | Labelled {txt = s} -> - pp f "%s:%a%a" s (core_type1 ctxt) arg.typ (attributes ctxt) arg.attrs - | Optional {txt = s} -> - pp f "?%s:%a%a" s (core_type1 ctxt) arg.typ (attributes ctxt) arg.attrs + match arg with + | Parg_fixed {attrs; lbl; value} -> + let label = + match lbl with + | Nolabel -> "" + | Labelled {txt = s} -> s ^ ":" + | Optional {txt = s} -> "?" ^ s ^ ":" + in + pp f "%s%%raw(%a)%a" label print_quoted_string_with_byte_width value.txt + (attributes ctxt) attrs + | Parg_type {attrs; lbl; typ} -> ( + match lbl with + | Nolabel -> pp f "%a%a" (core_type1 ctxt) typ (attributes ctxt) attrs + | Labelled {txt = s} -> + pp f "%s:%a%a" s (core_type1 ctxt) typ (attributes ctxt) attrs + | Optional {txt = s} -> + pp f "?%s:%a%a" s (core_type1 ctxt) typ (attributes ctxt) attrs) and core_type ctxt f x = if x.ptyp_attributes <> [] then diff --git a/compiler/ml/printast.ml b/compiler/ml/printast.ml index b15cecd6f37..a243d99696f 100644 --- a/compiler/ml/printast.ml +++ b/compiler/ml/printast.ml @@ -66,7 +66,6 @@ let fmt_constant f x = fprintf f "PConst_string (source=%S, semantic=%S)" (String_literal.string_source payload) (String_literal.string_semantic payload) - | Pconst_json source -> fprintf f "PConst_json %S" source | Pconst_raw_source source -> fprintf f "PConst_raw_source %S" source | Pconst_float (s, m) -> fprintf f "PConst_float (%s,%a)" s fmt_char_option m @@ -139,10 +138,15 @@ let rec core_type i ppf x = line i ppf "Ptyp_arrow\n"; line i ppf "arity = %d\n" (List.length params); List.iter - (fun (arg : Parsetree.arg) -> - arg_label_loc i ppf arg.lbl; - attributes i ppf arg.attrs; - core_type i ppf arg.typ) + (function + | Parsetree.Parg_type {attrs; lbl; typ} -> + arg_label_loc i ppf lbl; + attributes i ppf attrs; + core_type i ppf typ + | Parsetree.Parg_fixed {attrs; lbl; value} -> + line i ppf "Parg_fixed %S\n" value.txt; + arg_label_loc i ppf lbl; + attributes i ppf attrs) params; core_type i ppf ret | Ptyp_tuple l -> diff --git a/compiler/ml/translcore.ml b/compiler/ml/translcore.ml index 70519a7ea21..f4b7ee7d34a 100644 --- a/compiler/ml/translcore.ml +++ b/compiler/ml/translcore.ml @@ -965,9 +965,7 @@ let pack_trywith_exn id handler = let extract_directive_for_fn exp = exp.exp_attributes |> List.find_map (fun ({txt}, payload) -> - if txt = "directive" then ( - Ast_payload.reject_json_literal_payload payload; - Ast_payload.semantic_string_of_payload payload) + if txt = "directive" then Ast_payload.semantic_string_of_payload payload else None) let hoisted_function_attr_name = "res.hoistedFunction" diff --git a/compiler/ml/typecore.ml b/compiler/ml/typecore.ml index 00b6b60e729..0239efa5579 100644 --- a/compiler/ml/typecore.ml +++ b/compiler/ml/typecore.ml @@ -83,7 +83,6 @@ type error = | Polyvar_literal_overflow | Unknown_literal of string * char | Invalid_string_escape_sequence - | Json_literal_outside_external | Illegal_letrec_pat | Empty_record_literal | Uncurried_arity_mismatch of { @@ -286,7 +285,6 @@ let constant : Parsetree.constant -> (Asttypes.constant, error) result = | Pconst_char {semantic} -> Ok (Const_char semantic) | Pconst_string payload -> Ok (Const_string (String_literal.string_semantic payload)) - | Pconst_json _ -> Error Json_literal_outside_external | Pconst_raw_source s -> Ok (Const_string s) | Pconst_float (f, None) -> Ok (Const_float f) | Pconst_float (f, Some c) -> Error (Unknown_literal (f, c)) @@ -2001,12 +1999,18 @@ let rec approx_type env sty = newty (Tarrow ( List.map - (fun ({lbl = p} : Parsetree.arg) -> - { - Types.lbl = p; - typ = - (if is_optional p then type_option (newvar ()) else newvar ()); - }) + (function + | Parsetree.Parg_type {lbl = p} -> + { + Types.lbl = p; + typ = + (if is_optional p then type_option (newvar ()) + else newvar ()); + } + | Parsetree.Parg_fixed {value} -> + Location.raise_errorf ~loc:value.loc + "%%raw fixed arguments are only allowed on external \ + functions") params, approx_type env sty )) | Ptyp_tuple args -> newty (Ttuple (List.map (approx_type env) args)) @@ -5266,8 +5270,6 @@ let report_error env loc ppf error = fprintf ppf "Unknown modifier '%c' for literal %s%c" m n m | Invalid_string_escape_sequence -> fprintf ppf "Invalid string escape sequence" - | Json_literal_outside_external -> - fprintf ppf "%s" Ast_payload.json_literal_outside_external_message | Illegal_letrec_pat -> fprintf ppf "Only variables are allowed as left-hand side of `let rec`" | Empty_record_literal -> diff --git a/compiler/ml/typecore.mli b/compiler/ml/typecore.mli index cc0cc6415cd..68c3cd0392d 100644 --- a/compiler/ml/typecore.mli +++ b/compiler/ml/typecore.mli @@ -116,7 +116,6 @@ type error = | Polyvar_literal_overflow | Unknown_literal of string * char | Invalid_string_escape_sequence - | Json_literal_outside_external | Illegal_letrec_pat | Empty_record_literal | Uncurried_arity_mismatch of { diff --git a/compiler/ml/typetexp.ml b/compiler/ml/typetexp.ml index d72edc99007..8a5859ffc97 100644 --- a/compiler/ml/typetexp.ml +++ b/compiler/ml/typetexp.ml @@ -307,31 +307,31 @@ and transl_type_aux env policy styp = | Ptyp_arrow {params; ret} -> let cparams = List.map - (fun (arg : Parsetree.arg) -> - let cty = transl_type env policy arg.typ in - let ty = - if Btype.is_optional arg.lbl then - newty (Tconstr (Predef.path_option, [cty.ctyp_type], ref Mnil)) - else cty.ctyp_type - in - (arg, cty, ty)) + (function + | Parsetree.Parg_type {attrs; lbl; typ} -> + let cty = transl_type env policy typ in + let ty = + if Btype.is_optional lbl then + newty (Tconstr (Predef.path_option, [cty.ctyp_type], ref Mnil)) + else cty.ctyp_type + in + (attrs, lbl, cty, ty) + | Parsetree.Parg_fixed {value} -> + Location.raise_errorf ~loc:value.loc + "%%raw fixed arguments are only allowed on external functions") params in let cty2 = transl_type env policy ret in let ty = newty (Tarrow - ( List.map - (fun ((arg : Parsetree.arg), _, ty1) -> - {Types.lbl = arg.lbl; typ = ty1}) - cparams, + ( List.map (fun (_, lbl, _, ty1) -> {Types.lbl; typ = ty1}) cparams, cty2.ctyp_type )) in ctyp (Ttyp_arrow ( List.map - (fun ((arg : Parsetree.arg), cty1, _) -> - {Typedtree.attrs = arg.attrs; lbl = arg.lbl; typ = cty1}) + (fun (attrs, lbl, cty1, _) -> {Typedtree.attrs; lbl; typ = cty1}) cparams, cty2 )) ty diff --git a/compiler/syntax/src/jsx_v4.ml b/compiler/syntax/src/jsx_v4.ml index 9b15ed3f301..455b54d3a9b 100644 --- a/compiler/syntax/src/jsx_v4.ml +++ b/compiler/syntax/src/jsx_v4.ml @@ -931,7 +931,7 @@ let rec collect_prop_types types {ptyp_desc} = in let rec go types = function | [] -> if ret_is_arrow then collect_prop_types types ret else types - | ({lbl; attrs; typ} : Parsetree.arg) :: rest + | Parsetree.Parg_type {lbl; attrs; typ} :: rest when is_labelled lbl || is_optional lbl -> let loc = match (rest, ret_is_arrow) with @@ -939,7 +939,8 @@ let rec collect_prop_types types {ptyp_desc} = | _ -> typ.ptyp_loc in go ((lbl, attrs, loc, typ) :: types) rest - | _ :: rest -> go types rest + | (Parsetree.Parg_type _ | Parsetree.Parg_fixed _) :: rest -> + go types rest in go types params | _ -> types diff --git a/compiler/syntax/src/res_ast_debugger.ml b/compiler/syntax/src/res_ast_debugger.ml index 1dde1a25662..e27f493e116 100644 --- a/compiler/syntax/src/res_ast_debugger.ml +++ b/compiler/syntax/src/res_ast_debugger.ml @@ -140,7 +140,6 @@ module Sexp_ast = struct string (String_literal.string_source payload); string (String_literal.string_semantic payload); ] - | Pconst_json source -> Sexp.list [Sexp.atom "Pconst_json"; string source] | Pconst_raw_source source -> Sexp.list [Sexp.atom "Pconst_raw_source"; string source] | Pconst_float (txt, tag) -> @@ -963,8 +962,16 @@ module Sexp_ast = struct Sexp.atom "Ptyp_arrow"; Sexp.list (map_empty - ~f:(fun (p : Parsetree.arg) -> - Sexp.list [arg_label_loc p.lbl; core_type p.typ]) + ~f:(function + | Parsetree.Parg_type {lbl; typ} -> + Sexp.list [arg_label_loc lbl; core_type typ] + | Parsetree.Parg_fixed {lbl; value} -> + Sexp.list + [ + Sexp.atom "Parg_fixed"; + arg_label_loc lbl; + string value.txt; + ]) params); core_type ret; ] diff --git a/compiler/syntax/src/res_comments_table.ml b/compiler/syntax/src/res_comments_table.ml index 4a689a51c5e..7108186f674 100644 --- a/compiler/syntax/src/res_comments_table.ml +++ b/compiler/syntax/src/res_comments_table.ml @@ -318,7 +318,7 @@ let arrow_type ct = let open Parsetree in match ct with | {ptyp_desc = Ptyp_arrow {params; ret}; ptyp_attributes = attrs} -> - (attrs, params |> List.map (fun (p : arg) -> (p.attrs, p.lbl, p.typ)), ret) + (attrs, params, ret) | typ -> ([], [], typ) (* TODO: avoiding the dependency on ParsetreeViewer here, is this a good idea? *) @@ -2251,21 +2251,32 @@ and walk_object_field field t comments = and walk_type_parameters type_parameters t comments = visit_list_but_continue_with_remaining_comments - ~get_loc:(fun (_, lbl, typexpr) -> + ~get_loc:(fun parameter -> + let lbl, end_loc = + match parameter with + | Parsetree.Parg_type {lbl; typ} -> (lbl, typ.ptyp_loc) + | Parsetree.Parg_fixed {lbl; value} -> (lbl, value.loc) + in let lbl_loc = Asttypes.get_lbl_loc lbl in - if lbl_loc <> Location.none then - {lbl_loc with loc_end = typexpr.Parsetree.ptyp_loc.loc_end} - else typexpr.ptyp_loc) + if lbl_loc <> Location.none then {lbl_loc with loc_end = end_loc.loc_end} + else end_loc) ~walk_node:walk_type_parameter ~newline_delimited:false type_parameters t comments -and walk_type_parameter (_attrs, _lbl, typexpr) t comments = - let before_typ, inside_typ, after_typ = - partition_by_loc comments typexpr.ptyp_loc - in - attach t.leading typexpr.ptyp_loc before_typ; - walk_core_type typexpr t inside_typ; - attach t.trailing typexpr.ptyp_loc after_typ +and walk_type_parameter parameter t comments = + match parameter with + | Parsetree.Parg_type {typ = typexpr} -> + let before_typ, inside_typ, after_typ = + partition_by_loc comments typexpr.ptyp_loc + in + attach t.leading typexpr.ptyp_loc before_typ; + walk_core_type typexpr t inside_typ; + attach t.trailing typexpr.ptyp_loc after_typ + | Parsetree.Parg_fixed {value} -> + let before, inside, after = partition_by_loc comments value.loc in + attach t.leading value.loc before; + attach t.inside value.loc inside; + attach t.trailing value.loc after and walk_package_type package_type t comments = let longident, package_constraints = package_type in diff --git a/compiler/syntax/src/res_core.ml b/compiler/syntax/src/res_core.ml index adfb7f34e8c..34d72138063 100644 --- a/compiler/syntax/src/res_core.ml +++ b/compiler/syntax/src/res_core.ml @@ -305,6 +305,206 @@ type type_parameter = { start_pos: Lexing.position; } +let is_fixed_value_payload (payload : Parsetree.payload) = + match payload with + | PStr + [ + { + pstr_desc = + Pstr_eval + ( { + pexp_desc = + Pexp_constant (Pconst_integer (_, None) | Pconst_string _); + _; + }, + _ ); + _; + }; + ] -> + true + | PStr + [ + { + pstr_desc = + Pstr_eval + ( { + pexp_desc = Pexp_template {source_segments = [_]; values = []}; + _; + }, + _ ); + _; + }; + ] -> + true + | PStr + [ + { + pstr_desc = + Pstr_eval + ( { + pexp_desc = + Pexp_tagged_template + { + tag = {pexp_desc = Pexp_ident {txt = Lident "json"}}; + raw_sources = [_]; + values = []; + }; + _; + }, + _ ); + _; + }; + ] -> + true + | _ -> false + +let source_of_raw_payload (payload : Parsetree.payload) = + match payload with + | PStr + [ + { + pstr_desc = + Pstr_eval + ( { + pexp_desc = Pexp_constant (Pconst_raw_source source); + pexp_loc; + _; + }, + _ ); + _; + }; + ] -> + Some (source, pexp_loc) + | PStr + [ + { + pstr_desc = + Pstr_eval + ( { + pexp_desc = + Pexp_template + {source_segments = [{txt = source}]; values = []}; + pexp_loc; + _; + }, + _ ); + _; + }; + ] -> + Some (source, pexp_loc) + | PStr _ | PSig _ | PTyp _ | PPat _ -> None + +let reject_raw_fixed_extensions p (typ : Parsetree.core_type) = + let super = Ast_iterator.default_iterator in + let iterator = + { + super with + typ = + (fun self typ -> + (match typ.ptyp_desc with + | Ptyp_extension ({txt = "raw"; loc}, _) -> + Parser.err ~start_pos:loc.loc_start ~end_pos:loc.loc_end p + (Diagnostics.message + "%raw is only allowed as a direct external function argument") + | _ -> ()); + super.typ self typ); + } + in + iterator.typ iterator typ + +let normalize_external_fixed_parameters p (typ : Parsetree.core_type) = + let typ = + match typ.ptyp_desc with + | Ptyp_arrow {params; ret} -> + let params = + List.map + (fun (arg : Parsetree.arg) -> + match arg with + | Parg_fixed _ -> arg + | Parg_type + ({ + typ = + { + ptyp_desc = + Ptyp_extension (({txt = "raw"} as id), payload); + _; + } as arg_typ; + _; + } as typed_arg) -> ( + match source_of_raw_payload payload with + | Some (source, loc) -> + Parg_fixed + { + attrs = typed_arg.attrs @ arg_typ.ptyp_attributes; + lbl = typed_arg.lbl; + value = {txt = source; loc}; + } + | None -> + Parser.err ~start_pos:id.loc.loc_start ~end_pos:id.loc.loc_end p + (Diagnostics.message + "The %raw extension can only be applied to a string"); + arg) + | Parg_type + ({typ = {ptyp_desc = Ptyp_any} as arg_typ; _} as typed_arg) -> + let rec find_fixed found rev_attrs = function + | [] -> + Option.map + (fun (id, payload) -> (id, payload, List.rev rev_attrs)) + found + | (((id : string Location.loc), payload) as attribute) :: rest + -> + if id.txt = "as" && is_fixed_value_payload payload then ( + match found with + | None -> find_fixed (Some (id, payload)) rev_attrs rest + | Some _ -> + Parser.err ~start_pos:id.loc.loc_start + ~end_pos:id.loc.loc_end p + (Diagnostics.message + "A fixed argument can only have one fixed-value @as \ + annotation"); + find_fixed found rev_attrs rest) + else find_fixed found (attribute :: rev_attrs) rest + in + begin match find_fixed None [] arg_typ.ptyp_attributes with + | None -> arg + | Some (id, payload, remaining_attrs) -> ( + Location.prerr_warning id.loc + (Warnings.Deprecated + ( "The fixed-value `@as(...) _` external argument syntax \ + is deprecated. Use `%raw(...)` instead.", + id.loc, + id.loc, + false )); + let fixed_source = + match Ast_payload.fixed_source_of_payload payload with + | Some source -> Some (source, id.loc) + | None -> None + in + match fixed_source with + | Some (source, loc) -> + Parg_fixed + { + attrs = typed_arg.attrs @ remaining_attrs; + lbl = typed_arg.lbl; + value = {txt = source; loc}; + } + | None -> + Parser.err ~start_pos:id.loc.loc_start ~end_pos:id.loc.loc_end + p + (Diagnostics.message + "The fixed-value @as payload must be a JavaScript \ + literal"); + arg) + end + | Parg_type _ -> arg) + params + in + {typ with ptyp_desc = Ptyp_arrow {params; ret}} + | _ -> typ + in + reject_raw_fixed_extensions p typ; + typ + type typ_def_or_ext = | TypeDef of { rec_flag: Asttypes.rec_flag; @@ -2552,16 +2752,6 @@ and parse_template_expr ?prefix p = in match prefix with - | Some {txt = Longident.Lident "json"; _} -> ( - match (parts, values) with - | [(source, loc, None)], [] -> - Ast_helper.Exp.constant ~loc (Pconst_json source) - | (source, loc, _) :: _, _ -> - Parser.err ~start_pos:template_loc.loc_start ~end_pos:template_loc.loc_end - p - (Diagnostics.message "`json` literals do not support interpolation"); - Ast_helper.Exp.constant ~loc (Pconst_json source) - | [], _ -> assert false) | None -> List.iter (fun ({Location.txt = source; loc} : string Location.loc) -> @@ -4551,7 +4741,9 @@ and parse_poly_type_expr ?current_type_name_path ?inline_types_context p = let typ = Ast_helper.Typ.var ~loc:var.loc var.txt in let return_type = parse_typ_expr ~alias:false p in let loc = mk_loc typ.Parsetree.ptyp_loc.loc_start p.prev_end_pos in - Ast_helper.Typ.arrow ~loc [{attrs = []; lbl = Nolabel; typ}] return_type + Ast_helper.Typ.arrow ~loc + [Parg_type {attrs = []; lbl = Nolabel; typ}] + return_type | _ -> Ast_helper.Typ.var ~loc:var.loc var.txt) | _ -> assert false) | _ -> parse_typ_expr ?current_type_name_path ?inline_types_context p @@ -4973,7 +5165,7 @@ and parse_es6_arrow_type ?current_type_name_path ?inline_types_context ~attrs p arrow, exactly like its parenthesized form [(~x: t) => u]; it must carry the same arity or the two spellings produce types that print identically but do not unify. *) - Ast_helper.Typ.arrow ~loc [{attrs; lbl; typ}] return_type + Ast_helper.Typ.arrow ~loc [Parg_type {attrs; lbl; typ}] return_type | DocComment _ -> assert false | _ -> ( let parameters = @@ -4991,7 +5183,7 @@ and parse_es6_arrow_type ?current_type_name_path ?inline_types_context ~attrs p let params = List.map (fun {attrs; label = arg_lbl; typ; start_pos = _} -> - {Parsetree.attrs; lbl = arg_lbl; typ}) + Parsetree.Parg_type {attrs; lbl = arg_lbl; typ}) parameters in let loc = mk_loc start_pos p.prev_end_pos in @@ -5066,7 +5258,9 @@ and parse_arrow_type_rest ?current_type_name_path ?inline_types_context ?inline_types_context p in let loc = mk_loc start_pos p.prev_end_pos in - Ast_helper.Typ.arrow ~loc [{attrs = []; lbl = Nolabel; typ}] return_type + Ast_helper.Typ.arrow ~loc + [Parg_type {attrs = []; lbl = Nolabel; typ}] + return_type | _ -> typ and parse_typ_expr_region p = @@ -5843,7 +6037,7 @@ and parse_type_equation_or_constr_decl p = let loc = mk_loc uident_start_pos p.prev_end_pos in let arrow_type = Ast_helper.Typ.arrow ~loc - [{attrs = []; lbl = Nolabel; typ}] + [Parg_type {attrs = []; lbl = Nolabel; typ}] return_type in let typ = parse_type_alias p arrow_type in @@ -6546,6 +6740,7 @@ and parse_external_def ~attrs ~start_pos p = in let typ_expr = parse_external_type_expr ~current_type_name_path ~inline_types_context p + |> normalize_external_fixed_parameters p in let equal_start = p.start_pos in let equal_end = p.end_pos in diff --git a/compiler/syntax/src/res_parsetree_viewer.ml b/compiler/syntax/src/res_parsetree_viewer.ml index 0a2aeeb21bc..deb91880057 100644 --- a/compiler/syntax/src/res_parsetree_viewer.ml +++ b/compiler/syntax/src/res_parsetree_viewer.ml @@ -264,7 +264,7 @@ let is_multiline_text txt = let is_huggable_expression expr = match expr.pexp_desc with | Pexp_array _ | Pexp_tuple _ - | Pexp_constant (Pconst_json _ | Pconst_char _) + | Pexp_constant (Pconst_char _) | Pexp_template {values = []} | Pexp_construct ({txt = Longident.Lident ("::" | "[]")}, _) | Pexp_object_literal _ | Pexp_record _ -> diff --git a/compiler/syntax/src/res_printer.ml b/compiler/syntax/src/res_printer.ml index 7893e4f3209..c0089c6825d 100644 --- a/compiler/syntax/src/res_printer.ml +++ b/compiler/syntax/src/res_printer.ml @@ -598,8 +598,6 @@ let print_constant c = print_string_contents (String_literal.string_source payload); Doc.text "\""; ] - | Pconst_json source -> - Doc.concat [Doc.text "json`"; print_string_contents source; Doc.text "`"] | Pconst_raw_source source -> let delimiter = if raw_source_fits_double_quotes source then "\"" else "`" @@ -1913,7 +1911,7 @@ and print_typ_expr ?inline_record_definitions ~(state : State.t) in match args with | [] -> Doc.nil - | [{attrs = []; lbl = Nolabel; typ}] -> + | [Parg_type {attrs = []; lbl = Nolabel; typ}] -> let has_attrs_before = not (attrs_before = []) in let attrs = if has_attrs_before then @@ -2316,8 +2314,26 @@ and print_object_field ~state (field : Parsetree.object_field) cmt_tbl = (* es6 arrow type arg * type t = (~foo: string, ~bar: float=?, unit) => unit * i.e. ~foo: string, ~bar: float *) -and print_type_parameter ?inline_record_definitions ~state {attrs; lbl; typ} - cmt_tbl = +and print_type_parameter ?inline_record_definitions ~state parameter cmt_tbl = + let attrs, lbl, value_doc, end_loc = + match parameter with + | Parsetree.Parg_type {attrs; lbl; typ} -> + ( attrs, + lbl, + print_typ_expr ?inline_record_definitions ~state typ cmt_tbl, + typ.ptyp_loc ) + | Parsetree.Parg_fixed {attrs; lbl; value} -> + ( attrs, + lbl, + Doc.group + (Doc.concat + [ + Doc.text "%raw("; + print_constant (Pconst_raw_source value.txt); + Doc.rparen; + ]), + value.loc ) + in (* Converting .ml code to .res requires processing uncurried attributes *) let attrs = print_attributes ~state attrs cmt_tbl in let label = @@ -2333,16 +2349,9 @@ and print_type_parameter ?inline_record_definitions ~state {attrs; lbl; typ} | Nolabel | Labelled _ -> Doc.nil | Optional _ -> Doc.text "=?" in - let loc = {(Asttypes.get_lbl_loc lbl) with loc_end = typ.ptyp_loc.loc_end} in + let loc = {(Asttypes.get_lbl_loc lbl) with loc_end = end_loc.loc_end} in let doc = - Doc.group - (Doc.concat - [ - attrs; - label; - print_typ_expr ?inline_record_definitions ~state typ cmt_tbl; - optional_indicator; - ]) + Doc.group (Doc.concat [attrs; label; value_doc; optional_indicator]) in print_comments doc cmt_tbl loc diff --git a/packages/@rescript/belt/src/Belt_Array.res b/packages/@rescript/belt/src/Belt_Array.res index 11afbf34d54..eadf27dce12 100644 --- a/packages/@rescript/belt/src/Belt_Array.res +++ b/packages/@rescript/belt/src/Belt_Array.res @@ -51,7 +51,7 @@ let setExn = setOrThrow @new external makeUninitializedUnsafe: int => array<'a> = "Array" -@send external copy: (t<'a>, @as(0) _) => t<'a> = "slice" +@send external copy: (t<'a>, %raw("0")) => t<'a> = "slice" let swapUnsafe = (xs, i, j) => { let tmp = getUnsafe(xs, i) diff --git a/packages/@rescript/belt/src/Belt_Array.resi b/packages/@rescript/belt/src/Belt_Array.resi index 75cd9fb4b21..a9076874f73 100644 --- a/packages/@rescript/belt/src/Belt_Array.resi +++ b/packages/@rescript/belt/src/Belt_Array.resi @@ -325,7 +325,7 @@ let sliceToEnd: (t<'a>, int) => t<'a> elements as `a`. */ @send -external copy: (t<'a>, @as(0) _) => t<'a> = "slice" +external copy: (t<'a>, %raw("0")) => t<'a> = "slice" /** `fill(arr, ~offset, ~len, x)` modifies `arr` in place, storing `x` in elements diff --git a/packages/@rescript/belt/src/Belt_Int.res b/packages/@rescript/belt/src/Belt_Int.res index 177aae00397..72f86f2fd6d 100644 --- a/packages/@rescript/belt/src/Belt_Int.res +++ b/packages/@rescript/belt/src/Belt_Int.res @@ -14,7 +14,7 @@ external toFloat: int => float = "%identity" external fromFloat: float => int = "%intoffloat" -@val external fromString: (string, @as(10) _) => int = "parseInt" +@val external fromString: (string, %raw("10")) => int = "parseInt" let fromString = i => switch fromString(i) { diff --git a/packages/@rescript/runtime/Stdlib_Array.res b/packages/@rescript/runtime/Stdlib_Array.res index fc639b5a559..3e892e1edea 100644 --- a/packages/@rescript/runtime/Stdlib_Array.res +++ b/packages/@rescript/runtime/Stdlib_Array.res @@ -133,7 +133,7 @@ external toSpliced: (array<'a>, ~start: int, ~remove: int, ~insert: array<'a>) = "toSpliced" @send -external removeInPlace: (array<'a>, int, @as(1) _) => unit = "splice" +external removeInPlace: (array<'a>, int, %raw("1")) => unit = "splice" @send external with: (array<'a>, int, 'a) => array<'a> = "with" diff --git a/packages/@rescript/runtime/Stdlib_Array.resi b/packages/@rescript/runtime/Stdlib_Array.resi index d411a10b54a..c5124b4d680 100644 --- a/packages/@rescript/runtime/Stdlib_Array.resi +++ b/packages/@rescript/runtime/Stdlib_Array.resi @@ -485,7 +485,7 @@ array2 == ["Hello", "Good bye"] // Removes the item at index 1 ``` */ @send -external removeInPlace: (array<'a>, int, @as(1) _) => unit = "splice" +external removeInPlace: (array<'a>, int, %raw("1")) => unit = "splice" /** `with(array, index, value)` returns a copy of `array` where the element at `index` is replaced with `value`. diff --git a/packages/@rescript/runtime/Stdlib_Dict.res b/packages/@rescript/runtime/Stdlib_Dict.res index 04f1b56281a..ac53db1ab85 100644 --- a/packages/@rescript/runtime/Stdlib_Dict.res +++ b/packages/@rescript/runtime/Stdlib_Dict.res @@ -25,14 +25,14 @@ external fromIterable: Stdlib_Iterable.t<(string, 'a)> => dict<'a> = "Object.fro @variadic @val external assignMany: (dict<'a>, array>) => dict<'a> = "Object.assign" -@val external concat: (@as(json`{}`) _, dict<'a>, dict<'a>) => dict<'a> = "Object.assign" +@val external concat: (%raw("{}"), dict<'a>, dict<'a>) => dict<'a> = "Object.assign" @variadic @val -external concatMany: (@as(json`{}`) _, dict<'a>, array>) => dict<'a> = "Object.assign" +external concatMany: (%raw("{}"), dict<'a>, array>) => dict<'a> = "Object.assign" -@variadic @val external concatAll: (@as(json`{}`) _, array>) => dict<'a> = "Object.assign" +@variadic @val external concatAll: (%raw("{}"), array>) => dict<'a> = "Object.assign" -@val external copy: (@as(json`{}`) _, dict<'a>) => dict<'a> = "Object.assign" +@val external copy: (%raw("{}"), dict<'a>) => dict<'a> = "Object.assign" // Use %raw to support for..in which is a ~10% faster than .forEach let forEach: (dict<'a>, 'a => unit) => unit = %raw(`(dict, f) => { diff --git a/packages/@rescript/runtime/Stdlib_Dict.resi b/packages/@rescript/runtime/Stdlib_Dict.resi index 224be3ffefb..b0d54fe4d12 100644 --- a/packages/@rescript/runtime/Stdlib_Dict.resi +++ b/packages/@rescript/runtime/Stdlib_Dict.resi @@ -280,7 +280,7 @@ merged == dict{"firstKey": 2, "someKey": 3} ``` */ @val -external concat: (@as(json`{}`) _, dict<'a>, dict<'a>) => dict<'a> = "Object.assign" +external concat: (%raw("{}"), dict<'a>, dict<'a>) => dict<'a> = "Object.assign" /** `concatMany(target, sources)` [shallowly](https://developer.mozilla.org/en-US/docs/Glossary/Shallow_copy) merges `target` and each dictionary in `sources` into a fresh dictionary, and returns the new dictionary. @@ -301,7 +301,7 @@ merged == dict{"firstKey": 1, "someKey": 3, "someKey2": 4} ``` */ @variadic @val -external concatMany: (@as(json`{}`) _, dict<'a>, array>) => dict<'a> = "Object.assign" +external concatMany: (%raw("{}"), dict<'a>, array>) => dict<'a> = "Object.assign" /** `concatAll(dictionaries)` [shallowly](https://developer.mozilla.org/en-US/docs/Glossary/Shallow_copy) merges all dictionaries in `dictionaries` into a fresh dictionary, and returns the new dictionary. @@ -322,7 +322,7 @@ merged == dict{"firstKey": 1, "someKey": 3, "someKey2": 4} ``` */ @variadic @val -external concatAll: (@as(json`{}`) _, array>) => dict<'a> = "Object.assign" +external concatAll: (%raw("{}"), array>) => dict<'a> = "Object.assign" /** `copy(dictionary)` [shallowly copies](https://developer.mozilla.org/en-US/docs/Glossary/Shallow_copy) the provided dictionary to a new dictionary. @@ -337,7 +337,7 @@ Console.log2(dict->Dict.keysToArray, dict2->Dict.keysToArray) ``` */ @val -external copy: (@as(json`{}`) _, dict<'a>) => dict<'a> = "Object.assign" +external copy: (%raw("{}"), dict<'a>) => dict<'a> = "Object.assign" /** `forEach(dictionary, f)` iterates through all values of the dict. diff --git a/packages/@rescript/runtime/Stdlib_JSON.res b/packages/@rescript/runtime/Stdlib_JSON.res index 50012e67c87..ba3b3a8ce64 100644 --- a/packages/@rescript/runtime/Stdlib_JSON.res +++ b/packages/@rescript/runtime/Stdlib_JSON.res @@ -34,7 +34,7 @@ external parseExnWithReviver: (string, (string, t) => t) => t = "JSON.parse" migrate: JSON.stringify(%insert.unlabelledArgument(0), ~space=%insert.unlabelledArgument(2)), }) @val -external stringifyWithIndent: (t, @as(json`null`) _, int) => string = "JSON.stringify" +external stringifyWithIndent: (t, %raw("null"), int) => string = "JSON.stringify" @deprecated({ reason: "Use `JSON.stringify` with optional parameter instead", migrate: JSON.stringify( @@ -83,7 +83,7 @@ external stringifyAny: ('a, ~replacer: replacer=?, ~space: int=?) => option option = "JSON.stringify" +external stringifyAnyWithIndent: ('a, %raw("null"), int) => option = "JSON.stringify" @deprecated({ reason: "Use `JSON.stringifyAny` with optional parameter instead", migrate: JSON.stringifyAny( diff --git a/packages/@rescript/runtime/Stdlib_JSON.resi b/packages/@rescript/runtime/Stdlib_JSON.resi index 18b3870b494..c92b77fd473 100644 --- a/packages/@rescript/runtime/Stdlib_JSON.resi +++ b/packages/@rescript/runtime/Stdlib_JSON.resi @@ -217,7 +217,7 @@ JSON.stringifyWithIndent(json, 2) ``` */ @deprecated("Use `stringify` with optional parameter instead") @val -external stringifyWithIndent: (t, @as(json`null`) _, int) => string = "JSON.stringify" +external stringifyWithIndent: (t, %raw("null"), int) => string = "JSON.stringify" /** `stringifyWithReplacer(json, replacer)` @@ -442,7 +442,7 @@ switch BigInt.fromInt(0)->JSON.stringifyAny { - Throws a TypeError if the value contains `BigInt`s. */ @deprecated("Use `stringifyAny` with optional parameter instead") @val -external stringifyAnyWithIndent: ('a, @as(json`null`) _, int) => option = "JSON.stringify" +external stringifyAnyWithIndent: ('a, %raw("null"), int) => option = "JSON.stringify" /** `stringifyAnyWithReplacer(json, replacer)` diff --git a/packages/@rescript/runtime/Stdlib_Object.res b/packages/@rescript/runtime/Stdlib_Object.res index 27a314a0d38..152f102dc87 100644 --- a/packages/@rescript/runtime/Stdlib_Object.res +++ b/packages/@rescript/runtime/Stdlib_Object.res @@ -85,7 +85,7 @@ let obj = Object.createWithNull() obj->Object.get("toString") == None ``` */ -@val external createWithNull: (@as(json`null`) _, unit) => {..} = "Object.create" +@val external createWithNull: (%raw("null"), unit) => {..} = "Object.create" /** `createWithNullAndProperties(descriptors)` creates an object with a `null` prototype and defines properties using descriptor objects. @@ -100,7 +100,7 @@ obj->Object.get("name") == Some("banana") obj->Object.get("toString") == None ``` */ -@val external createWithNullAndProperties: (@as(json`null`) _, {..}) => {..} = "Object.create" +@val external createWithNullAndProperties: (%raw("null"), {..}) => {..} = "Object.create" /** `assign(target, source)` copies enumerable own properties from the source to the target, overwriting properties with the same name. It returns the modified target object. A deep clone is not created; properties are copied by reference. @@ -144,7 +144,7 @@ cloned->Object.get("name") == Some("banana") Object.is(original, cloned) == false ``` */ -@val external copy: (@as(json`{}`) _, {..} as 'a) => 'a = "Object.assign" +@val external copy: (%raw("{}"), {..} as 'a) => 'a = "Object.assign" /** `get` gets the value of a property by name. Returns `None` if the property does not exist or has the value `undefined`. Otherwise returns `Some`, including if the value is `null`. diff --git a/packages/@rescript/runtime/Stdlib_RegExp.res b/packages/@rescript/runtime/Stdlib_RegExp.res index 9f1b5736a20..545ea5a9897 100644 --- a/packages/@rescript/runtime/Stdlib_RegExp.res +++ b/packages/@rescript/runtime/Stdlib_RegExp.res @@ -3,8 +3,8 @@ type t module Result = { type t = array> - @get_index external fullMatch: (t, @as(0) _) => string = "" - @send external matches: (t, @as(1) _) => array> = "slice" + @get_index external fullMatch: (t, %raw("0")) => string = "" + @send external matches: (t, %raw("1")) => array> = "slice" @get external index: t => int = "index" @get external input: t => string = "input" } diff --git a/packages/@rescript/runtime/Stdlib_RegExp.resi b/packages/@rescript/runtime/Stdlib_RegExp.resi index f6822678973..16347d7dd33 100644 --- a/packages/@rescript/runtime/Stdlib_RegExp.resi +++ b/packages/@rescript/runtime/Stdlib_RegExp.resi @@ -31,7 +31,7 @@ module Result: { ``` */ @get_index - external fullMatch: (t, @as(0) _) => string = "" + external fullMatch: (t, %raw("0")) => string = "" /** `matches(regExpResult)` returns all matches for `regExpResult`. @@ -53,7 +53,7 @@ module Result: { ``` */ @send - external matches: (t, @as(1) _) => array> = "slice" + external matches: (t, %raw("1")) => array> = "slice" @get external index: t => int = "index" /** diff --git a/packages/dev-playground/src/Bindings.res b/packages/dev-playground/src/Bindings.res index 1b7f3f497f6..3e7c74f0818 100644 --- a/packages/dev-playground/src/Bindings.res +++ b/packages/dev-playground/src/Bindings.res @@ -167,8 +167,8 @@ module Document = { @val external current: {..} = "document" @get external head: {..} => Dom.element = "head" @get external body: {..} => Dom.element = "body" - @send external createScriptElement: ({..}, @as("script") _) => Dom.element = "createElement" - @send external createTextAreaElement: ({..}, @as("textarea") _) => Dom.element = "createElement" + @send external createScriptElement: ({..}, %raw(`"script"`)) => Dom.element = "createElement" + @send external createTextAreaElement: ({..}, %raw(`"textarea"`)) => Dom.element = "createElement" @send @return(nullable) external getElementById: ({..}, string) => option = "getElementById" @send external execCommand: ({..}, string) => bool = "execCommand" @@ -194,7 +194,7 @@ module Location = { module History = { @val @scope(("window", "history")) - external replaceState: (@as(json`null`) _, @as("") _, string) => unit = "replaceState" + external replaceState: (%raw("null"), %raw(`""`), string) => unit = "replaceState" } module Performance = { diff --git a/tests/ERROR_VARIANTS.md b/tests/ERROR_VARIANTS.md index 5f6afa03430..11ea18e856b 100644 --- a/tests/ERROR_VARIANTS.md +++ b/tests/ERROR_VARIANTS.md @@ -243,7 +243,6 @@ Source: [typecore.ml:27](../compiler/ml/typecore.ml). | `Polyvar_literal_overflow` | ✓ | `polyvar_int_overflow.res`, `polyvar_int_overflow_payload.res`, `polyvar_int_overflow_pattern.res` | | | `Unknown_literal` | ✓ | `unknown_literal.res` | | | `Invalid_string_escape_sequence` | ☐ | — | Regular source is rejected by the parser; the typer check remains defensive for malformed AST produced by a PPX. `syntaxErrors_invalid_ordinary_template_escape.res` covers the parser diagnostic. | -| `Json_literal_outside_external` | ✓ | `json_literal_outside_external.res` | Constant `json` payloads are reserved for external attributes such as `@as`. | | `Illegal_letrec_pat` | ✓ | `illegal_letrec_pat.res` | | | `Empty_record_literal` | ✓ | `empty_record_literal.res` | | | `Uncurried_arity_mismatch` | ✓ | `arity_mismatch3.res` etc. | | diff --git a/tests/analysis_tests/tests-reanalyze/deadcode/expected/deadcode.txt b/tests/analysis_tests/tests-reanalyze/deadcode/expected/deadcode.txt index c4efc7a2fc7..66462020dd3 100644 --- a/tests/analysis_tests/tests-reanalyze/deadcode/expected/deadcode.txt +++ b/tests/analysis_tests/tests-reanalyze/deadcode/expected/deadcode.txt @@ -56,7 +56,7 @@ addTypeReference _none_:1:-1 --> ContextOptionalArgs.res:12:14 addValueReference ContextOptionalArgs.res:12:6 --> React.res:16:0 addValueReference ContextOptionalArgs.res:22:6 --> ContextOptionalArgs.res:2:6 - addValueReference ContextOptionalArgs.res:22:6 --> React.res:250:0 + addValueReference ContextOptionalArgs.res:22:6 --> React.res:249:0 addValueDeclaration +dispatchNotification ContextOptionalArgs.res:28:8 path:+ContextOptionalArgs.ComponentUsingAction addValueReference ContextOptionalArgs.res:28:8 --> ContextOptionalArgs.res:22:6 addValueReference ContextOptionalArgs.res:35:4 --> React.res:3:0 diff --git a/tests/build_tests/react_ppx/src/React.res b/tests/build_tests/react_ppx/src/React.res index cb5168fc595..268099f42ee 100644 --- a/tests/build_tests/react_ppx/src/React.res +++ b/tests/build_tests/react_ppx/src/React.res @@ -125,7 +125,7 @@ external useReducerWithMapState: ( @module("react") external useEffect: (unit => option unit>) => unit = "useEffect" @module("react") -external useEffect0: (unit => option unit>, @as(json`[]`) _) => unit = "useEffect" +external useEffect0: (unit => option unit>, %raw("[]")) => unit = "useEffect" @module("react") external useEffect1: (unit => option unit>, array<'a>) => unit = "useEffect" @module("react") @@ -145,8 +145,7 @@ external useEffect7: (unit => option unit>, ('a, 'b, 'c, 'd, 'e, 'f, 'g) @module("react") external useLayoutEffect: (unit => option unit>) => unit = "useLayoutEffect" @module("react") -external useLayoutEffect0: (unit => option unit>, @as(json`[]`) _) => unit = - "useLayoutEffect" +external useLayoutEffect0: (unit => option unit>, %raw("[]")) => unit = "useLayoutEffect" @module("react") external useLayoutEffect1: (unit => option unit>, array<'a>) => unit = "useLayoutEffect" @module("react") @@ -169,7 +168,7 @@ external useLayoutEffect7: (unit => option unit>, ('a, 'b, 'c, 'd, 'e, ' @module("react") external useMemo: (unit => 'any) => 'any = "useMemo" @module("react") -external useMemo0: (unit => 'any, @as(json`[]`) _) => 'any = "useMemo" +external useMemo0: (unit => 'any, %raw("[]")) => 'any = "useMemo" @module("react") external useMemo1: (unit => 'any, array<'a>) => 'any = "useMemo" @module("react") @@ -191,8 +190,7 @@ type callback<'input, 'output> = 'input => 'output @module("react") external useCallback: ('input => 'output) => callback<'input, 'output> = "useCallback" @module("react") -external useCallback0: ('input => 'output, @as(json`[]`) _) => callback<'input, 'output> = - "useCallback" +external useCallback0: ('input => 'output, %raw("[]")) => callback<'input, 'output> = "useCallback" @module("react") external useCallback1: ('input => 'output, array<'a>) => callback<'input, 'output> = "useCallback" @module("react") @@ -221,7 +219,7 @@ external useContext: Context.t<'any> => 'any = "useContext" @module("react") external useRef: 'value => Ref.t<'value> = "useRef" @module("react") -external useImperativeHandle0: (nullable>, unit => 'value, @as(json`[]`) _) => unit = +external useImperativeHandle0: (nullable>, unit => 'value, %raw("[]")) => unit = "useImperativeHandle" @module("react") diff --git a/tests/build_tests/super_errors/expected/json_literal_inline.res.expected b/tests/build_tests/super_errors/expected/json_literal_inline.res.expected deleted file mode 100644 index 0e6bf0eab50..00000000000 --- a/tests/build_tests/super_errors/expected/json_literal_inline.res.expected +++ /dev/null @@ -1,9 +0,0 @@ - - We've found a bug for you! - /.../fixtures/json_literal_inline.res:2:17-28 - - 1 │ @inline - 2 │ let value = json`{foo: true}` - 3 │ - - A `json` literal can only be used in an external attribute such as `@as` \ No newline at end of file diff --git a/tests/build_tests/super_errors/expected/json_literal_inline_payload.res.expected b/tests/build_tests/super_errors/expected/json_literal_inline_payload.res.expected deleted file mode 100644 index 349ce978301..00000000000 --- a/tests/build_tests/super_errors/expected/json_literal_inline_payload.res.expected +++ /dev/null @@ -1,9 +0,0 @@ - - We've found a bug for you! - /.../fixtures/json_literal_inline_payload.res:1:13-17 - - 1 │ @inline(json`null`) - 2 │ let value = "ignored" - 3 │ - - A `json` literal can only be used in an external attribute such as `@as` \ No newline at end of file diff --git a/tests/build_tests/super_errors/expected/json_literal_outside_external.res.expected b/tests/build_tests/super_errors/expected/json_literal_outside_external.res.expected deleted file mode 100644 index 258909bc038..00000000000 --- a/tests/build_tests/super_errors/expected/json_literal_outside_external.res.expected +++ /dev/null @@ -1,8 +0,0 @@ - - We've found a bug for you! - /.../fixtures/json_literal_outside_external.res:1:17-29 - - 1 │ let value = json`{answer: 42}` - 2 │ - - A `json` literal can only be used in an external attribute such as `@as` \ No newline at end of file diff --git a/tests/build_tests/super_errors/expected/json_literal_todo_payload.res.expected b/tests/build_tests/super_errors/expected/json_literal_todo_payload.res.expected deleted file mode 100644 index 4998cb09352..00000000000 --- a/tests/build_tests/super_errors/expected/json_literal_todo_payload.res.expected +++ /dev/null @@ -1,8 +0,0 @@ - - We've found a bug for you! - /.../fixtures/json_literal_todo_payload.res:1:23-30 - - 1 │ let value = %todo(json`message`) - 2 │ - - A `json` literal can only be used in an external attribute such as `@as` \ No newline at end of file diff --git a/tests/build_tests/super_errors/expected/syntaxErrors_json_interpolation.res.expected b/tests/build_tests/super_errors/expected/syntaxErrors_json_interpolation.res.expected index 9476845ce36..fcc02fbe5c8 100644 --- a/tests/build_tests/super_errors/expected/syntaxErrors_json_interpolation.res.expected +++ b/tests/build_tests/super_errors/expected/syntaxErrors_json_interpolation.res.expected @@ -1,8 +1,8 @@ - Syntax error! - /.../fixtures/syntaxErrors_json_interpolation.res:1:17-35 + We've found a bug for you! + /.../fixtures/syntaxErrors_json_interpolation.res:1:13-16 - 1 │ let value = json`head${"value"}tail` + 1 │ let value = json`head${"value"}tail` 2 │ - `json` literals do not support interpolation \ No newline at end of file + The value json can't be found \ No newline at end of file diff --git a/tests/build_tests/super_errors/fixtures/json_literal_inline.res b/tests/build_tests/super_errors/fixtures/json_literal_inline.res deleted file mode 100644 index c496f5e47c9..00000000000 --- a/tests/build_tests/super_errors/fixtures/json_literal_inline.res +++ /dev/null @@ -1,2 +0,0 @@ -@inline -let value = json`{foo: true}` diff --git a/tests/build_tests/super_errors/fixtures/json_literal_inline_payload.res b/tests/build_tests/super_errors/fixtures/json_literal_inline_payload.res deleted file mode 100644 index 285bd2605c1..00000000000 --- a/tests/build_tests/super_errors/fixtures/json_literal_inline_payload.res +++ /dev/null @@ -1,2 +0,0 @@ -@inline(json`null`) -let value = "ignored" diff --git a/tests/build_tests/super_errors/fixtures/json_literal_outside_external.res b/tests/build_tests/super_errors/fixtures/json_literal_outside_external.res deleted file mode 100644 index e5fcc0bb2c3..00000000000 --- a/tests/build_tests/super_errors/fixtures/json_literal_outside_external.res +++ /dev/null @@ -1 +0,0 @@ -let value = json`{answer: 42}` diff --git a/tests/build_tests/super_errors/fixtures/json_literal_todo_payload.res b/tests/build_tests/super_errors/fixtures/json_literal_todo_payload.res deleted file mode 100644 index df4ea11cb6a..00000000000 --- a/tests/build_tests/super_errors/fixtures/json_literal_todo_payload.res +++ /dev/null @@ -1 +0,0 @@ -let value = %todo(json`message`) diff --git a/tests/dependencies/rescript-react/src/React.res b/tests/dependencies/rescript-react/src/React.res index ff2b1cd4d58..2b81b8d8b84 100644 --- a/tests/dependencies/rescript-react/src/React.res +++ b/tests/dependencies/rescript-react/src/React.res @@ -150,7 +150,7 @@ external useEffectOnEveryRender: (unit => option unit>) => unit = "useEf @module("react") external useEffect: (unit => option unit>, 'deps) => unit = "useEffect" @module("react") -external useEffect0: (unit => option unit>, @as(json`[]`) _) => unit = "useEffect" +external useEffect0: (unit => option unit>, %raw("[]")) => unit = "useEffect" @module("react") external useEffect1: (unit => option unit>, array<'a>) => unit = "useEffect" @module("react") @@ -172,8 +172,7 @@ external useLayoutEffectOnEveryRender: (unit => option unit>) => unit = @module("react") external useLayoutEffect: (unit => option unit>, 'deps) => unit = "useLayoutEffect" @module("react") -external useLayoutEffect0: (unit => option unit>, @as(json`[]`) _) => unit = - "useLayoutEffect" +external useLayoutEffect0: (unit => option unit>, %raw("[]")) => unit = "useLayoutEffect" @module("react") external useLayoutEffect1: (unit => option unit>, array<'a>) => unit = "useLayoutEffect" @module("react") @@ -197,7 +196,7 @@ external useLayoutEffect7: (unit => option unit>, ('a, 'b, 'c, 'd, 'e, ' external useMemo: (unit => 'any, 'deps) => 'any = "useMemo" @module("react") -external useMemo0: (unit => 'any, @as(json`[]`) _) => 'any = "useMemo" +external useMemo0: (unit => 'any, %raw("[]")) => 'any = "useMemo" @module("react") external useMemo1: (unit => 'any, array<'a>) => 'any = "useMemo" @@ -224,7 +223,7 @@ external useMemo7: (unit => 'any, ('a, 'b, 'c, 'd, 'e, 'f, 'g)) => 'any = "useMe external useCallback: ('f, 'deps) => 'f = "useCallback" @module("react") -external useCallback0: ('f, @as(json`[]`) _) => 'f = "useCallback" +external useCallback0: ('f, %raw("[]")) => 'f = "useCallback" @module("react") external useCallback1: ('f, array<'a>) => 'f = "useCallback" @@ -264,7 +263,7 @@ external useImperativeHandle: (nullable>, unit => 'value, 'deps) => "useImperativeHandle" @module("react") -external useImperativeHandle0: (nullable>, unit => 'value, @as(json`[]`) _) => unit = +external useImperativeHandle0: (nullable>, unit => 'value, %raw("[]")) => unit = "useImperativeHandle" @module("react") @@ -316,7 +315,7 @@ external useInsertionEffectOnEveryRender: (unit => option unit>) => unit @module("react") external useInsertionEffect: (unit => option unit>, 'deps) => unit = "useInsertionEffect" @module("react") -external useInsertionEffect0: (unit => option unit>, @as(json`[]`) _) => unit = +external useInsertionEffect0: (unit => option unit>, %raw("[]")) => unit = "useInsertionEffect" @module("react") external useInsertionEffect1: (unit => option unit>, array<'a>) => unit = @@ -372,7 +371,7 @@ module Uncurried = { external useCallback: ('f, 'deps) => 'f = "useCallback" @module("react") - external useCallback0: ('f, @as(json`[]`) _) => 'f = "useCallback" + external useCallback0: ('f, %raw("[]")) => 'f = "useCallback" @module("react") external useCallback1: ('f, array<'a>) => 'f = "useCallback" diff --git a/tests/dependencies/rescript-react/src/ReactDOMStyle.res b/tests/dependencies/rescript-react/src/ReactDOMStyle.res index f9ead0b0ab4..6894811ec4e 100644 --- a/tests/dependencies/rescript-react/src/ReactDOMStyle.res +++ b/tests/dependencies/rescript-react/src/ReactDOMStyle.res @@ -2,7 +2,7 @@ type t = JsxDOMStyle.t /* CSS2Properties: https://www.w3.org/TR/DOM-Level-2-Style/css.html#CSS-CSS2Properties */ @val -external combine: (@as(json`{}`) _, t, t) => t = "Object.assign" +external combine: (%raw("{}"), t, t) => t = "Object.assign" external _dictToStyle: dict => t = "%identity" @@ -13,4 +13,4 @@ let unsafeAddProp = (style, key, value) => { } @val -external unsafeAddStyle: (@as(json`{}`) _, t, {..}) => t = "Object.assign" +external unsafeAddStyle: (%raw("{}"), t, {..}) => t = "Object.assign" diff --git a/tests/dependencies/rescript-react/src/RescriptReactRouter.res b/tests/dependencies/rescript-react/src/RescriptReactRouter.res index 747154149db..2087a0fb9b7 100644 --- a/tests/dependencies/rescript-react/src/RescriptReactRouter.res +++ b/tests/dependencies/rescript-react/src/RescriptReactRouter.res @@ -23,10 +23,10 @@ external dispatchEvent: (Dom.window, Dom.event) => unit = "dispatchEvent" @get external search: Dom.location => string = "search" @send -external pushState: (Dom.history, @as(json`null`) _, @as("") _, ~href: string) => unit = "pushState" +external pushState: (Dom.history, %raw("null"), %raw(`""`), ~href: string) => unit = "pushState" @send -external replaceState: (Dom.history, @as(json`null`) _, @as("") _, ~href: string) => unit = +external replaceState: (Dom.history, %raw("null"), %raw(`""`), ~href: string) => unit = "replaceState" type makeEventOptions = { diff --git a/tests/ounit_tests/ounit_ast_mapper0_tests.ml b/tests/ounit_tests/ounit_ast_mapper0_tests.ml index 32e2564b049..4b047aa9e23 100644 --- a/tests/ounit_tests/ounit_ast_mapper0_tests.ml +++ b/tests/ounit_tests/ounit_ast_mapper0_tests.ml @@ -318,12 +318,20 @@ let test_string_literals_roundtrip_through_ast0 _ = (String_literal.string_semantic payload) | _ -> assert_failure "Expected a string pattern after ast0 roundtrip"); let json_expr = - Ast_helper.Exp.constant ~loc (Parsetree.Pconst_json {|{"answer":42}|}) + Ast_helper.Exp.tagged_template ~loc + (Ast_helper.Exp.ident ~loc (Location.mkloc (Longident.Lident "json") loc)) + [located_string {|{"answer":42}|}] + [] in (match (map_expr0 (map_expr_to0 json_expr)).pexp_desc with - | Pexp_constant (Pconst_json actual) -> + | Pexp_tagged_template + { + tag = {pexp_desc = Pexp_ident {txt = Lident "json"}}; + raw_sources = [{txt = actual}]; + values = []; + } -> OUnit.assert_equal ~printer:(Printf.sprintf "%S") {|{"answer":42}|} actual - | _ -> assert_failure "Expected a JSON literal"); + | _ -> assert_failure "Expected a legacy json tagged template"); let char_pattern = Ast_helper.Pat.constant ~loc (Parsetree.Pconst_char {source = {|\u{61}|}; semantic = 0x61}) diff --git a/tests/ounit_tests/ounit_string_literal_tests.ml b/tests/ounit_tests/ounit_string_literal_tests.ml index a8fdb3e542a..3e41f2363b5 100644 --- a/tests/ounit_tests/ounit_string_literal_tests.ml +++ b/tests/ounit_tests/ounit_string_literal_tests.ml @@ -244,13 +244,36 @@ let assert_tagged_template_location () = pexp_loc.loc_end.pos_cnum | _ -> OUnit.assert_failure "expected a parsed tagged template" -let assert_invalid_json_interpolation () = +let assert_json_interpolation_is_a_tagged_template () = let result = Res_driver.parse_implementation_from_source ~for_printer:false ~display_filename:"StringLiteralTest.res" ~source:{|let value = json`head${item}tail`|} in - OUnit.assert_bool "expected JSON interpolation to be rejected" result.invalid + match result.parsetree with + | [ + { + pstr_desc = + Pstr_value + ( _, + [ + { + pvb_expr = + { + pexp_desc = + Pexp_tagged_template + { + tag = {pexp_desc = Pexp_ident {txt = Lident "json"}}; + raw_sources = [_; _]; + values = [_]; + }; + }; + }; + ] ); + }; + ] -> + () + | _ -> OUnit.assert_failure "expected an ordinary tagged template" let assert_int_equal expected actual = OUnit.assert_equal ~printer:string_of_int expected actual @@ -322,17 +345,11 @@ let assert_js_string ~expected constant = OUnit.assert_equal ~printer:(Printf.sprintf "%S") expected actual | _ -> OUnit.assert_failure "expected a JavaScript string expression" -let assert_external_js_string ~expected constant = +let assert_external_fixed_literal ~expected constant = match (Lam_compile_const.translate_arg_cst constant).J.expression_desc with - | Str actual -> + | Fixed_literal actual -> OUnit.assert_equal ~printer:(Printf.sprintf "%S") expected actual - | _ -> OUnit.assert_failure "expected a JavaScript string expression" - -let assert_external_json_literal ~expected constant = - match (Lam_compile_const.translate_arg_cst constant).J.expression_desc with - | Json_literal actual -> - OUnit.assert_equal ~printer:(Printf.sprintf "%S") expected actual - | _ -> OUnit.assert_failure "expected a JavaScript JSON literal expression" + | _ -> OUnit.assert_failure "expected a fixed JavaScript literal expression" let inline_string semantic = match Ast_external_mk.inline_string semantic with @@ -353,6 +370,14 @@ let template_payload source = Parsetree.PStr [Ast_helper.Str.eval (Ast_helper.Exp.template [located_string source] [])] +let tagged_payload tag source = + let tag = Ast_helper.Exp.ident (Location.mknoloc (Longident.Lident tag)) in + Parsetree.PStr + [ + Ast_helper.Str.eval + (Ast_helper.Exp.tagged_template tag [located_string source] []); + ] + let suites = __FILE__ >::: [ @@ -432,7 +457,7 @@ let suites = >:: fun _ -> assert_parsed_template (); assert_tagged_template_location (); - assert_invalid_json_interpolation () ); + assert_json_interpolation_is_a_tagged_template () ); ( "template expression escapes are parser diagnostics" >:: fun _ -> List.iter assert_invalid_template_expression [{|bad \xZZ escape|}; {|a\1b|}; {|a\01b|}; {|a\8b|}] ); @@ -512,9 +537,7 @@ let suites = OUnit.assert_equal ~printer:Ext_obj.dump (Ast_helper.Const.string "a\n😀") (Untypeast.constant semantic); - OUnit.assert_equal ~printer:Ext_obj.dump - (Error Typecore.Json_literal_outside_external) - (Typecore.constant (Parsetree.Pconst_json {|{"answer":42}|})) ); + () ); ( "constant backquoted attribute strings become semantic" >:: fun _ -> OUnit.assert_equal ~printer:Ext_obj.dump (Some "a\n😀") (Ast_payload.semantic_string_of_payload @@ -527,7 +550,7 @@ let suites = ]); OUnit.assert_equal ~printer:Ext_obj.dump None (Ast_payload.semantic_string_of_payload - (string_payload (Pconst_json {|{"answer":42}|}))); + (tagged_payload "json" {|{"answer":42}|})); match Ast_payload.semantic_string_of_payload (template_payload {|\uD800|}) @@ -564,27 +587,28 @@ let suites = ( "external string constants have explicit representations" >:: fun _ -> OUnit.assert_equal ~printer:Ext_obj.dump (External_ffi_types.Const_string "a\n😀") (inline_string "a\n😀"); - assert_external_js_string ~expected:{|\x61|} - (External_arg_spec.cst_string {|\x61|}); - assert_external_json_literal ~expected:{|{"answer":42}|} - (External_arg_spec.cst_json {|{"answer":42}|}); - let json = Js_exp_make.json_literal {| {answer: 42} |} in - OUnit.assert_bool "expected JSON literals to be side-effect free" - (Js_analyzer.no_side_effect_expression json); + assert_external_fixed_literal ~expected:{|"a"|} + (External_arg_spec.cst_fixed {|"a"|}); + assert_external_fixed_literal ~expected:{|{"answer":42}|} + (External_arg_spec.cst_fixed {|{"answer":42}|}); + let fixed = Js_exp_make.fixed_literal {| {answer: 42} |} in + OUnit.assert_bool "expected fixed literals to be side-effect free" + (Js_analyzer.no_side_effect_expression fixed); OUnit.assert_bool - "expected allocating JSON literals not to duplicate" - (not (Js_analyzer.is_okay_to_duplicate json)); - OUnit.assert_bool "expected JSON literals not to compare as strings" + "expected allocating fixed literals not to duplicate" + (not (Js_analyzer.is_okay_to_duplicate fixed)); + OUnit.assert_bool "expected fixed literals not to compare as strings" (not - (Js_analyzer.eq_expression json - (Js_exp_make.json_literal {| {answer: 42} |}))); - (match (Js_exp_make.typeof json).expression_desc with + (Js_analyzer.eq_expression fixed + (Js_exp_make.fixed_literal {| {answer: 42} |}))); + (match (Js_exp_make.typeof fixed).expression_desc with | Typeof argument -> - OUnit.assert_bool "expected typeof to preserve the JSON expression" - (json == argument) + OUnit.assert_bool + "expected typeof to preserve the fixed literal expression" + (fixed == argument) | _ -> OUnit.assert_failure "expected a runtime typeof expression"); OUnit.assert_equal ~printer:(Printf.sprintf "%S") {| {answer: 42} |} - (Js_dump.string_of_expression json) ); + (Js_dump.string_of_expression fixed) ); ( "Lambda constants contain semantic strings" >:: fun _ -> let semantic = convert_typed_constant (Asttypes.Const_string "a\n😀") diff --git a/tests/syntax_tests/data/ast-mapping/FixedExternal.res b/tests/syntax_tests/data/ast-mapping/FixedExternal.res new file mode 100644 index 00000000000..1108db1f340 --- /dev/null +++ b/tests/syntax_tests/data/ast-mapping/FixedExternal.res @@ -0,0 +1,5 @@ +@val +external unsafeAddStyle: (%raw("{}"), t, {..}) => t = "Object.assign" + +@val +external legacyObject: (@as(json`{foo: true}`) _, int) => int = "Object.assign" diff --git a/tests/syntax_tests/data/ast-mapping/expected/FixedExternal.res.txt b/tests/syntax_tests/data/ast-mapping/expected/FixedExternal.res.txt new file mode 100644 index 00000000000..bde9db62397 --- /dev/null +++ b/tests/syntax_tests/data/ast-mapping/expected/FixedExternal.res.txt @@ -0,0 +1,17 @@ + + Warning number 3 + syntax_tests/data/ast-mapping/FixedExternal.res:5:25-27 + + 3 │ + 4 │ @val + 5 │ external legacyObject: (@as(json`{foo: true}`) _, int) => int = "Object. + │ assign" + 6 │ + + deprecated: The fixed-value `@as(...) _` external argument syntax is deprecated. Use `%raw(...)` instead. + +@val +external unsafeAddStyle: (%raw("{}"), t, {..}) => t = "Object.assign" + +@val +external legacyObject: (%raw("{foo: true}"), int) => int = "Object.assign" diff --git a/tests/syntax_tests/data/ast-mapping/expected/FunctionsAndArrows.res.txt b/tests/syntax_tests/data/ast-mapping/expected/FunctionsAndArrows.res.txt index 508c2860fb2..af5a38c9273 100644 --- a/tests/syntax_tests/data/ast-mapping/expected/FunctionsAndArrows.res.txt +++ b/tests/syntax_tests/data/ast-mapping/expected/FunctionsAndArrows.res.txt @@ -1,3 +1,16 @@ + + Warning number 3 + syntax_tests/data/ast-mapping/FunctionsAndArrows.res:47:29-31 + + 45 │ // phantom @as arguments: written arity differs from lowered call arity + 46 │ @val + 47 │ external phantom: (~a: int, @as(json`false`) _, ~c: string) => unit = " + │ phantom" + 48 │ + 49 │ // external with uncurried callback argument + + deprecated: The fixed-value `@as(...) _` external argument syntax is deprecated. Use `%raw(...)` instead. + // Round-trip coverage for functions and arrow types through the // Parsetree0 bridge (ast_mapper_to0 / ast_mapper_from0). @@ -44,7 +57,7 @@ type argAttr = (@as("x") ~foo: string, int) => int // phantom @as arguments: written arity differs from lowered call arity @val -external phantom: (~a: int, @as(json`false`) _, ~c: string) => unit = "phantom" +external phantom: (~a: int, %raw("false"), ~c: string) => unit = "phantom" // external with uncurried callback argument @val external onEvent: (string, (~event: string) => unit) => unit = "on" diff --git a/tests/syntax_tests/data/parsing/errors/typexpr/expected/fixedExternalDuplicate.res.txt b/tests/syntax_tests/data/parsing/errors/typexpr/expected/fixedExternalDuplicate.res.txt new file mode 100644 index 00000000000..86cb5ae9a6d --- /dev/null +++ b/tests/syntax_tests/data/parsing/errors/typexpr/expected/fixedExternalDuplicate.res.txt @@ -0,0 +1,10 @@ + + Syntax error! + syntax_tests/data/parsing/errors/typexpr/fixedExternalDuplicate.res:1:31-32 + + 1 │ external duplicate: (%raw("1") %raw("2")) => unit = "duplicate" + 2 │ + + Did you forget a `,` here? + +external duplicate : %raw("1") -> %raw("2") -> unit (a:2) = "duplicate" \ No newline at end of file diff --git a/tests/syntax_tests/data/parsing/errors/typexpr/expected/fixedExternalPosition.res.txt b/tests/syntax_tests/data/parsing/errors/typexpr/expected/fixedExternalPosition.res.txt new file mode 100644 index 00000000000..def2d21233a --- /dev/null +++ b/tests/syntax_tests/data/parsing/errors/typexpr/expected/fixedExternalPosition.res.txt @@ -0,0 +1,11 @@ + + Syntax error! + syntax_tests/data/parsing/errors/typexpr/fixedExternalPosition.res:1:28-31 + + 1 │ external nestedArgument: ((%raw("1")) => int) => unit = "nestedArgument" + 2 │ + + %raw is only allowed as a direct external function argument + +external nestedArgument : + ([%raw {js|1|js}] -> int (a:1)) -> unit (a:1) = "nestedArgument" \ No newline at end of file diff --git a/tests/syntax_tests/data/parsing/errors/typexpr/expected/fixedExternalTyped.res.txt b/tests/syntax_tests/data/parsing/errors/typexpr/expected/fixedExternalTyped.res.txt new file mode 100644 index 00000000000..967da7f1a40 --- /dev/null +++ b/tests/syntax_tests/data/parsing/errors/typexpr/expected/fixedExternalTyped.res.txt @@ -0,0 +1,10 @@ + + Syntax error! + syntax_tests/data/parsing/errors/typexpr/fixedExternalTyped.res:1:26-29 + + 1 │ external typedArgument: (%raw(1), int) => unit = "typedArgument" + 2 │ + + The %raw extension can only be applied to a string + +external typedArgument : [%raw 1] -> int -> unit (a:2) = "typedArgument" \ No newline at end of file diff --git a/tests/syntax_tests/data/parsing/errors/typexpr/fixedExternalDuplicate.res b/tests/syntax_tests/data/parsing/errors/typexpr/fixedExternalDuplicate.res new file mode 100644 index 00000000000..a4fb03d4c25 --- /dev/null +++ b/tests/syntax_tests/data/parsing/errors/typexpr/fixedExternalDuplicate.res @@ -0,0 +1 @@ +external duplicate: (%raw("1") %raw("2")) => unit = "duplicate" diff --git a/tests/syntax_tests/data/parsing/errors/typexpr/fixedExternalPosition.res b/tests/syntax_tests/data/parsing/errors/typexpr/fixedExternalPosition.res new file mode 100644 index 00000000000..6c3d1f50dad --- /dev/null +++ b/tests/syntax_tests/data/parsing/errors/typexpr/fixedExternalPosition.res @@ -0,0 +1 @@ +external nestedArgument: ((%raw("1")) => int) => unit = "nestedArgument" diff --git a/tests/syntax_tests/data/parsing/errors/typexpr/fixedExternalTyped.res b/tests/syntax_tests/data/parsing/errors/typexpr/fixedExternalTyped.res new file mode 100644 index 00000000000..8e5f9a83f71 --- /dev/null +++ b/tests/syntax_tests/data/parsing/errors/typexpr/fixedExternalTyped.res @@ -0,0 +1 @@ +external typedArgument: (%raw(1), int) => unit = "typedArgument" diff --git a/tests/syntax_tests/data/parsing/grammar/expressions/expected/es6template.res.txt b/tests/syntax_tests/data/parsing/grammar/expressions/expected/es6template.res.txt index 1de94e6031a..c326581be79 100644 --- a/tests/syntax_tests/data/parsing/grammar/expressions/expected/es6template.res.txt +++ b/tests/syntax_tests/data/parsing/grammar/expressions/expected/es6template.res.txt @@ -32,7 +32,7 @@ let s = :) ` let s = `$dollar without $braces $interpolation` -let s = {json|null|json} +let s = json`null` let x = `foo\`bar\$\\foo` let x = `foo\`bar\$\\foo${a} \` ${b} \` xx` let thisIsFine = `$something` diff --git a/tests/syntax_tests/data/printer/ffi/expected/fixedExternal.res.txt b/tests/syntax_tests/data/printer/ffi/expected/fixedExternal.res.txt new file mode 100644 index 00000000000..bf4a29e85c1 --- /dev/null +++ b/tests/syntax_tests/data/printer/ffi/expected/fixedExternal.res.txt @@ -0,0 +1,38 @@ + + Warning number 3 + syntax_tests/data/printer/ffi/fixedExternal.res:11:25-27 + + 9 │ + 10 │ @val + 11 │ external legacyObject: (@as(json`{foo: true}`) _, int) => int = "Object + │ .assign" + 12 │ + 13 │ @val + + deprecated: The fixed-value `@as(...) _` external argument syntax is deprecated. Use `%raw(...)` instead. + + + Warning number 3 + syntax_tests/data/printer/ffi/fixedExternal.res:14:25-27 + + 12 │ + 13 │ @val + 14 │ external legacyString: (@as("img") _, int) => int = "f" + 15 │ + + deprecated: The fixed-value `@as(...) _` external argument syntax is deprecated. Use `%raw(...)` instead. + +@val +external unsafeAddStyle: (%raw("{}"), t, {..}) => t = "Object.assign" + +@module("react") +external useEffect0: (unit => option unit>, %raw("[]")) => unit = "useEffect" + +@val +external stringValue: (%raw(`"img"`), int) => int = "f" + +@val +external legacyObject: (%raw("{foo: true}"), int) => int = "Object.assign" + +@val +external legacyString: (%raw(`"img"`), int) => int = "f" diff --git a/tests/syntax_tests/data/printer/ffi/fixedExternal.res b/tests/syntax_tests/data/printer/ffi/fixedExternal.res new file mode 100644 index 00000000000..ed7804c75f6 --- /dev/null +++ b/tests/syntax_tests/data/printer/ffi/fixedExternal.res @@ -0,0 +1,14 @@ +@val +external unsafeAddStyle: (%raw("{}"), t, {..}) => t = "Object.assign" + +@module("react") +external useEffect0: (unit => option unit>, %raw("[]")) => unit = "useEffect" + +@val +external stringValue: (%raw(`"img"`), int) => int = "f" + +@val +external legacyObject: (@as(json`{foo: true}`) _, int) => int = "Object.assign" + +@val +external legacyString: (@as("img") _, int) => int = "f" diff --git a/tests/syntax_tests/data/printer/other/expected/attributes.res.txt b/tests/syntax_tests/data/printer/other/expected/attributes.res.txt index b34daf6830c..5a935b6c21c 100644 --- a/tests/syntax_tests/data/printer/other/expected/attributes.res.txt +++ b/tests/syntax_tests/data/printer/other/expected/attributes.res.txt @@ -1,3 +1,75 @@ + + Warning number 3 + syntax_tests/data/printer/other/attributes.res:29:42-44 + + 27 │ @obj external ff: (~x: int, ~g: int, ~h: int) => _ = "" + 28 │ + 29 │ @obj external ff: (~x: int, ~g: int, ~h: @as(3) _) => _ = "" + 30 │ + 31 │ @obj external ff: (~x: int) => (~h: @as(3) _) => _ = "" + + deprecated: The fixed-value `@as(...) _` external argument syntax is deprecated. Use `%raw(...)` instead. + + + Warning number 3 + syntax_tests/data/printer/other/attributes.res:35:8-10 + + 33 │ @obj + 34 │ external ff: ( + 35 │ ~lo: @as(3) _, + 36 │ ~mid: @as(3) _, + 37 │ ~hi: int, + + deprecated: The fixed-value `@as(...) _` external argument syntax is deprecated. Use `%raw(...)` instead. + + + Warning number 3 + syntax_tests/data/printer/other/attributes.res:36:9-11 + + 34 │ external ff: ( + 35 │ ~lo: @as(3) _, + 36 │ ~mid: @as(3) _, + 37 │ ~hi: int, + 38 │ ) => _ = "" + + deprecated: The fixed-value `@as(...) _` external argument syntax is deprecated. Use `%raw(...)` instead. + + + Warning number 3 + syntax_tests/data/printer/other/attributes.res:44:8-10 + + 42 │ external ff: ( + 43 │ ~hi: int, + 44 │ ~lo: @as(3) _ + 45 │ ) => _ = "" + 46 │ + + deprecated: The fixed-value `@as(...) _` external argument syntax is deprecated. Use `%raw(...)` instead. + + + Warning number 3 + syntax_tests/data/printer/other/attributes.res:50:9-11 + + 48 │ external ff: ( + 49 │ ~hi: int, + 50 │ ~mid: @as(3) _, + 51 │ ~lo: @as(3) _ + 52 │ ) => _ = "" + + deprecated: The fixed-value `@as(...) _` external argument syntax is deprecated. Use `%raw(...)` instead. + + + Warning number 3 + syntax_tests/data/printer/other/attributes.res:51:8-10 + + 49 │ ~hi: int, + 50 │ ~mid: @as(3) _, + 51 │ ~lo: @as(3) _ + 52 │ ) => _ = "" + 53 │ + + deprecated: The fixed-value `@as(...) _` external argument syntax is deprecated. Use `%raw(...)` instead. + @attr(: int) let x = 1 @@ -25,15 +97,15 @@ let x = 1 @obj external ff: (~x: int, ~g: int, ~h: int) => _ = "" -@obj external ff: (~x: int, ~g: int, ~h: @as(3) _) => _ = "" +@obj external ff: (~x: int, ~g: int, ~h: %raw("3")) => _ = "" @obj external ff: (~x: int) => (~h: @as(3) _) => _ = "" @obj -external ff: (~lo: @as(3) _, ~mid: @as(3) _, ~hi: int) => _ = "" +external ff: (~lo: %raw("3"), ~mid: %raw("3"), ~hi: int) => _ = "" @obj -external ff: (~hi: int, ~lo: @as(3) _) => _ = "" +external ff: (~hi: int, ~lo: %raw("3")) => _ = "" @obj -external ff: (~hi: int, ~mid: @as(3) _, ~lo: @as(3) _) => _ = "" +external ff: (~hi: int, ~mid: %raw("3"), ~lo: %raw("3")) => _ = "" diff --git a/tests/tests/src/AsInUncurriedExternals.mjs b/tests/tests/src/AsInUncurriedExternals.mjs index 9af4134fcfe..c86b4449f82 100644 --- a/tests/tests/src/AsInUncurriedExternals.mjs +++ b/tests/tests/src/AsInUncurriedExternals.mjs @@ -19,15 +19,22 @@ function shouldNotFail(objectMode, name) { return 3; } -let x = somescope.somefn({foo:true}); +let x = somescope.somefn({"foo":true}); let y = somescope.stringfn("ab"); +let style = Object.assign({}, { + color: "red" +}, { + display: "flex" +}); + export { mo, options, shouldNotFail, x, y, + style, } /* x Not a pure module */ diff --git a/tests/tests/src/AsInUncurriedExternals.res b/tests/tests/src/AsInUncurriedExternals.res index 739f8668ec7..371ae00f68f 100644 --- a/tests/tests/src/AsInUncurriedExternals.res +++ b/tests/tests/src/AsInUncurriedExternals.res @@ -2,9 +2,9 @@ @obj external makeOptions: ( - ~objectMode: @as(json`false`) _, + ~objectMode: %raw("false"), ~name: string, - ~someOther: @as(json`true`) _, + ~someOther: %raw("true"), unit, ) => int = "" @@ -15,11 +15,18 @@ let options = mo(~name="foo", ()) let shouldNotFail: (~objectMode: _, ~name: string) => int = (~objectMode, ~name) => 3 @scope("somescope") -external constantArgOnly: @as(json`{foo:true}`) _ => string = "somefn" +external constantArgOnly: (%raw(`{"foo":true}`)) => string = "somefn" let x = constantArgOnly() @scope("somescope") -external semanticStringArg: @as(`\x61\u0062`) _ => string = "stringfn" +external semanticStringArg: (%raw(`"ab"`)) => string = "stringfn" let y = semanticStringArg() + +type t = {"color": string} + +@val +external unsafeAddStyle: (%raw("{}"), t, {..}) => t = "Object.assign" + +let style = unsafeAddStyle({"color": "red"}, {"display": "flex"}) diff --git a/tests/tests/src/UncurriedExternals.res b/tests/tests/src/UncurriedExternals.res index f48940a3016..a6a6e2f9577 100644 --- a/tests/tests/src/UncurriedExternals.res +++ b/tests/tests/src/UncurriedExternals.res @@ -15,7 +15,7 @@ module StandardNotation = { @get_index external get: (array, int) => option<'a> = "" let tg = arr => arr->get(0) - @val external copy: (@as(json`{}`) _, string) => string = "Object.assign" + @val external copy: (%raw("{}"), string) => string = "Object.assign" let tc = copy("abc") external toException: exn => exn = "%identity" diff --git a/tests/tests/src/bs_auto_uncurry.res b/tests/tests/src/bs_auto_uncurry.res index 673049bcf99..f9caafd118c 100644 --- a/tests/tests/src/bs_auto_uncurry.res +++ b/tests/tests/src/bs_auto_uncurry.res @@ -21,9 +21,9 @@ let xs = map([(1, 2), (1, 2), (2, 1)], ((x, y)) => y + x + 1) @val external ff: (int, @ignore int, (int, int) => int) => int = "ff" -@val external ff1: (int, @as(3) _, (int, int) => int) => int = "ff1" +@val external ff1: (int, %raw("3"), (int, int) => int) => int = "ff1" -@val external ff2: (int, @as("3") _, (int, int) => int) => int = "ff2" +@val external ff2: (int, %raw(`"3"`), (int, int) => int) => int = "ff2" @val external hi: (unit => unit) => int = "hi" diff --git a/tests/tests/src/bs_splice_partial.res b/tests/tests/src/bs_splice_partial.res index 21633ee1542..38acbd6a833 100644 --- a/tests/tests/src/bs_splice_partial.res +++ b/tests/tests/src/bs_splice_partial.res @@ -5,7 +5,7 @@ type t @send @variadic -external on_exit_slice3: (t, int, ~h: @as(3) _, @as("xxx") _, array) => unit = "xx" +external on_exit_slice3: (t, int, ~h: %raw("3"), %raw(`"xxx"`), array) => unit = "xx" let test = g => on_exit_slice3(g, __LINE__, [1, 2, 3]) @@ -46,6 +46,6 @@ type u = int => int let f = x => ignore(v(x)) -@val external fff0: (int, int, @as(json`[undefined,undefined]`) _) => int = "say" +@val external fff0: (int, int, %raw("[undefined,undefined]")) => int = "say" let testUndefined = () => fff0(1, 2) diff --git a/tests/tests/src/external_ppx.mjs b/tests/tests/src/external_ppx.mjs index 41d0d27f607..15474568163 100644 --- a/tests/tests/src/external_ppx.mjs +++ b/tests/tests/src/external_ppx.mjs @@ -10,7 +10,7 @@ let renamed = { let u = { hi: 2, lo: 3, - lo2: {hi:-3 }, + lo2: {hi: -3}, lo3: -1, lo4: -3 }; diff --git a/tests/tests/src/external_ppx.res b/tests/tests/src/external_ppx.res index 8c6d0e3a534..119de45062b 100644 --- a/tests/tests/src/external_ppx.res +++ b/tests/tests/src/external_ppx.res @@ -21,10 +21,10 @@ let renamed = renamed_make(~_type="123", ~normal=12.) @obj external ff: ( ~hi: int, - ~lo: @as(3) _, - ~lo2: @as(json`{hi:-3 }`) _, - ~lo3: @as(-1) _, - ~lo4: @as(json`-3`) _, + ~lo: %raw("3"), + ~lo2: %raw("{hi: -3}"), + ~lo3: %raw("-1"), + ~lo4: %raw("-3"), ) => _ = "" let u = ff(~hi=2) diff --git a/tests/tests/src/external_ppx2.res b/tests/tests/src/external_ppx2.res index fd515ec20e0..9ff056417c9 100644 --- a/tests/tests/src/external_ppx2.res +++ b/tests/tests/src/external_ppx2.res @@ -1,4 +1,4 @@ -external f: (@as("\h\e\l\lo") _, int) => unit = "f" +external f: (%raw(`"hello"`), int) => unit = "f" let x = "\h\e\l\lo" let y = f(42) diff --git a/tests/tests/src/ffi_js_test.res b/tests/tests/src/ffi_js_test.res index 58151625456..a54fe4cf365 100644 --- a/tests/tests/src/ffi_js_test.res +++ b/tests/tests/src/ffi_js_test.res @@ -47,12 +47,12 @@ type t @get_index external getGADTI2: (t, @ignore kind<'a>, @ignore kind<'b>, int) => ('a, 'b) = "" -@get_index external getGADTI3: (t, @ignore kind<'a>, @ignore kind<'b>, @as(3) _) => ('a, 'b) = "" +@get_index external getGADTI3: (t, @ignore kind<'a>, @ignore kind<'b>, %raw("3")) => ('a, 'b) = "" @set_index external setGADTI2: (t, @ignore kind<'a>, @ignore kind<'b>, int, ('a, 'b)) => unit = "" @set_index -external setGADTI3: (t, @ignore kind<'a>, @ignore kind<'b>, @as(3) _, ('a, 'b)) => unit = "" +external setGADTI3: (t, @ignore kind<'a>, @ignore kind<'b>, %raw("3"), ('a, 'b)) => unit = "" describe(__MODULE__, () => { test("higher_order function", () => eq(__LOC__, 6, higher_order(1)(2, 3))) diff --git a/tests/tests/src/gpr_1170.res b/tests/tests/src/gpr_1170.res index 42ac38e0bd7..3559e09bcae 100644 --- a/tests/tests/src/gpr_1170.res +++ b/tests/tests/src/gpr_1170.res @@ -1,7 +1,7 @@ type resp -@set external set_okay: (resp, @as(200) _) => unit = "statusCode" +@set external set_okay: (resp, %raw("200")) => unit = "statusCode" -@set external set_hi: (resp, @as("hi") _) => unit = "hi" +@set external set_hi: (resp, %raw(`"hi"`)) => unit = "hi" let f = resp => { set_okay(resp) diff --git a/tests/tests/src/gpr_1484.res b/tests/tests/src/gpr_1484.res index 3a5a6ca32c7..0bb0427e6fc 100644 --- a/tests/tests/src/gpr_1484.res +++ b/tests/tests/src/gpr_1484.res @@ -1,5 +1,5 @@ type t -@set external clearNodeValue: (t, @as(json`null`) _) => unit = "nodeValue" +@set external clearNodeValue: (t, %raw("null")) => unit = "nodeValue" /* TODO: more test cases */ /* external clearNodeValue2 : */ diff --git a/tests/tests/src/mario_game.res b/tests/tests/src/mario_game.res index 20345edbbe7..e7d81f58f49 100644 --- a/tests/tests/src/mario_game.res +++ b/tests/tests/src/mario_game.res @@ -160,7 +160,7 @@ module Dom_html = { @val external window: Dom.window = "window" /* external createImg: (_ [@as "img"]) -> document -> imageElement = "createElement" [@@send] */ - @send external createImg: (Dom.document, @as("img") _) => imageElement = "createElement" + @send external createImg: (Dom.document, %raw(`"img"`)) => imageElement = "createElement" @val external requestAnimationFrame: (float => unit) => unit = "requestAnimationFrame" @return(null_to_opt) @send external getElementById: (Dom.document, string) => option = "getElementById" diff --git a/tests/tests/src/prepend_data_ffi.mjs b/tests/tests/src/prepend_data_ffi.mjs index 9ae19366a9c..8cf59713d86 100644 --- a/tests/tests/src/prepend_data_ffi.mjs +++ b/tests/tests/src/prepend_data_ffi.mjs @@ -22,19 +22,19 @@ process.on(i => i.toString(), 1); xx(3, 3, "xxx", "a", "b"); function f(x) { - x.xx(72, [ + x.xx(73, [ 1, 2, 3 ]); - x.xx(73, 3, "xxx", [ + x.xx(74, 3, "xxx", [ 1, 2, 3 ]); - x.xx(74, 3, "xxx", 1, 2, 3); - x.xx(75, 3, "xxx", 0, "b", 1, 2, 3, 4, 5); - x.xx(76, 3, true, false, "你好", ["你好",1,2,3] , [{ "arr" : ["你好",1,2,3], "encoding" : "utf8"}] , [{ "arr" : ["你好",1,2,3], "encoding" : "utf8"}] , "xxx", 0, "yyy", "b", 1, 2, 3, 4, 5); + x.xx(75, 3, "xxx", 1, 2, 3); + x.xx(76, 3, "xxx", 0, "b", 1, 2, 3, 4, 5); + x.xx(77, 3, true, false, "你好", ["你好",1,2,3], [{"arr":["你好",1,2,3],"encoding":"utf8"}], [{"arr":["你好",1,2,3],"encoding":"utf8"}], "xxx", 0, "yyy", "b", 1, 2, 3, 4, 5); } process.on("exit", exit_code => { diff --git a/tests/tests/src/prepend_data_ffi.res b/tests/tests/src/prepend_data_ffi.res index 33802f4e1b6..b05e4a49fa2 100644 --- a/tests/tests/src/prepend_data_ffi.res +++ b/tests/tests/src/prepend_data_ffi.res @@ -1,30 +1,30 @@ type config1_expect = {"v": int} -@obj external config1: (~stdio: @as("inherit") _, ~v: int, unit) => _ = "" +@obj external config1: (~stdio: %raw(`"inherit"`), ~v: int, unit) => _ = "" let v1: config1_expect = config1(~v=3, ()) type config2_expect = {"v": int} -@obj external config2: (~stdio: @as(1) _, ~v: int, unit) => _ = "" +@obj external config2: (~stdio: %raw("1"), ~v: int, unit) => _ = "" let v2: config2_expect = config2(~v=2, ()) -@val external on_exit: (@as("exit") _, int => string) => unit = "process.on" +@val external on_exit: (%raw(`"exit"`), int => string) => unit = "process.on" let () = on_exit(exit_code => Int.toString(exit_code)) -@val external on_exit_int: (@as(1) _, int => unit) => unit = "process.on" +@val external on_exit_int: (%raw("1"), int => unit) => unit = "process.on" let () = on_exit_int(_ => ()) -@val external on_exit3: (int => string, @as("exit") _) => unit = "process.on" +@val external on_exit3: (int => string, %raw(`"exit"`)) => unit = "process.on" let () = on_exit3(i => Int.toString(i)) -@val external on_exit4: (int => string, @as(1) _) => unit = "process.on" +@val external on_exit4: (int => string, %raw("1")) => unit = "process.on" let () = on_exit4(i => Int.toString(i)) -@val @variadic external on_exit_slice: (int, @as(3) _, @as("xxx") _, array) => unit = "xx" +@val @variadic external on_exit_slice: (int, %raw("3"), %raw(`"xxx"`), array) => unit = "xx" let () = on_exit_slice(3, ["a", "b"]) @@ -32,16 +32,17 @@ type t @send external on_exit_slice1: (t, int, array) => unit = "xx" -@send external on_exit_slice2: (t, int, @as(3) _, @as("xxx") _, array) => unit = "xx" +@send external on_exit_slice2: (t, int, %raw("3"), %raw(`"xxx"`), array) => unit = "xx" -@send @variadic external on_exit_slice3: (t, int, @as(3) _, @as("xxx") _, array) => unit = "xx" +@send @variadic +external on_exit_slice3: (t, int, %raw("3"), %raw(`"xxx"`), array) => unit = "xx" @send @variadic external on_exit_slice4: ( t, int, - @as(3) _, - @as("xxx") _, + %raw("3"), + %raw(`"xxx"`), @int [#a | #b | #c], [#a | #b | #c], array, @@ -51,16 +52,16 @@ external on_exit_slice4: ( external on_exit_slice5: ( t, int, - @as(3) _, - @as(json`true`) _, - @as(json`false`) _, - @as(json`"你好"`) _, - @as(json` ["你好",1,2,3] `) _, - @as(json` [{ "arr" : ["你好",1,2,3], "encoding" : "utf8"}] `) _, - @as(json` [{ "arr" : ["你好",1,2,3], "encoding" : "utf8"}] `) _, - @as("xxx") _, + %raw("3"), + %raw("true"), + %raw("false"), + %raw(`"你好"`), + %raw(`["你好",1,2,3]`), + %raw(`[{"arr":["你好",1,2,3],"encoding":"utf8"}]`), + %raw(`[{"arr":["你好",1,2,3],"encoding":"utf8"}]`), + %raw(`"xxx"`), @int [#a | #b | #c], - @as("yyy") _, + %raw(`"yyy"`), [#a | #b | #c], array, ) => unit = "xx" @@ -76,15 +77,15 @@ let f = (x: t) => { x->on_exit_slice5(__LINE__, #a, #b, [1, 2, 3, 4, 5]) } -@val external process_on_exit: (@as("exit") _, int => unit) => unit = "process.on" +@val external process_on_exit: (%raw(`"exit"`), int => unit) => unit = "process.on" let () = process_on_exit(exit_code => Console.log2("error code: %d", exit_code)) type process -@send external on_exit: (process, @as("exit") _, int => unit) => unit = "on" +@send external on_exit: (process, %raw(`"exit"`), int => unit) => unit = "on" let register = (p: process) => p->on_exit(i => Console.log(i)) -@obj external io_config: (~stdio: @as("inherit") _, ~cwd: string, unit) => _ = "" +@obj external io_config: (~stdio: %raw(`"inherit"`), ~cwd: string, unit) => _ = "" let config = io_config(~cwd=".", ()) diff --git a/tests/tests/src/record_name_test.res b/tests/tests/src/record_name_test.res index 4d5b6bd9251..9f2a6f03e99 100644 --- a/tests/tests/src/record_name_test.res +++ b/tests/tests/src/record_name_test.res @@ -64,8 +64,8 @@ type t6 = { } /* allow this case */ -@obj external ff: (~x: int, ~h: @as(3) _) => _ = "" -@obj external ff2: (~x: int, ~h: @as(3) _) => {"x": int} = "" +@obj external ff: (~x: int, ~h: %raw("3")) => _ = "" +@obj external ff2: (~x: int, ~h: %raw("3")) => {"x": int} = "" let u = () => { ignore(ff(~x=3)) ff2(~x=22) diff --git a/tests/tests/src/tagged_template_test.mjs b/tests/tests/src/tagged_template_test.mjs index 839c31017fe..efb0d26eba9 100644 --- a/tests/tests/src/tagged_template_test.mjs +++ b/tests/tests/src/tagged_template_test.mjs @@ -20,6 +20,10 @@ let id = "5"; let queryWithModule = sql`SELECT * FROM ${table} WHERE id = ${id}`; +let json = Tagged_template_libJs.sql; + +let jsonTaggedQuery = json`SELECT * FROM ${table}`; + let query = sql` " SELECT * FROM ${table} WHERE id = ${id}`; @@ -67,33 +71,34 @@ let rawTag = Tagged_template_libJs.rawTag; let rawResult = rawTag`a ${1} b ${2} c`; Mocha.describe("tagged templates", () => { - Mocha.test("with externals, it should return a string with the correct interpolations", () => Test_utils.eq("File \"tagged_template_test.res\", line 92, characters 6-13", query, ` + Mocha.test("with externals, it should return a string with the correct interpolations", () => Test_utils.eq("File \"tagged_template_test.res\", line 99, characters 6-13", query, ` " SELECT * FROM 'users' WHERE id = '5'`)); - Mocha.test("with module scoped externals, it should also return a string with the correct interpolations", () => Test_utils.eq("File \"tagged_template_test.res\", line 101, characters 13-20", queryWithModule, "SELECT * FROM 'users' WHERE id = '5'")); - Mocha.test("with externals, it should return the result of the function", () => Test_utils.eq("File \"tagged_template_test.res\", line 104, characters 79-86", length$1, 52)); - Mocha.test("with a runtime-constructed tag (factory), it should emit tagged-template syntax", () => Test_utils.eq("File \"tagged_template_test.res\", line 107, characters 7-14", factoryQuery, "PREFIX SELECT * FROM 'users'")); - Mocha.test("with a tag from a bare package import, it should emit tagged-template syntax", () => Test_utils.eq("File \"tagged_template_test.res\", line 113, characters 7-14", bareImportQuery, "PG: SELECT * FROM 'users'")); - Mocha.test("with a tag passed as a function argument, it should emit tagged-template syntax", () => Test_utils.eq("File \"tagged_template_test.res\", line 117, characters 7-14", paramQuery, "SELECT id = '5'")); - Mocha.test("with a tag imported from another module, it should emit tagged-template syntax", () => Test_utils.eq("File \"tagged_template_test.res\", line 121, characters 7-14", crossModuleQuery, "X: SELECT * FROM 'users'")); + Mocha.test("with module scoped externals, it should also return a string with the correct interpolations", () => Test_utils.eq("File \"tagged_template_test.res\", line 108, characters 13-20", queryWithModule, "SELECT * FROM 'users' WHERE id = '5'")); + Mocha.test("a tag named json remains an ordinary tagged template", () => Test_utils.eq("File \"tagged_template_test.res\", line 112, characters 7-14", jsonTaggedQuery, "SELECT * FROM 'users'")); + Mocha.test("with externals, it should return the result of the function", () => Test_utils.eq("File \"tagged_template_test.res\", line 115, characters 79-86", length$1, 52)); + Mocha.test("with a runtime-constructed tag (factory), it should emit tagged-template syntax", () => Test_utils.eq("File \"tagged_template_test.res\", line 118, characters 7-14", factoryQuery, "PREFIX SELECT * FROM 'users'")); + Mocha.test("with a tag from a bare package import, it should emit tagged-template syntax", () => Test_utils.eq("File \"tagged_template_test.res\", line 124, characters 7-14", bareImportQuery, "PG: SELECT * FROM 'users'")); + Mocha.test("with a tag passed as a function argument, it should emit tagged-template syntax", () => Test_utils.eq("File \"tagged_template_test.res\", line 128, characters 7-14", paramQuery, "SELECT id = '5'")); + Mocha.test("with a tag imported from another module, it should emit tagged-template syntax", () => Test_utils.eq("File \"tagged_template_test.res\", line 132, characters 7-14", crossModuleQuery, "X: SELECT * FROM 'users'")); Mocha.test("it should call the tag as a real tagged template (TemplateStringsArray with .raw)", () => { - Test_utils.eq("File \"tagged_template_test.res\", line 125, characters 7-14", rawResult.hasRaw, true); - Test_utils.eq("File \"tagged_template_test.res\", line 126, characters 7-14", rawResult.cooked, [ + Test_utils.eq("File \"tagged_template_test.res\", line 136, characters 7-14", rawResult.hasRaw, true); + Test_utils.eq("File \"tagged_template_test.res\", line 137, characters 7-14", rawResult.cooked, [ "a ", " b ", " c" ]); - Test_utils.eq("File \"tagged_template_test.res\", line 127, characters 7-14", rawResult.raw, [ + Test_utils.eq("File \"tagged_template_test.res\", line 138, characters 7-14", rawResult.raw, [ "a ", " b ", " c" ]); - Test_utils.eq("File \"tagged_template_test.res\", line 128, characters 7-14", rawResult.values, [ + Test_utils.eq("File \"tagged_template_test.res\", line 139, characters 7-14", rawResult.values, [ 1, 2 ]); }); - Mocha.test("with a ReScript tag lifted via TaggedTemplate.make, it should return the correct interpolation", () => Test_utils.eq("File \"tagged_template_test.res\", line 133, characters 13-20", greeting, "hello Ada you're 36 years old!")); - Mocha.test("a regular string interpolation should continue working", () => Test_utils.eq("File \"tagged_template_test.res\", line 137, characters 7-14", `some random string interpolation`, "some random string interpolation")); + Mocha.test("with a ReScript tag lifted via TaggedTemplate.make, it should return the correct interpolation", () => Test_utils.eq("File \"tagged_template_test.res\", line 144, characters 13-20", greeting, "hello Ada you're 36 years old!")); + Mocha.test("a regular string interpolation should continue working", () => Test_utils.eq("File \"tagged_template_test.res\", line 148, characters 7-14", `some random string interpolation`, "some random string interpolation")); Mocha.test("ordinary interpolation evaluates values once from left to right", () => { let calls = []; let record = value => { @@ -101,15 +106,15 @@ Mocha.describe("tagged templates", () => { return value; }; let result = `start ${record("first")} middle ${record("second")} end`; - Test_utils.eq("File \"tagged_template_test.res\", line 147, characters 7-14", result, "start first middle second end"); - Test_utils.eq("File \"tagged_template_test.res\", line 148, characters 7-14", calls, [ + Test_utils.eq("File \"tagged_template_test.res\", line 158, characters 7-14", result, "start first middle second end"); + Test_utils.eq("File \"tagged_template_test.res\", line 159, characters 7-14", calls, [ "first", "second" ]); }); Mocha.test("invalid escapes remain valid in tagged-template segments", () => { let result = rawTag`\unicode`; - Test_utils.eq("File \"tagged_template_test.res\", line 153, characters 7-14", result.raw, ["\\unicode"]); + Test_utils.eq("File \"tagged_template_test.res\", line 164, characters 7-14", result.raw, ["\\unicode"]); }); }); @@ -120,6 +125,8 @@ export { table, id, queryWithModule, + json, + jsonTaggedQuery, query, extraLength, length$1 as length, diff --git a/tests/tests/src/tagged_template_test.res b/tests/tests/src/tagged_template_test.res index aa61e166607..afa20e9e5c9 100644 --- a/tests/tests/src/tagged_template_test.res +++ b/tests/tests/src/tagged_template_test.res @@ -13,6 +13,13 @@ let id = "5" let queryWithModule = Pg.sql`SELECT * FROM ${table} WHERE id = ${id}` +// `json` is not reserved: outside the legacy fixed-external parameter shape, +// it behaves exactly like every other tagged-template identifier. +@module("./tagged_template_lib.js") +external json: taggedTemplate = "sql" + +let jsonTaggedQuery = json`SELECT * FROM ${table}` + // The tag still emits backticks when used through `open` (i.e. once it has // crossed the module boundary as a value of the `taggedTemplate` type). open Pg @@ -101,6 +108,10 @@ describe("tagged templates", () => { () => eq(__LOC__, queryWithModule, "SELECT * FROM 'users' WHERE id = '5'"), ) + test("a tag named json remains an ordinary tagged template", () => + eq(__LOC__, jsonTaggedQuery, "SELECT * FROM 'users'") + ) + test("with externals, it should return the result of the function", () => eq(__LOC__, length, 52)) test("with a runtime-constructed tag (factory), it should emit tagged-template syntax", () => diff --git a/tools/src/tools.ml b/tools/src/tools.ml index 3ae00bff140..43b44862fc0 100644 --- a/tools/src/tools.ml +++ b/tools/src/tools.ml @@ -864,7 +864,6 @@ module Format_codeblocks = struct match (name, payload) with | {txt = "res.doc"}, PStr [{pstr_desc = Pstr_eval ({pexp_loc}, _)}] -> ( - Ast_payload.reject_json_literal_payload payload; match Ast_payload.semantic_string_of_payload payload with | Some contents -> let formatted_contents, had_code_blocks = From 21bbae10044c86e735b2bc334544e057e4411ffa Mon Sep 17 00:00:00 2001 From: Christoph Knittel Date: Fri, 4 Sep 2026 07:16:51 +0200 Subject: [PATCH 2/3] Fix JSX completion fixture for raw external arguments Signed-off-by: Christoph Knittel --- tests/analysis_tests/tests/src/CompletionJsx.res | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/analysis_tests/tests/src/CompletionJsx.res b/tests/analysis_tests/tests/src/CompletionJsx.res index 655d61298d3..6ad77f6a33f 100644 --- a/tests/analysis_tests/tests/src/CompletionJsx.res +++ b/tests/analysis_tests/tests/src/CompletionJsx.res @@ -56,7 +56,7 @@ module IntrinsicElementLowercase = { type props = {name?: string, age?: int} @module("react") - external make: (@as("mesh") _, props) => Jsx.element = "createElement" + external make: (%raw(`"mesh"`), props) => Jsx.element = "createElement" } // Date: Fri, 4 Sep 2026 07:42:54 +0200 Subject: [PATCH 3/3] Allow slow CI builds in watch recompilation test Signed-off-by: Christoph Knittel --- rewatch/tests/watch/01-watch-recompile.sh | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/rewatch/tests/watch/01-watch-recompile.sh b/rewatch/tests/watch/01-watch-recompile.sh index 626df386161..8ba43b5a813 100755 --- a/rewatch/tests/watch/01-watch-recompile.sh +++ b/rewatch/tests/watch/01-watch-recompile.sh @@ -22,9 +22,10 @@ success "Watcher Started" # Trigger a recompilation echo 'Console.log("added-by-test")' >> ./packages/main/src/Main.res -# Wait for the compiled JS to show up (can be slow in CI) +# A cold build of the test repo can exceed 20 seconds on Intel macOS CI. +# Poll so faster machines can continue as soon as the output is ready. target=./packages/main/src/Main.mjs -if ! wait_for_file "$target" 20; then +if ! wait_for_file "$target" 60; then error "Expected output not found: $target" ls -la ./packages/main/src || true tail -n 200 rewatch.log || true