Add typars in binding when there is an order mismatch. (#15366)

Author: nojaf

src/Compiler/Checking/CheckPatterns.fs

@@ -105,6 +105,12 @@ and TcSimplePat optionalArgsOK checkConstraints (cenv: cenv) ty env patEnv p =
         | _ -> UnifyTypes cenv env m ty ctyR
 
         let patEnvR = TcPatLinearEnv(tpenv, names, takenNames)
+        
+        // Ensure the untyped typar name sticks
+        match cty, ty with
+        | SynType.Var(typar = SynTypar(ident = untypedIdent)), TType_var(typar = typedTp) -> typedTp.SetIdent(untypedIdent)
+        | _ -> ()
+
         TcSimplePat optionalArgsOK checkConstraints cenv ty env patEnvR p
 
     | SynSimplePat.Attrib (p, _, _) ->

src/Compiler/Checking/NicePrint.fs

@@ -1259,14 +1259,15 @@ module PrintTastMemberOrVals =
         else 
             nameL
 
-    let layoutMemberName (denv: DisplayEnv) (vref: ValRef) niceMethodTypars tagFunction name =
+    let layoutMemberName (denv: DisplayEnv) (vref: ValRef) niceMethodTypars argInfos tagFunction name =
         let nameL = ConvertValLogicalNameToDisplayLayout vref.IsBaseVal (tagFunction >> mkNav vref.DefinitionRange >> wordL) name
         let nameL =
             if denv.showMemberContainers then 
                 layoutTyconRef denv vref.MemberApparentEntity ^^ SepL.dot ^^ nameL
             else
                 nameL
-        let nameL = if denv.showTyparBinding then layoutTyparDecls denv nameL true niceMethodTypars else nameL
+        let typarOrderMismatch = isTyparOrderMismatch niceMethodTypars argInfos
+        let nameL = if denv.showTyparBinding || typarOrderMismatch then layoutTyparDecls denv nameL true niceMethodTypars else nameL
         let nameL = layoutAccessibility denv vref.Accessibility nameL
         nameL
 
@@ -1289,7 +1290,7 @@ module PrintTastMemberOrVals =
                 let resL =
                     if short then tauL
                     else
-                        let nameL = layoutMemberName denv vref niceMethodTypars tagMember vref.DisplayNameCoreMangled
+                        let nameL = layoutMemberName denv vref niceMethodTypars argInfos tagMember vref.DisplayNameCoreMangled
                         let nameL = if short then nameL else mkInlineL denv vref.Deref nameL
                         stat --- ((nameL  |> addColonL) ^^ tauL)
                 prettyTyparInst, resL
@@ -1311,7 +1312,7 @@ module PrintTastMemberOrVals =
                 if isNil argInfos then
                     // use error recovery because intellisense on an incomplete file will show this
                     errorR(Error(FSComp.SR.tastInvalidFormForPropertyGetter(), vref.Id.idRange))
-                    let nameL = layoutMemberName denv vref [] tagProperty vref.DisplayNameCoreMangled
+                    let nameL = layoutMemberName denv vref [] argInfos tagProperty vref.DisplayNameCoreMangled
                     let resL =
                         if short then nameL --- (WordL.keywordWith ^^ WordL.keywordGet)
                         else stat --- nameL --- (WordL.keywordWith ^^ WordL.keywordGet)
@@ -1327,25 +1328,26 @@ module PrintTastMemberOrVals =
                             if isNil argInfos then tauL
                             else tauL --- (WordL.keywordWith ^^ WordL.keywordGet)
                         else
-                            let nameL = layoutMemberName denv vref niceMethodTypars tagProperty vref.DisplayNameCoreMangled
+                            let nameL = layoutMemberName denv vref niceMethodTypars argInfos tagProperty vref.DisplayNameCoreMangled
                             stat --- ((nameL  |> addColonL) ^^ (if isNil argInfos then tauL else tauL --- (WordL.keywordWith ^^ WordL.keywordGet)))
                     prettyTyparInst, resL
 
             | SynMemberKind.PropertySet ->
                 if argInfos.Length <> 1 || isNil argInfos.Head then
                     // use error recovery because intellisense on an incomplete file will show this
                     errorR(Error(FSComp.SR.tastInvalidFormForPropertySetter(), vref.Id.idRange))
-                    let nameL = layoutMemberName denv vref [] tagProperty vref.DisplayNameCoreMangled
+                    let nameL = layoutMemberName denv vref [] argInfos tagProperty vref.DisplayNameCoreMangled
                     let resL = stat --- nameL --- (WordL.keywordWith ^^ WordL.keywordSet)
                     emptyTyparInst, resL
                 else
+                    let curriedArgInfos = argInfos
                     let argInfos, valueInfo = List.frontAndBack argInfos.Head
                     let prettyTyparInst, niceMethodTypars, tauL = prettyLayoutOfMemberType denv vref typarInst (if isNil argInfos then [] else [argInfos]) (fst valueInfo)
                     let resL =
                         if short then
                             (tauL --- (WordL.keywordWith ^^ WordL.keywordSet))
                         else
-                            let nameL = layoutMemberName denv vref niceMethodTypars tagProperty vref.DisplayNameCoreMangled
+                            let nameL = layoutMemberName denv vref niceMethodTypars curriedArgInfos tagProperty vref.DisplayNameCoreMangled
                             stat --- ((nameL |> addColonL) ^^ (tauL --- (WordL.keywordWith ^^ WordL.keywordSet)))
                     prettyTyparInst, resL
 
@@ -1412,9 +1414,11 @@ module PrintTastMemberOrVals =
         let nameL = mkInlineL denv v nameL
 
         let isOverGeneric = List.length (Zset.elements (freeInType CollectTyparsNoCaching tau).FreeTypars) < List.length tps // Bug: 1143 
-        let isTyFunction = v.IsTypeFunction // Bug: 1143, and innerpoly tests 
+        let isTyFunction = v.IsTypeFunction // Bug: 1143, and innerpoly tests
+        let typarOrderMismatch = isTyparOrderMismatch tps argInfos
+
         let typarBindingsL = 
-            if isTyFunction || isOverGeneric || denv.showTyparBinding then 
+            if isTyFunction || isOverGeneric || denv.showTyparBinding || typarOrderMismatch then 
                 layoutTyparDecls denv nameL true tps 
             else nameL
         let valAndTypeL = (WordL.keywordVal ^^ (typarBindingsL |> addColonL)) --- layoutTopType denv env argInfos retTy cxs

src/Compiler/TypedTree/TypedTreeOps.fs

@@ -10633,3 +10633,32 @@ let updateSeqTypeIsPrefix (fsharpCoreMSpec: ModuleOrNamespace) =
                 )
         )
     )
