Make @as part of the AST

CHANGELOG.md

@@ -37,7 +37,10 @@
 #### :bug: Bug fix
 
 - Fix the side-effect analysis treating bigint exponentiation and bounds-checked array and string reads as pure, which let dead-code elimination drop an unused one that throws: `let _ = 2n ** -1n` no longer raised. https://github.com/rescript-lang/rescript/pull/8617
+- Preserve record field `@as` annotations when formatting object types containing spreads. https://github.com/rescript-lang/rescript/pull/8619
 - Fix excessive parentheses and indentation in function assignments to refs, align record and array assignment formatting across refs and fields, and preserve function return-type parentheses and consistent JSX fragment layout in callbacks. https://github.com/rescript-lang/rescript/pull/8611
+- Report an error instead of crashing when an integer in a variant constructor's `@as` annotation exceeds the compiler's integer range. https://github.com/rescript-lang/rescript/pull/8619
+- Warn about an `@as` on a record field whose payload does not name the field, such as `@as(42)`. It renamed nothing and was silently accepted. https://github.com/rescript-lang/rescript/pull/8619
 - Fix a recursive module with an empty signature discarding its right-hand side. Lambda-to-Lam conversion rewrote `Pupdate_mod` to unit when the module's shape had no fields, dropping the primitive's arguments - one of which is the right-hand side - so `module rec M: {} = { let () = Console.log("effect") }` emitted nothing for `M`. The elision now happens where the bindings are produced, with the right-hand side still in hand. https://github.com/rescript-lang/rescript/pull/8608
 - Fix a compiler crash on a polymorphic variant whose numeric name exceeds the `int32` range. `#99999999999("a")` and the same name in a pattern failed with `Failure("Int32.of_string")` and no location, because the range check ran in the frontend AST pass and matched only payload-free expressions. It now runs in `Typecore`, next to the integer literal decoding whose overflow error it mirrors, and covers both label positions. A bare `type t = [#99999999999]` still compiles, since nothing decodes a row field name. https://github.com/rescript-lang/rescript/pull/8608
 - Object typing errors now describe fields directly: assigning to a field without `@set` reports that the field is not settable and suggests the annotation, and missing-property errors name the field instead of a phantom `"x#="` member. https://github.com/rescript-lang/rescript/pull/8597
@@ -66,12 +69,15 @@
 - Print external declarations in signatures and type errors with their processed attributes instead of the `"#rescript-external"` placeholder, and print inline constants using `@inline` syntax. https://github.com/rescript-lang/rescript/pull/8581
 - Improve diagnostics for dynamic imports of local values and attempts to use `import` as a first-class value. https://github.com/rescript-lang/rescript/pull/8582
 - Allow inferred labeled functions to be called with labels in any order by removing legacy curried-arrow commutation locks. https://github.com/rescript-lang/rescript/pull/8547
+- Format an `@as` payload written as a backquoted string with ordinary quotes, on both record fields and variant constructors, since it names the same thing either way. https://github.com/rescript-lang/rescript/pull/8619
 
 #### :house: Internal
 
 - Normalize Lambda terms where they are built: a match guard stays structured data until its fallthrough is known, and `apply` and `mk_builtin` go through the folding constructors. https://github.com/rescript-lang/rescript/pull/8615
 - Replace non-escaping local mutable blocks with scalar bindings when all uses are direct field accesses, generalizing reference unboxing to multi-field records and references captured by JavaScript closures. https://github.com/rescript-lang/rescript/pull/8617
 - Split `lambda.ml` into the IR and its traversals, static exits and path translation, so the module defining `Lambda.t` no longer reaches into `Env` or `Path`. https://github.com/rescript-lang/rescript/pull/8618
