GenType: removed support for @genType.as in type definitions, which has become unnecessary.

CHANGELOG.md

@@ -47,6 +47,7 @@ These are only breaking changes for unformatted code.
 - Remove deprecated module `Printexc`
 - `@deriving(jsConverter)` not supported anymore for variant types https://github.com/rescript-lang/rescript-compiler/pull/6088
 - New representation for variants, where the tag is a string instead of a number. https://github.com/rescript-lang/rescript-compiler/pull/6088
+- GenType: removed support for `@genType.as` for records and variants which has become unnecessary. Use the language's `@as` instead to channge the runtime representation without requiring any runtime conversion during FFI.
 
 #### :bug: Bug Fix
 
@@ -84,6 +85,7 @@ These are only breaking changes for unformatted code.
 - Change the compilation of pattern matching for variants so it does not depends on variats being integers https://github.com/rescript-lang/rescript-compiler/pull/6085
 - Improve code generated for string templates https://github.com/rescript-lang/rescript-compiler/pull/6090
 - Move Jsx and JsxDOM and JsxEvent and JsxPPXReactSupport inside Pervasives and build them separately for curried and uncurried mode https://github.com/rescript-lang/rescript-compiler/pull/6091
+- Gentype: allow recursive data types https://github.com/rescript-association/genType/issues/585
 
 # 10.1.4
 

Makefile

@@ -13,7 +13,7 @@ bench:
 	$(DUNE_BIN_DIR)/syntax_benchmarks
 
 dce:
-	reanalyze.exe -- -dce-cmt _build
+	reanalyze.exe -dce-cmt _build/default/jscomp
 
 ninja/ninja:
 	./scripts/buildNinjaBinary.js
@@ -43,6 +43,7 @@ test-all: test test-gentype
 
 reanalyze:
 	reanalyze.exe -set-exit-code -all-cmt _build/default/res_syntax -suppress res_syntax/testrunner
+	reanalyze.exe -set-exit-code -all-cmt _build/default/jscomp -suppress res_syntax/testrunner -exclude-paths jscomp/super_errors,jscomp/outcome_printer,jscomp/ounit_tests,jscomp/ml,jscomp/js_parser,jscomp/frontend,jscomp/ext,jscomp/depends,jscomp/core,jscomp/common,jscomp/cmij,jscomp/bsb_helper,jscomp/bsb
 
 lib: build node_modules/.bin/semver
 	node scripts/ninja.js config

jscomp/frontend/ast_attributes.mli

@@ -94,4 +94,4 @@ val process_send_pipe : t -> (Parsetree.core_type * t) option
 
 val process_as_value : t -> Lambda.as_value option
 
-val process_tag_name : t -> string option
+val process_tag_name : t -> string option

jscomp/gentype/Annotation.ml

@@ -64,65 +64,89 @@ let rec getAttributePayload checkText (attributes : Typedtree.attributes) =
   in
   match attributes with
   | [] -> None
-  | ({Asttypes.txt}, payload) :: _tl when checkText txt -> (
+  | ({txt; loc}, payload) :: _tl when checkText txt -> (
+    let payload =
+      match payload with
+      | PStr [] -> Some UnrecognizedPayload
+      | PStr ({pstr_desc = Pstr_eval (expr, _)} :: _) -> expr |> fromExpr
+      | PStr ({pstr_desc = Pstr_extension _} :: _) -> Some UnrecognizedPayload
+      | PStr ({pstr_desc = Pstr_value _} :: _) -> Some UnrecognizedPayload
+      | PStr ({pstr_desc = Pstr_primitive _} :: _) -> Some UnrecognizedPayload
+      | PStr ({pstr_desc = Pstr_type _} :: _) -> Some UnrecognizedPayload
+      | PStr ({pstr_desc = Pstr_typext _} :: _) -> Some UnrecognizedPayload
+      | PStr ({pstr_desc = Pstr_exception _} :: _) -> Some UnrecognizedPayload
+      | PStr ({pstr_desc = Pstr_module _} :: _) -> Some UnrecognizedPayload
+      | PStr ({pstr_desc = Pstr_recmodule _} :: _) -> Some UnrecognizedPayload
+      | PStr ({pstr_desc = Pstr_modtype _} :: _) -> Some UnrecognizedPayload
+      | PStr ({pstr_desc = Pstr_open _} :: _) -> Some UnrecognizedPayload
+      | PStr ({pstr_desc = Pstr_class _} :: _) -> Some UnrecognizedPayload
+      | PStr ({pstr_desc = Pstr_class_type _} :: _) -> Some UnrecognizedPayload
+      | PStr ({pstr_desc = Pstr_include _} :: _) -> Some UnrecognizedPayload
+      | PStr ({pstr_desc = Pstr_attribute _} :: _) -> Some UnrecognizedPayload
+      | PPat _ -> Some UnrecognizedPayload
+      | PSig _ -> Some UnrecognizedPayload
+      | PTyp _ -> Some UnrecognizedPayload
+    in
     match payload with
-    | PStr [] -> Some UnrecognizedPayload
-    | PStr ({pstr_desc = Pstr_eval (expr, _)} :: _) -> expr |> fromExpr
-    | PStr ({pstr_desc = Pstr_extension _} :: _) -> Some UnrecognizedPayload
-    | PStr ({pstr_desc = Pstr_value _} :: _) -> Some UnrecognizedPayload
-    | PStr ({pstr_desc = Pstr_primitive _} :: _) -> Some UnrecognizedPayload
-    | PStr ({pstr_desc = Pstr_type _} :: _) -> Some UnrecognizedPayload
-    | PStr ({pstr_desc = Pstr_typext _} :: _) -> Some UnrecognizedPayload
-    | PStr ({pstr_desc = Pstr_exception _} :: _) -> Some UnrecognizedPayload
-    | PStr ({pstr_desc = Pstr_module _} :: _) -> Some UnrecognizedPayload
-    | PStr ({pstr_desc = Pstr_recmodule _} :: _) -> Some UnrecognizedPayload
-    | PStr ({pstr_desc = Pstr_modtype _} :: _) -> Some UnrecognizedPayload
-    | PStr ({pstr_desc = Pstr_open _} :: _) -> Some UnrecognizedPayload
-    | PStr ({pstr_desc = Pstr_class _} :: _) -> Some UnrecognizedPayload
-    | PStr ({pstr_desc = Pstr_class_type _} :: _) -> Some UnrecognizedPayload
-    | PStr ({pstr_desc = Pstr_include _} :: _) -> Some UnrecognizedPayload
-    | PStr ({pstr_desc = Pstr_attribute _} :: _) -> Some UnrecognizedPayload
-    | PPat _ -> Some UnrecognizedPayload
-    | PSig _ -> Some UnrecognizedPayload
-    | PTyp _ -> Some UnrecognizedPayload)
+    | None -> None
+    | Some payload -> Some (loc, payload))
   | _hd :: tl -> getAttributePayload checkText tl
 
 let getGenTypeAsRenaming attributes =
   match attributes |> getAttributePayload tagIsGenTypeAs with