+
+let isTyparOrderMismatch (tps: Typars) (argInfos: CurriedArgInfos) =
+    let rec getTyparName (ty: TType) : string list =
+        match ty with
+        | TType_var (typar = tp) ->
+            if tp.Id.idText <> unassignedTyparName then
+                [ tp.Id.idText ]
+            else
+                match tp.Solution with
+                | None -> []
+                | Some solutionType -> getTyparName solutionType
+        | TType_fun(domainType, rangeType, _) -> [ yield! getTyparName domainType; yield! getTyparName rangeType ]
+        | TType_anon(tys = ti)
+        | TType_app (typeInstantiation = ti)
+        | TType_tuple (elementTypes = ti) -> List.collect getTyparName ti 
+        | _ -> []
+
+    let typarNamesInArguments =
+        argInfos
+        |> List.collect (fun argInfos ->
+                argInfos
+                |> List.collect (fun (ty, _) -> getTyparName ty))
+        |> List.distinct
+
+    let typarNamesInDefinition =
+        tps |> List.map (fun (tp: Typar) -> tp.Id.idText) |> List.distinct
+
+    typarNamesInArguments.Length = typarNamesInDefinition.Length
+    && typarNamesInArguments <> typarNamesInDefinition

src/Compiler/TypedTree/TypedTreeOps.fsi

@@ -2705,3 +2705,8 @@ val serializeEntity: path: string -> entity: Entity -> unit
 /// Updates the IsPrefixDisplay to false for the Microsoft.FSharp.Collections.seq`1 entity
 /// Meant to be called with the FSharp.Core module spec right after it was unpickled.
 val updateSeqTypeIsPrefix: fsharpCoreMSpec: ModuleOrNamespace -> unit
+
+/// Check if the order of defined typars is different from the order of used typars in the curried arguments.
+/// If this is the case, a generated signature would require explicit typars.
+/// See https://github.com/dotnet/fsharp/issues/15175
+val isTyparOrderMismatch: Typars -> CurriedArgInfos -> bool

tests/FSharp.Compiler.ComponentTests/Signatures/TestCasesForGenerationRoundTrip/generic-parameter-order.fsx