+- Record a record field's `@as` rename on the declaration instead of re-reading the attribute, so every place that needs the runtime name reads one field. https://github.com/rescript-lang/rescript/pull/8619
+- Record a variant constructor's `@as` tag on the declaration instead of re-interpreting its attributes, keeping the source spelling for printing. https://github.com/rescript-lang/rescript/pull/8619
 - Merge the duplicate Lam intermediate representation into Lambda, removing the conversion layer and obsolete supporting infrastructure. Lambda is now a single private, normalized representation, with generated JavaScript remaining semantically unchanged. https://github.com/rescript-lang/rescript/pull/8608
 - Add genType and source map controls and output to the developer playground. https://github.com/rescript-lang/rescript/pull/8448
 - Rework the object-type representation end to end: object rows are plain field chains carrying a per-field mutability state (no phantom setter members), object literals are typed directly and property access and assignment are first-class AST and Lambda nodes shared between the Lambda and JS pipelines, and dead class-system remnants (the field-presence lattice, the class-abbreviation memo on object types, method-send typing) are removed. https://github.com/rescript-lang/rescript/pull/8597

analysis/src/completion_front_end.ml

@@ -892,51 +892,57 @@ let completion_with_parser1 ~debug ~offset ~pos_cursor ~kind_file
     if not !processed then
       Ast_iterator.default_iterator.signature_item iterator item
   in
