Print variant runtime repr in error messages, and fix inclusion check. (#6669)

* POC print variant runtime repr

As in `type t = @as(undefined) A`

Triggered in error message:

```res
Type declarations do not match:
    type t = @as(undefined) A
  is not included in
    type t = @as(null) A
```

* Print @unboxed for variants and check inclusion correctly.

- Print `@unboxed` in the variant type declaration in the outcome printer.
- Fix issue where attributes such as `@unboxed` were printed twice.
- Fix issue where inconsistency in `@unboxed` in variant declarations between implementation and interface was not chedked.

* snake case

* Changelog and test.

* Bump rescript-core for playground bundling.

Author: cristianoc

CHANGELOG.md

@@ -18,6 +18,7 @@
 - PPX v4: mark props type in externals as `@live` to avoid dead code warnings for prop fields in the editor tooling. https://github.com/rescript-lang/rescript-compiler/pull/6796
 - Fix issue where optional labels were not taken into account when disambiguating record value construction. https://github.com/rescript-lang/rescript-compiler/pull/6798
 - Fix issue in gentype when type `Jsx.element` surfaces to the user. https://github.com/rescript-lang/rescript-compiler/pull/6808
+- Fix inclusion check (impl vs interface) for untagged variants, and fix the outcome printer to show tags. https://github.com/rescript-lang/rescript-compiler/pull/6669
 
 # 11.1.1
 

jscomp/build_tests/super_errors/expected/UntaggedImplIntf.res.expected

@@ -0,0 +1,29 @@
+
+  We've found a bug for you!
+  /.../fixtures/UntaggedImplIntf.res:3:5-5:1
+
+  1 │ module M: {
+  2 │   @unboxed type t = | @as(null) A
+  3 │ } = {
+  4 │   type t = | @as(null) A
+  5 │ }
+
+  Signature mismatch:
+  Modules do not match:
+    {
+  type t = @as(null) A
+}
+  is not included in
+    {
+  @unboxed type t = @as(null) A
+}
+  Type declarations do not match:
+    type t = @as(null) A
+  is not included in
+    @unboxed type t = @as(null) A
+  /.../fixtures/UntaggedImplIntf.res:2:12-33:
+    Expected declaration
+  /.../fixtures/UntaggedImplIntf.res:4:3-24:
+    Actual declaration
+  Their internal representations differ:
+  the second declaration uses unboxed representation.

jscomp/build_tests/super_errors/fixtures/UntaggedImplIntf.res

@@ -0,0 +1,5 @@
+module M: {
+  @unboxed type t = | @as(null) A
+} = {
+  type t = | @as(null) A
+}

jscomp/ml/includecore.ml

@@ -328,8 +328,10 @@ let type_declarations ?(equality = false) ~loc env name decl1 id decl2 =
   in
   if err <> [] then err else
   let err =
-    match (decl2.type_kind, decl1.type_unboxed.unboxed,
-           decl2.type_unboxed.unboxed) with
+    let untagged1 = Ast_untagged_variants.process_untagged decl1.type_attributes in
+    let untagged2 = Ast_untagged_variants.process_untagged decl2.type_attributes in  
+    match (decl2.type_kind, decl1.type_unboxed.unboxed || untagged1,
+           decl2.type_unboxed.unboxed || untagged2) with
     | Type_abstract, _, _ -> []
     | _, true, false -> [Unboxed_representation false]
     | _, false, true -> [Unboxed_representation true]

jscomp/ml/oprint.ml

@@ -499,13 +499,13 @@ and print_out_signature ppf =
         match items with
             Osig_typext(ext, Oext_next) :: items ->
               gather_extensions
-                ((ext.oext_name, ext.oext_args, ext.oext_ret_type) :: acc)
+                ((ext.oext_name, ext.oext_args, ext.oext_ret_type, ext.oext_repr) :: acc)
                 items
           | _ -> (List.rev acc, items)
       in
       let exts, items =
         gather_extensions
-          [(ext.oext_name, ext.oext_args, ext.oext_ret_type)]
+          [(ext.oext_name, ext.oext_args, ext.oext_ret_type, ext.oext_repr)]
           items
       in
       let te =
@@ -531,7 +531,7 @@ and print_out_sig_item ppf =
         name !out_class_type clt
   | Osig_typext (ext, Oext_exception) ->
       fprintf ppf "@[<2>exception %a@]"
-        print_out_constr (ext.oext_name, ext.oext_args, ext.oext_ret_type)
+        print_out_constr (ext.oext_name, ext.oext_args, ext.oext_ret_type, ext.oext_repr)
   | Osig_typext (ext, _es) ->
       print_out_extension_constructor ppf ext
   | Osig_modtype (name, Omty_abstract) ->
@@ -639,7 +639,10 @@ and print_out_type_decl kwd ppf td =
     print_immediate
     print_unboxed
 
-and print_out_constr ppf (name, tyl,ret_type_opt) =
+and print_out_constr ppf (name, tyl, ret_type_opt, repr) =
+  let () = match repr with
+    | None -> ()
+    | Some s -> pp_print_string ppf s in
   let name =
     match name with
     | "::" -> "(::)"   (* #7200 *)
@@ -686,7 +689,7 @@ and print_out_extension_constructor ppf ext =
   fprintf ppf "@[<hv 2>type %t +=%s@;<1 2>%a@]"
     print_extended_type
     (if ext.oext_private = Asttypes.Private then " private" else "")
-    print_out_constr (ext.oext_name, ext.oext_args, ext.oext_ret_type)
+    print_out_constr (ext.oext_name, ext.oext_args, ext.oext_ret_type, ext.oext_repr)
 
 and print_out_type_extension ppf te =
   let print_extended_type ppf =
@@ -736,13 +739,13 @@ let rec print_items ppf =
         match items with
             (Osig_typext(ext, Oext_next), None) :: items ->
               gather_extensions
-                ((ext.oext_name, ext.oext_args, ext.oext_ret_type) :: acc)
+                ((ext.oext_name, ext.oext_args, ext.oext_ret_type, ext.oext_repr) :: acc)
                 items
           | _ -> (List.rev acc, items)
       in
       let exts, items =
         gather_extensions
-          [(ext.oext_name, ext.oext_args, ext.oext_ret_type)]
+          [(ext.oext_name, ext.oext_args, ext.oext_ret_type, ext.oext_repr)]
           items
       in
       let te =

jscomp/ml/outcometree.ml

@@ -63,7 +63,7 @@ type out_type =
   | Otyp_object of (string * out_type) list * bool option
   | Otyp_record of (string * bool * bool * out_type) list
   | Otyp_stuff of string
-  | Otyp_sum of (string * out_type list * out_type option) list
+  | Otyp_sum of (string * out_type list * out_type option * string option) list
   | Otyp_tuple of out_type list
   | Otyp_var of bool * string
   | Otyp_variant of
@@ -118,11 +118,12 @@ and out_extension_constructor =
     oext_type_params: string list;
     oext_args: out_type list;
     oext_ret_type: out_type option;
+    oext_repr: string option;
     oext_private: Asttypes.private_flag }
 and out_type_extension =
   { otyext_name: string;
     otyext_params: string list;
-    otyext_constructors: (string * out_type list * out_type option) list;
+    otyext_constructors: (string * out_type list * out_type option * string option) list;
     otyext_private: Asttypes.private_flag }
 and out_val_decl =
   { oval_name: string;

jscomp/ml/printtyp.ml

@@ -881,6 +881,7 @@ let rec tree_of_type_decl id decl =
   in
   let (name, args) = type_defined decl in
   let constraints = tree_of_constraints params in
+  let untagged = ref false in
   let ty, priv =
     match decl.type_kind with
     | Type_abstract ->
@@ -890,6 +891,7 @@ let rec tree_of_type_decl id decl =
             tree_of_typexp false ty, decl.type_private
         end
     | Type_variant cstrs ->
+        untagged := Ast_untagged_variants.process_untagged decl.type_attributes;
         tree_of_manifest (Otyp_sum (List.map tree_of_constructor cstrs)),
         decl.type_private
     | Type_record(lbls, _rep) ->
@@ -907,7 +909,7 @@ let rec tree_of_type_decl id decl =
       otype_type = ty;
       otype_private = priv;
       otype_immediate = immediate;
-      otype_unboxed = decl.type_unboxed.unboxed;
+      otype_unboxed = decl.type_unboxed.unboxed || !untagged;
       otype_cstrs = constraints ;
       }
 
@@ -917,16 +919,29 @@ and tree_of_constructor_arguments = function
 
 and tree_of_constructor cd =
   let name = Ident.name cd.cd_id in
+  let nullary = Ast_untagged_variants.is_nullary_variant cd.cd_args in
+  let repr =
+    if not nullary then None
+    else match Ast_untagged_variants.process_tag_type cd.cd_attributes with
+      | Some Null -> Some "@as(null)"
+      | Some Undefined -> Some "@as(undefined)"
+      | Some (String s) -> Some (Printf.sprintf "@as(%S)" s)
+      | Some (Int i) -> Some (Printf.sprintf "@as(%d)" i)
+      | Some (Float f) -> Some (Printf.sprintf "@as(%s)" f)
+      | Some (Bool b) -> Some (Printf.sprintf "@as(%b)" b)
+      | Some (BigInt s) -> Some (Printf.sprintf "@as(%sn)" s)
+      | Some (Untagged _) (* should never happen *)
+      | None -> None in
   let arg () = tree_of_constructor_arguments cd.cd_args in
   match cd.cd_res with
-  | None -> (name, arg (), None)
+  | None -> (name, arg (), None, repr)
   | Some res ->
       let nm = !names in
       names := [];
       let ret = tree_of_typexp false res in
       let args = arg () in
       names := nm;
-      (name, args, Some ret)
+      (name, args, Some ret, repr)
 
 and tree_of_label l =
   let opt = l.ld_attributes |> List.exists (fun ({txt}, _) -> txt = "ns.optional" || txt = "res.optional") in
@@ -982,6 +997,7 @@ let tree_of_extension_constructor id ext es =
       oext_type_params = ty_params;
       oext_args = args;
       oext_ret_type = ret;
+      oext_repr = None;
       oext_private = ext.ext_private }
   in
   let es =

