Gentype: fix issue with labelled args which should not be grouped. (#6406)

* Gentype: fix issue with labelled args which should not be grouped.

Grouping labelled args is a leftover incompatible with zero cost conversion.

Fixes #6361

* Make optional args of option type.

Author: cristianoc

CHANGELOG.md

@@ -12,6 +12,10 @@
 
 # 11.0.0-rc.4 (Unreleased)
 
+#### :bug: Bug Fix
+
+- Fix issue with GenType and labelled arguments https://github.com/rescript-lang/rescript-compiler/pull/6406
+
 #### :rocket: New Feature
 
 - Support renaming fields in inline records with `@as` attribute. [#6391](https://github.com/rescript-lang/rescript-compiler/pull/6391)

jscomp/gentype/Converter.ml

@@ -13,9 +13,6 @@ let typeGetInlined ~config ~lookupId ~typeNameIsInterface type0 =
       let argConverted = argTypes |> List.map (argTypeToGroupedArg ~visited) in
       let retNormalized = retType |> visit ~visited in
       Function {function_ with argTypes = argConverted; retType = retNormalized}
-    | GroupOfLabeledArgs _ ->
-      (* This case should only fire from withing a function *)
-      normalized_
     | Ident {builtin = true} -> normalized_
     | Ident {builtin = false; name; typeArgs} -> (
       if visited |> StringSet.mem name then (
@@ -77,21 +74,8 @@ let typeGetInlined ~config ~lookupId ~typeNameIsInterface type0 =
       in
       normalized
   and argTypeToGroupedArg ~visited {aName; aType} =
-    match aType with
-    | GroupOfLabeledArgs fields ->
-      let fieldsConverted =
-        fields
-        |> List.map (fun ({type_} as field) -> (field, type_ |> visit ~visited))
-      in
-      let tNormalized =
-        GroupOfLabeledArgs
-          (fieldsConverted
-          |> List.map (fun (field, t) -> {field with type_ = t}))
-      in
-      {aName; aType = tNormalized}
-    | _ ->
-      let tNormalized = aType |> visit ~visited in
-      {aName; aType = tNormalized}
+    let tNormalized = aType |> visit ~visited in
+    {aName; aType = tNormalized}
   in
   let normalized = type0 |> visit ~visited:StringSet.empty in
   if !Debug.converter then

jscomp/gentype/EmitJs.ml

@@ -549,7 +549,7 @@ let propagateAnnotationToSubTypes ~codeItems (typeMap : CodeItem.exportTypeMap)
       | Function {argTypes; retType} ->
         argTypes |> List.iter (fun {aType} -> visit aType);
         retType |> visit
-      | GroupOfLabeledArgs fields | Object (_, fields) ->
+      | Object (_, fields) ->
         fields |> List.iter (fun {type_} -> type_ |> visit)
       | Option t | Null t | Nullable t | Promise t -> t |> visit
       | Tuple innerTypes -> innerTypes |> List.iter visit

jscomp/gentype/EmitType.ml

@@ -105,7 +105,7 @@ let rec renderType ~(config : Config.t) ?(indent = None) ~typeNameIsInterface
   | Function {argTypes; retType; typeVars} ->
     renderFunType ~config ~indent ~inFunType ~typeNameIsInterface ~typeVars
       argTypes retType
-  | GroupOfLabeledArgs fields | Object (_, fields) ->
+  | Object (_, fields) ->
     let indent1 = fields |> Indent.heuristicFields ~indent in
     fields
     |> renderFields ~config ~indent:indent1 ~inFunType ~typeNameIsInterface

jscomp/gentype/GenTypeCommon.ml

@@ -69,7 +69,6 @@ type type_ =
   | Array of type_ * mutable_
   | Dict of type_
   | Function of function_
-  | GroupOfLabeledArgs of fields
   | Ident of ident
   | Null of type_
   | Nullable of type_

jscomp/gentype/NamedArgs.ml

@@ -1,62 +1,14 @@
 open GenTypeCommon
 
-type groupedArg = Group of fields | Arg of type_
-
-(**
- For convenient processing turns consecutive named arguments into a
- `NamedArgs` group, and individual non-named arguments into `Arg`s.
-*)
-let rec groupReversed ~revCurGroup ~revResult labeledTypes =
-  match (revCurGroup, labeledTypes) with
-  | [], (Nolabel, type_) :: tl ->
-    groupReversed ~revCurGroup:[] ~revResult:(Arg type_ :: revResult) tl
-  | _, (OptLabel name, type_) :: tl ->
-    (* Add it to the current group, not result. *)
-    groupReversed
-      ~revCurGroup:
-        ({
-           mutable_ = Immutable;
-           nameJS = name;
-           optional = Optional;
-           type_;
-           docString = DocString.empty;
-         }
-        :: revCurGroup)
-      ~revResult tl
-  | _, (Label name, type_) :: tl ->
-    groupReversed
-      ~revCurGroup:
-        ({
-           mutable_ = Immutable;
-           nameJS = name;
-           optional = Mandatory;
-           type_;
-           docString = DocString.empty;
-         }
-        :: revCurGroup)
-      ~revResult tl
-  | [], [] -> revResult
-  | _grpHd :: _grpTl, ([] as _tl) | _grpHd :: _grpTl, (Nolabel, _) :: _tl ->
-    (* Just form the group, and recurse ignoring the (None, t) in that case.
-       t will be handled in recursion. *)
-    groupReversed ~revCurGroup:[]
-      ~revResult:(Group revCurGroup :: revResult)
-      labeledTypes
-
-(** Special reverse that not only reverses the entire list but also the order of
-  items in the NamedArgs grouping. *)
-let rec reverse ?(soFar = []) lst =
-  match lst with
-  | [] -> soFar
-  | [Arg type_] when type_ = unitT && soFar = [] ->
-    (* treat a single argument of type unit as no argument *)
-    []
-  | Arg type_ :: tl -> reverse ~soFar:({aName = ""; aType = type_} :: soFar) tl
-  | Group fields :: tl ->
-    reverse
-      ~soFar:
-        ({aName = ""; aType = GroupOfLabeledArgs (List.rev fields)} :: soFar)
-      tl
-
 let group labeledTypes =
-  labeledTypes |> groupReversed ~revCurGroup:[] ~revResult:[] |> reverse
+  let types =
+    Ext_list.map labeledTypes (fun (lbl, aType) ->
+        match lbl with
+        | Nolabel -> {aName = ""; aType}
+        | Label lbl -> {aName = lbl; aType}
+        | OptLabel lbl -> {aName = lbl; aType = Option aType})
+  in
+  match types with
+  | [{aType}] when aType = unitT ->
+    [] (* treat a single argument of type unit as no argument *)
+  | _ -> types

jscomp/gentype/TranslateStructure.ml

@@ -3,14 +3,19 @@ open GenTypeCommon
 let rec addAnnotationsToTypes_ ~config ~(expr : Typedtree.expression)
     (argTypes : argType list) =
   match (expr.exp_desc, expr.exp_type.desc, argTypes) with
-  | _, _, {aName; aType = GroupOfLabeledArgs fields} :: nextTypes ->
-    let fields1, nextTypes1 =
-      addAnnotationsToFields ~config expr fields nextTypes
-    in
-    {aName; aType = GroupOfLabeledArgs fields1} :: nextTypes1
-  | Texp_function {param; cases = [{c_rhs}]}, _, {aType} :: nextTypes ->
+  | Texp_function {arg_label; param; cases = [{c_rhs}]}, _, {aType} :: nextTypes
+    ->
     let nextTypes1 = nextTypes |> addAnnotationsToTypes_ ~config ~expr:c_rhs in
     let aName = Ident.name param in
+    let _ = Printtyped.implementation in
+    let aName =
+      if aName = "*opt*" then
+        match arg_label with
+        | Optional l ->
+          l
+        | _ -> "" (* should not happen *)
+      else aName
+    in
     {aName; aType} :: nextTypes1
   | Texp_construct ({txt = Lident "Function$"}, _, [funExpr]), _, _ ->
     (* let uncurried1: function$<_, _> = Function$(x => x |> string_of_int, [`Has_arity1]) *)

jscomp/gentype/TypeVars.ml

@@ -40,11 +40,6 @@ let rec substitute ~f type0 =
           |> List.map (fun {aName; aType = t} ->
                  {aName; aType = t |> substitute ~f});
       }
-  | GroupOfLabeledArgs fields ->
-    GroupOfLabeledArgs
-      (fields
-      |> List.map (fun field ->
-             {field with type_ = field.type_ |> substitute ~f}))
   | Ident {typeArgs = []} -> type0
   | Ident ({typeArgs} as ident) ->
     Ident {ident with typeArgs = typeArgs |> List.map (substitute ~f)}
@@ -80,7 +75,7 @@ let rec free_ type0 : StringSet.t =
     StringSet.diff
       ((argTypes |> freeOfList_) +++ (retType |> free_))
       (typeVars |> StringSet.of_list)
-  | GroupOfLabeledArgs fields | Object (_, fields) ->
+  | Object (_, fields) ->
     fields
     |> List.fold_left
          (fun s {type_} -> StringSet.union s (type_ |> free_))

jscomp/gentype_tests/typescript-react-example/package-lock.json

@@ -39,7 +39,7 @@ export const unnamed2: (param_0:number, param_1:number) => number = DocstringsBS
 
 export const unnamed2U: (param_0:number, param_1:number) => number = DocstringsBS.unnamed2U;
 
-export const grouped: (_1:{ readonly x: number; readonly y: number }, a:number, b:number, c:number, _5:{ readonly z: number }) => number = DocstringsBS.grouped;
+export const grouped: (x:number, y:number, a:number, b:number, c:number, z:number) => number = DocstringsBS.grouped;
 
 export const unitArgWithoutConversion: () => string = DocstringsBS.unitArgWithoutConversion;