+  (* A decorator whose name spans the cursor completes decorator names. The
+     label is taken from the source text under the location, since the
+     parser's location can run past the name: [@foo. let x] gives [@foo.let].
+     A field's [@as] is a field of the declaration rather than an attribute,
+     so [label_declaration] below reports its location here too. *)
+  let decorator_at ~id_txt (id_loc : Location.t) =
+    let pos_start, pos_end = Loc.range id_loc in
+    match
+      ( Pos.position_to_offset text pos_start,
+        Pos.position_to_offset text pos_end )
+    with
+    | Some offset_start, Some offset_end
+      when offset_start >= 0 && offset_end >= offset_start ->
+      let label =
+        let raw_label =
+          String.sub text offset_start (offset_end - offset_start)
+        in
+        let ( ++ ) x y =
+          match (x, y) with
+          | Some i1, Some i2 -> Some (min i1 i2)
+          | Some _, None -> x
+          | None, _ -> y
+        in
+        let label =
+          match
+            String.index_opt raw_label ' '
+            ++ String.index_opt raw_label '\t'
+            ++ String.index_opt raw_label '\r'
+            ++ String.index_opt raw_label '\n'
+          with
+          | None -> raw_label
+          | Some i -> String.sub raw_label 0 i
+        in
+        if label <> "" && label.[0] = '@' then
+          String.sub label 1 (String.length label - 1)
+        else label
+      in
+      found := true;
+      if debug then
+        Printf.printf "Attribute id:%s:%s label:%s\n" id_txt
+          (Loc.to_string id_loc) label;
+      set_result (Completable.Cdecorator label)
+    | _ -> ()
+  in
   let attribute (iterator : Ast_iterator.iterator)
       ((id, payload) : Parsetree.attribute) =
     (if String.length id.txt >= 4 && String.sub id.txt 0 4 = "res." then
        (* skip: internal parser attribute *) ()
      else if id.loc.loc_ghost then ()
      else if id.loc |> Loc.has_pos ~pos:pos_before_cursor then
-       let pos_start, pos_end = Loc.range id.loc in
-       match
-         ( Pos.position_to_offset text pos_start,
-           Pos.position_to_offset text pos_end )
-       with
-       | Some offset_start, Some offset_end
-         when offset_start >= 0 && offset_end >= offset_start ->
-         (* Can't trust the parser's location
-            E.g. @foo. let x... gives as label @foo.let *)
-         let label =
-           let raw_label =
-             String.sub text offset_start (offset_end - offset_start)
-           in
-           let ( ++ ) x y =
-             match (x, y) with
-             | Some i1, Some i2 -> Some (min i1 i2)
-             | Some _, None -> x
-             | None, _ -> y
-           in
-           let label =
-             match
-               String.index_opt raw_label ' '
-               ++ String.index_opt raw_label '\t'
-               ++ String.index_opt raw_label '\r'
-               ++ String.index_opt raw_label '\n'
-             with
-             | None -> raw_label
-             | Some i -> String.sub raw_label 0 i
-           in
-           if label <> "" && label.[0] = '@' then
-             String.sub label 1 (String.length label - 1)
-           else label
-         in
-         found := true;
-         if debug then
-           Printf.printf "Attribute id:%s:%s label:%s\n" id.txt
-             (Loc.to_string id.loc) label;
-         set_result (Completable.Cdecorator label)
-       | _ -> ()
+       decorator_at ~id_txt:id.txt id.loc
      else if id.txt = "module" then
        match payload with
        | PStr
@@ -1844,11 +1850,33 @@ let completion_with_parser1 ~debug ~offset ~pos_cursor ~kind_file
     if Loc.end_ loc <= pos_cursor then last_scope_before_cursor := !scope
   in
 
+  let label_declaration (iterator : Ast_iterator.iterator)
+      (ld : Parsetree.label_declaration) =
+    (match ld.pld_runtime_name with
+    | Some {loc}
+      when (not loc.loc_ghost) && Loc.has_pos loc ~pos:pos_before_cursor ->
+      decorator_at ~id_txt:"as" loc
+    | _ -> ());
+    Ast_iterator.default_iterator.label_declaration iterator ld
+  in
+
+  let constructor_declaration (iterator : Ast_iterator.iterator)
+      (cd : Parsetree.constructor_declaration) =
+    (match cd.pcd_runtime_tag with
+    | Some {loc}
+      when (not loc.loc_ghost) && Loc.has_pos loc ~pos:pos_before_cursor ->
+      decorator_at ~id_txt:"as" loc
+    | _ -> ());
+    Ast_iterator.default_iterator.constructor_declaration iterator cd
+  in
+
   let iterator =
     {
       Ast_iterator.default_iterator with
       attribute;
+      constructor_declaration;
       expr;
+      label_declaration;
       location;
       module_expr;
       module_type;

compiler/core/bs_conditional_initial.ml

@@ -40,11 +40,6 @@ let setup_env () =
   Clflags.binary_annotations := true;
   (* Turn on [-no-alias-deps] by default -- double check *)
   Oprint.out_ident := Outcome_printer_ns.out_ident;
-  Builtin_attributes.check_bs_attributes_inclusion :=
-    Record_attributes_check.check_bs_attributes_inclusion;
-  Builtin_attributes.check_duplicated_labels :=
-    Record_attributes_check.check_duplicated_labels;
-
   Printtyp.print_res_poly_identifier := Res_printer.polyvar_ident_to_string
 (*; Switch.cut := 100*)
 (* tweakable but not very useful *)

compiler/core/js_dump.ml

@@ -936,16 +936,16 @@ and expression_desc cxt ~(level : int) f x : cxt =
       else
         ( Js_op.Lit tag_name,
           (* TAG:xx for inline records *)
-          match tag.tag_type with
+          match tag.literal with
           | None -> E.str p.name
-          | Some t -> E.tag_type t )
+          | Some t -> E.literal_tag t )
         :: tails
     in
     expression_desc cxt ~level f (Object (None, objs))
   | Caml_block (el, _, Blk_constructor p) ->
     let not_is_cons = p.name <> Literals.cons in
     let {Variant_runtime.tag; tag_name; untagged} = p.runtime in
-    let tag_type = tag.tag_type in
+    let literal = tag.literal in
     let tag_name = Option.value tag_name ~default:L.tag in
     let objs =
       let tails =
@@ -964,9 +964,9 @@ and expression_desc cxt ~(level : int) f x : cxt =
       else
         ( Js_op.Lit tag_name,
           (* TAG:xx *)
-          match tag_type with
+          match literal with
           | None -> E.str p.name
-          | Some t -> E.tag_type t )
+          | Some t -> E.literal_tag t )
         :: tails
     in
     let exp =