@@ -0,0 +1,31 @@
+module OrderMatters
+
+let f<'a, 'b> (x: 'b) (y: 'a) = ()
+
+type T() =
+    member this.i<'a, 'b> (x: 'b) (y: 'a) = printfn "%A %A" x y
+
+// compound types
+let h1<'a, 'b> (x: 'b * 'a) = ()
+let h2<'a, 'b> (x: 'b -> 'a) = ()
+let h3<'a, 'b> (x: {| F1: 'b; F2: 'a|}) = ()
+let h4<'a, 'b> (x: seq<'b> * array<int * 'a>) = ()
+
+// Avoid duplicate names
+let z<'a, 'z> (z1: 'z) (z2: 'z) (z3: 'a) : 'z = z1
+
+type IMonad<'a> =
+    interface
+        // Hash constraint leads to another type parameter
+        abstract bind : #IMonad<'a> -> ('a -> #IMonad<'b>) -> IMonad<'b>
+    end
+
+open System.Runtime.InteropServices
+
+type A<'zzz>() =
+  // Process the solution of typar as well
+  static member Foo(argA2: 'a, argB2: 'a -> 'b, argC2: 'b -> 'c, argD: 'c -> 'd, [<Optional>] argZ2: 'zzz) : 'd = argD (argC2( argB2 argA2))
+
+type C<'a>() =
+    // The explicit parameters are required here as well.
+    static member SM5<'b,'c>(y:'a,z:'b) = 2

tests/fsharp/typecheck/sigs/neg20.bsl

@@ -131,7 +131,7 @@ neg20.fs(157,28,157,29): typecheck error FS0495: The member or object constructo
 
 neg20.fs(158,13,158,36): typecheck error FS0502: The member or object constructor 'SM4' takes 1 type argument(s) but is here given 2. The required signature is 'static member C.SM4: y: 'a * z: 'b -> int'.
 
-neg20.fs(159,13,159,32): typecheck error FS0502: The member or object constructor 'SM5' takes 2 type argument(s) but is here given 1. The required signature is 'static member C.SM5: y: 'a * z: 'b -> int'.
+neg20.fs(159,13,159,32): typecheck error FS0502: The member or object constructor 'SM5' takes 2 type argument(s) but is here given 1. The required signature is 'static member C.SM5<'b,'c> : y: 'a * z: 'b -> int'.
 
 neg20.fs(162,13,162,24): typecheck error FS0502: The member or object constructor 'M1' takes 0 type argument(s) but is here given 1. The required signature is 'member C.M1: unit -> int'.
 
@@ -143,7 +143,7 @@ neg20.fs(165,27,165,28): typecheck error FS0495: The member or object constructo
 
 neg20.fs(166,13,166,35): typecheck error FS0502: The member or object constructor 'M4' takes 1 type argument(s) but is here given 2. The required signature is 'member C.M4: y: 'a * z: 'b -> int'.
 
-neg20.fs(167,13,167,31): typecheck error FS0502: The member or object constructor 'M5' takes 2 type argument(s) but is here given 1. The required signature is 'member C.M5: y: 'a * z: 'b -> int'.
+neg20.fs(167,13,167,31): typecheck error FS0502: The member or object constructor 'M5' takes 2 type argument(s) but is here given 1. The required signature is 'member C.M5<'b,'c> : y: 'a * z: 'b -> int'.
 
 neg20.fs(182,14,182,31): typecheck error FS0041: No overloads match for method 'M'.
 

tests/fsharp/typecheck/sigs/version50/neg20.bsl

@@ -181,7 +181,7 @@ neg20.fs(157,28,157,29): typecheck error FS0495: The member or object constructo
 
 neg20.fs(158,13,158,36): typecheck error FS0502: The member or object constructor 'SM4' takes 1 type argument(s) but is here given 2. The required signature is 'static member C.SM4: y: 'a * z: 'b -> int'.
 
-neg20.fs(159,13,159,32): typecheck error FS0502: The member or object constructor 'SM5' takes 2 type argument(s) but is here given 1. The required signature is 'static member C.SM5: y: 'a * z: 'b -> int'.
+neg20.fs(159,13,159,32): typecheck error FS0502: The member or object constructor 'SM5' takes 2 type argument(s) but is here given 1. The required signature is 'static member C.SM5<'b,'c> : y: 'a * z: 'b -> int'.
 
 neg20.fs(162,13,162,24): typecheck error FS0502: The member or object constructor 'M1' takes 0 type argument(s) but is here given 1. The required signature is 'member C.M1: unit -> int'.
 
@@ -193,7 +193,7 @@ neg20.fs(165,27,165,28): typecheck error FS0495: The member or object constructo
 
 neg20.fs(166,13,166,35): typecheck error FS0502: The member or object constructor 'M4' takes 1 type argument(s) but is here given 2. The required signature is 'member C.M4: y: 'a * z: 'b -> int'.
 
-neg20.fs(167,13,167,31): typecheck error FS0502: The member or object constructor 'M5' takes 2 type argument(s) but is here given 1. The required signature is 'member C.M5: y: 'a * z: 'b -> int'.
+neg20.fs(167,13,167,31): typecheck error FS0502: The member or object constructor 'M5' takes 2 type argument(s) but is here given 1. The required signature is 'member C.M5<'b,'c> : y: 'a * z: 'b -> int'.
 
 neg20.fs(182,14,182,31): typecheck error FS0041: No overloads match for method 'M'.
 

vsintegration/tests/FSharp.Editor.Tests/QuickInfoProviderTests.fs

@@ -280,7 +280,7 @@ Full name: Microsoft.FSharp.Core.Operators.(||>)
 'U is float"
                 mkDesc
                     "let res4 = (1.0,[1]) ||> List.fold"
-                    "val fold: folder: ('State -> 'T -> 'State) -> state: 'State -> list: 'T list -> 'State
+                    "val fold<'T,'State> : folder: ('State -> 'T -> 'State) -> state: 'State -> list: 'T list -> 'State
 Full name: Microsoft.FSharp.Collections.List.fold
 'T is int
 'State is float"