Keep @tag and runtime annotations when printing a type declaration (#9136)

* Keep @tag and runtime annotations when printing a type declaration

Why:
    The printer of type declarations kept only @Immediate and @unboxed.
    @tag, @notundefined, @instanceof and @typeof were dropped, so a
    signature mismatch about them printed two declarations that looked the
    same, hover hid them, and createInterface wrote an interface for an
    applied functor that does not match its implementation (#9134).

Diagnostic modified (@tag mismatch):
Example:
    // Foo.res
    @tag("type")
    type t =
      | @as("a") A
      | B
    // Foo.resi
    @tag("kind")
    type t =
      | @as("a") A
      | B
Before (diagnostic):
    Actual declaration (Foo.res:2:1-4:5):
      type t = @as("a") A | B

    Expected declaration (Foo.resi:2:1-4:5):
      type t = @as("a") A | B

    Their @tag annotations differ.
After (diagnostic):
    Actual declaration (Foo.res:2:1-4:5):
      @tag("type") type t = @as("a") A | B

    Expected declaration (Foo.resi:2:1-4:5):
      @tag("kind") type t = @as("a") A | B

    Their @tag annotations differ.

Diagnostic modified (@notundefined functor parameter):
Example:
    module Make = (
      X: {
        @notundefined type t
      },
    ) => {
      type u = X.t
    }
    module Applied = Make({
      type t = option<int>
    })
Before (diagnostic):
    Actual declaration (not_undefined_functor_argument.res:10:3-22):
      type t = option<int>

    Expected declaration (not_undefined_functor_argument.res:3:19-24):
      type t

    Their runtime representations differ:
      Actual declaration: can hold undefined
      Expected declaration: @notundefined
After (diagnostic):
    Actual declaration (not_undefined_functor_argument.res:10:3-22):
      type t = option<int>

    Expected declaration (not_undefined_functor_argument.res:3:19-24):
      @notundefined type t

    Their runtime representations differ:
      Actual declaration: can hold undefined
      Expected declaration: @notundefined

Format modified (createInterface for an applied functor):
Example:
    module Tagged = (X: Type) => {
      @tag("kind") type wrapped = Value({value: X.t}) | Empty({reason: string})
    }
    module IntTagged = Tagged({
      type t = int
    })
Before (rescript): the interface does not compile against the implementation
    module IntTagged: {
      type wrapped = Value({value: int}) | Empty({reason: string})
    }
After (rescript):
    module IntTagged: {
      @tag("kind") type wrapped = Value({value: int}) | Empty({reason: string})
    }

Representation modified (printed declaration annotations, Printtyp.tree_of_type_decl):
Before (representation):
    otype_immediate: bool ↦ @Immediate
    otype_unboxed: bool ↦ @unboxed
After (representation):
    otype_attributes: string list ↦ @Immediate @unboxed @tag("…") @notundefined | @instanceof("…") | @typeof("…")
    source: what the declaration itself states, not what it inherits from an abbreviated type

Review: Why read the attributes rather than the declaration's runtime shape? The shape of an abbreviation can come from the type it abbreviates; the printed declaration should show what it states itself, as the source does.
Review: Can printing raise for a malformed annotation? No. The annotations are parsed by the functions that typing uses, which raise on malformed payloads; those were reported when the declaration was typed, and the printer then leaves the annotation out.

Fixes: #9134
Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
Claude-Session: https://claude.ai/code/session_01Kbf3gLpf7RN1MiRcubPgRn
Signed-off-by: Christoph Knittel <ck@cca.io>

* Say when declarations that differ read the same

Why:
    With the annotations printed, two declarations can still read the same
    and not match, when a type they mention differs between the two sides,
    e.g. a base class that the interface leaves abstract. The error then
    showed the same text twice, which reads as a bug in the compiler. The
    reasons now start with a note saying so, which replaces the lead-in of a
    difference in runtime representation.

Diagnostic modified (declarations that print the same):
Example:
    // Classes.res
    @instanceof("Animal") type animal
    @instanceof("Dog") type dog = private animal
    // Classes.resi
    type animal
    @instanceof("Dog") type dog = private animal
Before (diagnostic):
    Actual declaration (Classes.res:2:20-44):
      @instanceof("Dog") type dog = private animal

    Expected declaration (Classes.resi:2:20-44):
      @instanceof("Dog") type dog = private animal

    Their runtime representations differ:
      Actual declaration: instances of Dog, a subclass of Animal
      Expected declaration: instances of Dog
After (diagnostic):
    Actual declaration (Classes.res:2:20-44):
      @instanceof("Dog") type dog = private animal

    Expected declaration (Classes.resi:2:20-44):
      @instanceof("Dog") type dog = private animal

    The declarations read the same, but a type they mention differs:
      Actual declaration: instances of Dog, a subclass of Animal
      Expected declaration: instances of Dog

Review: Why compare the printed text? It is what the reader sees, and the case to catch is exactly two declarations that look the same.

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
Claude-Session: https://claude.ai/code/session_01Kbf3gLpf7RN1MiRcubPgRn
Signed-off-by: Christoph Knittel <ck@cca.io>

* Escape a @tag name when printing it

Codex review of #9136: the printed @tag put the decoded name between quotes
as it is, so a tag with a quote printed as invalid source and a backslash
changed its value when reparsed, also in interfaces written by
createInterface. It is now encoded as a string literal, which keeps
non-ASCII letters as they are.

Diagnostic modified (@tag names with a quote, a backslash and a non-ASCII letter):
Example:
    module M: {
      @tag("k\"ind") type t = A({x: int}) | B({y: int})
    } = {
      @tag("typ\\é") type t = A({x: int}) | B({y: int})
    }
Before (diagnostic):
    Actual declaration (tag_name_escaped.res:6:18-51):
      @tag("typ\é") type t = A({x: int}) | B({y: int})

    Expected declaration (tag_name_escaped.res:4:18-51):
      @tag("k"ind") type t = A({x: int}) | B({y: int})
After (diagnostic):
    Actual declaration (tag_name_escaped.res:6:18-51):
      @tag("typ\\é") type t = A({x: int}) | B({y: int})

    Expected declaration (tag_name_escaped.res:4:18-51):
      @tag("k\"ind") type t = A({x: int}) | B({y: int})

Co-Authored-By: Claude Opus 5.5 <noreply@anthropic.com>
Claude-Session: https://claude.ai/code/session_01Kbf3gLpf7RN1MiRcubPgRn
Signed-off-by: Christoph Knittel <ck@cca.io>

---------

Signed-off-by: Christoph Knittel <ck@cca.io>
Co-authored-by: Claude Opus 5.5 <noreply@anthropic.com>

Author: cknitt

changes/print-type-annotations.fix.md

@@ -0,0 +1 @@
+- Keep `@tag`, `@notUndefined`, `@instanceOf` and `@typeOf` when printing a type declaration, in error messages, hover and generated interfaces.

compiler/ml/includecore.ml

@@ -201,7 +201,9 @@ let label side decl =
   in
   String.capitalize_ascii (side ^ " " ^ decl)
 
-let report_type_mismatch0 first second decl ppf err =
+(* [lead_in] introduces the two lines of a difference in runtime
+   representation; without it they stand under a lead-in printed before *)
+let report_type_mismatch0 ?(lead_in = true) first second decl ppf err =
   let pr fmt = Format.fprintf ppf fmt in
   match err with
   | Arity -> pr "They have different arities"
@@ -243,24 +245,41 @@ let report_type_mismatch0 first second decl ppf err =
   | Variant_representation s ->
     pr "The internal representations for case %s are not equal" (Ident.name s)
   | Not_undefined ->
-    pr
-      "@[<v 2>Their runtime representations differ:@,\
-       %s: can hold undefined@,\
-       %s: @notUndefined@]"
-      (label first decl) (label second decl)
+    if lead_in then pr "@[<v 2>Their runtime representations differ:@,";
+    pr "%s: can hold undefined@,%s: @notUndefined" (label first decl)
+      (label second decl);
+    if lead_in then pr "@]"
   | Runtime_annotation (declared1, declared2) ->
-    pr "@[<v 2>Their runtime representations differ:@,%s: %s@,%s: %s@]"
-      (label first decl) declared1 (label second decl) declared2
+    if lead_in then pr "@[<v 2>Their runtime representations differ:@,";
+    pr "%s: %s@,%s: %s" (label first decl) declared1 (label second decl)
+      declared2;
+    if lead_in then pr "@]"
 
-let report_type_mismatch first second decl ppf =
-  List.iter (fun err ->
-      match err with
-      | Manifest -> ()
-      (* Its lines are labels, not sentences *)
-      | Runtime_annotation _ | Not_undefined ->
-        Format.fprintf ppf "@ %a" (report_type_mismatch0 first second decl) err
-      | _ ->
-        Format.fprintf ppf "@ %a." (report_type_mismatch0 first second decl) err)
+(* Each reason on a line after a break. [read_the_same] puts them under a note
+   that the declarations print the same, which then replaces the lead-in of a
+   difference in runtime representation. *)
+let report_type_mismatch ?(read_the_same = false) first second decl ppf errs =
+  let report ppf =
+    List.iter (fun err ->
+        match err with
+        | Manifest -> ()
+        (* Its lines are labels, not sentences *)
+        | Runtime_annotation _ | Not_undefined ->
+          Format.fprintf ppf "@ %a"
+            (report_type_mismatch0 ~lead_in:(not read_the_same) first second
+               decl)
+            err
+        | _ ->
+          Format.fprintf ppf "@ %a."
+            (report_type_mismatch0 first second decl)
+            err)
+  in
+  if read_the_same then
+    Format.fprintf ppf
+      "@ @[<v 2>The declarations read the same, but a type they mention \
+       differs:%a@]"
+      report errs
+  else report ppf errs
 
 let rec compare_constructor_arguments env cstr params1 params2 arg1 arg2 =
   match (arg1, arg2) with

compiler/ml/includecore.mli

@@ -67,4 +67,10 @@ val extension_constructors :
   Env.t -> Ident.t -> extension_constructor -> extension_constructor -> bool
 
 val report_type_mismatch :
-  string -> string -> string -> Format.formatter -> type_mismatch list -> unit
+  ?read_the_same:bool ->
+  string ->
+  string ->
+  string ->
+  Format.formatter ->
+  type_mismatch list ->
+  unit

compiler/ml/includemod.ml

@@ -583,8 +583,16 @@ let include_symptom ~swapped env ppf = function
         if swapped then ("the expected", "the actual")
         else ("the actual", "the expected")
       in
+      (* Declarations can print the same and still differ, when a type they
+         mention differs between the two sides, e.g. a class the interface
+         leaves abstract. The reasons then say that first. *)
+      let read_the_same =
+        Format.asprintf "%a" (type_declaration id) d1
+        = Format.asprintf "%a" (type_declaration id) d2
+      in
       fprintf ppf "@,%a"
-        (Includecore.report_type_mismatch first second "declaration")
+        (Includecore.report_type_mismatch ~read_the_same first second
+           "declaration")
         errs
   | Extension_constructors (id, x1, x2) ->
     show_declarations ~swapped (extension_constructor id) ppf

compiler/ml/outcometree.ml

@@ -70,8 +70,9 @@ and out_type_decl = {
   otype_params: (string * (bool * bool)) list;
   otype_type: out_type;
   otype_private: Asttypes.private_flag;
-  otype_immediate: bool;
-  otype_unboxed: bool;
+  otype_attributes: string list;
+      (** The annotations that change what the declaration means at run time,
+          as they are written, e.g. [@unboxed] or [@tag("kind")] *)
   otype_cstrs: (out_type * out_type) list;
 }
 and out_extension_constructor = {

compiler/ml/printtyp.ml

@@ -892,14 +892,35 @@ and tree_of_type_decl id decl =
         decl.type_private,
         decl.type_representation = Unboxed )
   in
-  let immediate = Builtin_attributes.immediate decl.type_attributes in
+  let attributes =
+    let flag set attribute = if set then [attribute] else [] in
+    (* A malformed annotation was reported when the declaration was typed *)
+    let stated process =
+      try process decl.type_attributes
+      with Ast_untagged_variants.Error _ -> None
+    in
+    List.concat
+      [
+        flag (Builtin_attributes.immediate decl.type_attributes) "@immediate";
+        flag unboxed "@unboxed";
+        (match stated Ast_untagged_variants.process_tag_name with
+        | Some name ->
+          [Printf.sprintf "@tag(\"%s\")" (String_literal.encode_js_string name)]
+        | None -> []);
+        (match
+           stated (Ast_untagged_variants.process_runtime_annotation ?loc:None)
+         with
+        | Some annotation ->
+          [Ast_untagged_variants.runtime_annotation_to_string annotation]
+        | None -> []);
+      ]
+  in
   {
     otype_name = name;
     otype_params = args;
     otype_type = ty;
     otype_private = priv;
-    otype_immediate = immediate;
-    otype_unboxed = unboxed;
+    otype_attributes = attributes;
     otype_cstrs = constraints;
   }
 

compiler/syntax/src/res_outcome_printer.ml

@@ -661,11 +661,10 @@ let rec print_out_sig_item_doc ?(print_name_as_is = false)
   | Osig_type (out_type_decl, out_rec_status) ->
     (* TODO: manifest ? *)
     let attrs =
-      match (out_type_decl.otype_immediate, out_type_decl.otype_unboxed) with
-      | false, false -> Doc.nil
-      | true, false -> Doc.concat [Doc.text "@immediate"; Doc.line]
-      | false, true -> Doc.concat [Doc.text "@unboxed"; Doc.line]
-      | true, true -> Doc.concat [Doc.text "@immediate @unboxed"; Doc.line]
+      match out_type_decl.otype_attributes with
+      | [] -> Doc.nil
+      | attributes ->
+        Doc.concat [Doc.text (String.concat " " attributes); Doc.line]
     in
     let kw =
       Doc.text

tests/analysis_tests/tests/src/CreateInterfaceFunctor.res

@@ -32,3 +32,12 @@ module WithWire = (X: {}) => {
 }
 
 module Applied = WithWire({})
+
+// Types of an applied functor keep their @tag
+module type Type = {
+  type t
+}
+
+module Tagged = (X: Type) => {
+  @tag("kind") type wrapped = Value({value: X.t}) | Empty({reason: string})
+}

tests/analysis_tests/tests/src/CreateInterfaceFunctorUse.res

@@ -9,3 +9,7 @@ include CreateInterfaceFunctor.MakeSet({
   type t = float
   let compare = (a: float, b) => a < b ? -1 : a > b ? 1 : 0
 })
+
+module IntTagged = CreateInterfaceFunctor.Tagged({
+  type t = int
+})