compiler/core/js_exp_make.ml

@@ -1389,7 +1389,8 @@ let rec float_equal ?comment (e0 : t) (e1 : t) : t =
 
 let int_equal = float_equal
 
-let tag_type = function
+(* The JS value a declared tag stands for. *)
+let literal_tag = function
   | Variant_runtime.String s -> str s
   | Int i -> small_int i
   | Float f -> float f
@@ -1399,19 +1400,24 @@ let tag_type = function
   | Bool b -> bool b
   | Null -> nil
   | Undefined -> undefined
-  | Untagged IntType -> str "number"
-  | Untagged FloatType -> str "number"
-  | Untagged BigintType -> str "bigint"
-  | Untagged BooleanType -> str "boolean"
-  | Untagged FunctionType -> str "function"
-  | Untagged StringType -> str "string"
-  | Untagged (InstanceType i) ->
-    js_global (Variant_runtime.Instance.to_string i)
-  | Untagged ObjectType -> str "object"
-  | Untagged UnknownType ->
+
+(* The [typeof] string an untagged payload answers to. *)
+let block_type_name = function
+  | Variant_runtime.IntType | FloatType -> str "number"
+  | BigintType -> str "bigint"
+  | BooleanType -> str "boolean"
+  | FunctionType -> str "function"
+  | StringType -> str "string"
+  | InstanceType i -> js_global (Variant_runtime.Instance.to_string i)
+  | ObjectType -> str "object"
+  | UnknownType ->
     (* TODO: this should not happen *)
     assert false
 
+let tag_type = function
+  | Variant_runtime.Literal d -> literal_tag d
+  | Untagged b -> block_type_name b
+
 let rec emit_check (check : t Ast_untagged_variants.Dynamic_checks.t) =
   match check with
   | TagType t -> tag_type t

compiler/core/js_exp_make.mli

@@ -161,6 +161,7 @@ val extension_assign : t -> int32 -> string -> t -> t
 
 val assign : ?comment:string -> t -> t -> t
 
+val literal_tag : Variant_runtime.literal_tag -> t
 val tag_type : Variant_runtime.tag_type -> t
 
 val emit_check : t Ast_untagged_variants.Dynamic_checks.t -> t
@@ -183,7 +184,7 @@ val is_type_number : ?comment:string -> t -> t
 val is_int_tag : ?has_null_undefined_other:bool * bool * bool -> t -> t
 
 val is_a_literal_case :
-  literal_cases:Variant_runtime.tag_type list ->
+  literal_cases:Variant_runtime.literal_tag list ->
   block_cases:Variant_runtime.block_type list ->
   t ->
   t

compiler/core/js_of_lam_variant.ml