jscomp/syntax/src/res_outcome_printer.ml

@@ -483,7 +483,12 @@ and printOutConstructorsDoc constructors =
                  constructors);
           ]))
 
-and printOutConstructorDoc (name, args, gadt) =
+and printOutConstructorDoc (name, args, gadt, repr) =
+  let reprDoc =
+    match repr with
+    | None -> Doc.nil
+    | Some s -> Doc.text (s ^ " ")
+  in
   let gadtDoc =
     match gadt with
     | Some outType -> Doc.concat [Doc.text ": "; printOutTypeDoc outType]
@@ -523,7 +528,7 @@ and printOutConstructorDoc (name, args, gadt) =
              Doc.rparen;
            ])
   in
-  Doc.group (Doc.concat [Doc.text name; argsDoc; gadtDoc])
+  Doc.group (Doc.concat [reprDoc; Doc.text name; argsDoc; gadtDoc])
 
 and printRecordDeclRowDoc (name, mut, opt, arg) =
   Doc.group
@@ -730,7 +735,6 @@ let rec printOutSigItemDoc ?(printNameAsIs = false)
            Doc.group
              (Doc.concat
                 [
-                  attrs;
                   kw;
                   (if printNameAsIs then Doc.text outTypeDecl.otype_name
                    else printIdentLike ~allowUident:false outTypeDecl.otype_name);
@@ -808,13 +812,14 @@ and printOutSignatureDoc (signature : Outcometree.out_sig_item list) =
         match items with
         | Outcometree.Osig_typext (ext, Oext_next) :: items ->
           gather_extensions
-            ((ext.oext_name, ext.oext_args, ext.oext_ret_type) :: acc)
+            ((ext.oext_name, ext.oext_args, ext.oext_ret_type, ext.oext_repr)
+            :: acc)
             items
         | _ -> (List.rev acc, items)
       in
       let exts, items =
         gather_extensions
-          [(ext.oext_name, ext.oext_args, ext.oext_ret_type)]
+          [(ext.oext_name, ext.oext_args, ext.oext_ret_type, ext.oext_repr)]
           items
       in
       let te =
@@ -872,7 +877,10 @@ and printOutExtensionConstructorDoc
          (if outExt.oext_private = Asttypes.Private then Doc.text "private "
           else Doc.nil);
          printOutConstructorDoc
-           (outExt.oext_name, outExt.oext_args, outExt.oext_ret_type);
+           ( outExt.oext_name,
+             outExt.oext_args,
+             outExt.oext_ret_type,
+             outExt.oext_repr );
        ])
 
 and printOutTypeExtensionDoc (typeExtension : Outcometree.out_type_extension) =
@@ -1084,13 +1092,14 @@ let printOutPhraseSignature signature =
         match items with
         | (Outcometree.Osig_typext (ext, Oext_next), None) :: items ->
           gather_extensions
-            ((ext.oext_name, ext.oext_args, ext.oext_ret_type) :: acc)
+            ((ext.oext_name, ext.oext_args, ext.oext_ret_type, ext.oext_repr)
+            :: acc)
             items
         | _ -> (List.rev acc, items)
       in
       let exts, signature =
         gather_extensions
-          [(ext.oext_name, ext.oext_args, ext.oext_ret_type)]
+          [(ext.oext_name, ext.oext_args, ext.oext_ret_type, ext.oext_repr)]
           signature
       in
       let te =

packages/playground-bundling/package-lock.json

@@ -11,7 +11,7 @@
   "author": "",
   "license": "ISC",
   "dependencies": {
-    "@rescript/core": "^1.1.0",
+    "@rescript/core": "^1.5.0",
     "@rescript/react": "^0.12.1"
   }
 }