-  | Some (StringPayload s) -> Some s
+  | Some (_, StringPayload s) -> Some s
   | None -> (
     match attributes |> getAttributePayload tagIsGenType with
-    | Some (StringPayload s) -> Some s
+    | Some (_, StringPayload s) -> Some s
     | _ -> None)
   | _ -> None
 
+(* This is not supported anymore: only use to give a warning *)
+let checkUnsupportedGenTypeAsRenaming attributes =
+  let error ~loc =
+    Log_.Color.setup ();
+    Log_.info ~loc ~name:"Warning genType" (fun ppf () ->
+        Format.fprintf ppf
+          "@\n\
+           @genType.as is not supported anymore in type definitions. Use @as \
+           from the language.")
+  in
+  match attributes |> getAttributePayload tagIsGenTypeAs with
+  | Some (loc, _) -> error ~loc
+  | None -> (
+    match attributes |> getAttributePayload tagIsGenType with
+    | Some (loc, _) -> error ~loc
+    | None -> ())
+
 let getBsAsRenaming attributes =
   match attributes |> getAttributePayload tagIsBsAs with
-  | Some (StringPayload s) -> Some s
+  | Some (_, StringPayload s) -> Some s
   | _ -> None
 
 let getBsAsInt attributes =
   match attributes |> getAttributePayload tagIsBsAs with
-  | Some (IntPayload s) -> (
+  | Some (_, IntPayload s) -> (
     try Some (int_of_string s) with Failure _ -> None)
   | _ -> None
 
 let getAttributeImportRenaming attributes =
   let attributeImport = attributes |> getAttributePayload tagIsGenTypeImport in
   let genTypeAsRenaming = attributes |> getGenTypeAsRenaming in
   match (attributeImport, genTypeAsRenaming) with
-  | Some (StringPayload importString), _ ->
+  | Some (_, StringPayload importString), _ ->
     (Some importString, genTypeAsRenaming)
   | ( Some
-        (TuplePayload [StringPayload importString; StringPayload renameString]),
+        ( _,
+          TuplePayload [StringPayload importString; StringPayload renameString]
+        ),
       _ ) ->
     (Some importString, Some renameString)
   | _ -> (None, genTypeAsRenaming)
 
 let getDocString attributes =
   let docPayload = attributes |> getAttributePayload tagIsOcamlDoc in
   match docPayload with
-  | Some (StringPayload docString) -> "/** " ^ docString ^ " */\n"
+  | Some (_, StringPayload docString) -> "/** " ^ docString ^ " */\n"
   | _ -> ""
 
 let hasAttribute checkText (attributes : Typedtree.attributes) =
@@ -133,7 +157,7 @@ let fromAttributes ~loc (attributes : Typedtree.attributes) =
   else if hasAttribute (fun s -> tagIsGenType s || tagIsGenTypeAs s) attributes
   then (
     (match attributes |> getAttributePayload tagIsGenType with
-    | Some UnrecognizedPayload -> ()
+    | Some (_, UnrecognizedPayload) -> ()
     | Some _ ->
       Log_.Color.setup ();
       Log_.info ~loc ~name:"Warning genType" (fun ppf () ->