@@ -40,7 +40,7 @@ let eval (arg : J.expression) (dispatches : (string * string) list) : E.t =
         [
           S.string_switch arg
             (Ext_list.map dispatches (fun (s, r) ->
-                 ( Variant_runtime.String s,
+                 ( Variant_runtime.Literal (String s),
                    J.
                      {
                        switch_body = [S.return_stmt (E.str r)];
@@ -81,7 +81,7 @@ let eval_as_event (arg : J.expression)
               S.string_switch
                 (E.poly_var_tag_access arg)
                 (Ext_list.map dispatches (fun (s, r) ->
-                     ( Variant_runtime.String s,
+                     ( Variant_runtime.Literal (String s),
                        J.
                          {
                            switch_body = [S.return_stmt (E.str r)];
@@ -110,7 +110,7 @@ let eval_as_int (arg : J.expression) (dispatches : (string * int) list) : E.t =
         [
           S.string_switch arg
             (Ext_list.map dispatches (fun (s, r) ->
-                 ( Variant_runtime.String s,
+                 ( Variant_runtime.Literal (String s),
                    J.
                      {
                        switch_body = [S.return_stmt (E.int (Int32.of_int r))];

compiler/core/js_stmt_make.ml

@@ -149,10 +149,8 @@ let string_switch ?(comment : string option)
       match
         Ext_list.find_opt clauses (fun (switch_case, x) ->
             match switch_case with
-            | String s -> if s = txt then Some x.switch_body else None
-            | Int _ | Float _ | BigInt _ | Bool _ | Null | Undefined
-            | Untagged _ ->
-              None)
+            | Literal (String s) -> if s = txt then Some x.switch_body else None
+            | Literal _ | Untagged _ -> None)
       with
       | Some case -> case
       | None -> (

compiler/core/lam_compile.ml

@@ -173,15 +173,17 @@ let default_action ~saturated failaction =
 
 let tag_of_switch_key = function
   | Lambda.Switch_int _ -> None
-  | Switch_constructor (Constant tag) -> Some tag
+  | Switch_constructor (Constant tag) ->
+    Some (Variant_runtime.to_matchable_tag tag)
   | Switch_constructor
       (Block
          {
            runtime = {tag = {name}; untagged = true};
            block_type = Some block_type;
          }) ->
     Some {name; tag_type = Some (Untagged block_type)}
-  | Switch_constructor (Block {runtime = {untagged = false; tag}}) -> Some tag
+  | Switch_constructor (Block {runtime = {untagged = false; tag}}) ->
+    Some (Variant_runtime.to_matchable_tag tag)
   | Switch_constructor (Block {runtime = {untagged = true}; block_type = None})
     ->
     assert false
@@ -700,7 +702,7 @@ let compile output_prefix =
         | Some {Variant_runtime.tag_type = Some t}, Some string_table ->
           Some ((t, lam) :: string_table)
         | Some {name; tag_type = None}, Some string_table ->
-          Some ((String name, lam) :: string_table)
+          Some ((Literal (String name), lam) :: string_table)
         | _, _ -> None)
       table (Some [])
   and compile_cases ?(untagged = false) ?(has_null_case = false) ~cxt
@@ -935,7 +937,7 @@ let compile output_prefix =
         The [gen] can be elimiated when number of [cases] is less than 3
     *)
     let cases =
-      cases |> List.map (fun (s, l) -> (Variant_runtime.String s, l))
+      cases |> List.map (fun (s, l) -> (Variant_runtime.Literal (String s), l))
     in
     match
       compile_lambda {lambda_cxt with continuation = NeedValue Not_tail} l

compiler/core/lam_compile_const.ml

@@ -50,11 +50,11 @@ and translate (x : Lambda.structured_constant) : J.expression =
   | Const_js_null -> E.nil
   | Const_js_undefined {is_unit = true} -> E.unit
   | Const_js_undefined {is_unit = false} -> E.undefined
-  | Const_constructor {name; tag_type = None} ->
+  | Const_constructor {name; literal = None} ->
     (* The runtime representation of a constant constructor is its name,
        except for the list constructor [] which is the number 0 *)
     if name = "[]" then E.int 0l ~comment:"[]" else E.str name
-  | Const_constructor {tag_type = Some t} -> E.tag_type t
+  | Const_constructor {literal = Some t} -> E.literal_tag t
   | Const_int i -> E.int i
   | Const_assertfalse -> E.int 0l ~comment:"assert_false"
   | Const_char i -> Js_of_lam_string.const_char i

compiler/core/lam_compile_primitive.ml

@@ -567,7 +567,7 @@ let translate output_prefix loc (cxt : Lam_compile_context.t)
          {
            name = "::";
            num_nonconst = 1;
-           runtime = Ast_untagged_variants.block_runtime ~name:"::" [];
+           runtime = Ast_untagged_variants.generated_block_runtime ~name:"::";
          })
       args
   | Pmakedict -> (