Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

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

Merged
merged 6 commits into from
Jun 14, 2023
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
6 changes: 6 additions & 0 deletions src/Compiler/Checking/CheckPatterns.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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, _, _) ->
Expand Down
22 changes: 13 additions & 9 deletions src/Compiler/Checking/NicePrint.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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

Expand All @@ -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
Expand All @@ -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)
Expand All @@ -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

Expand Down Expand Up @@ -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
Expand Down
29 changes: 29 additions & 0 deletions src/Compiler/TypedTree/TypedTreeOps.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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
5 changes: 5 additions & 0 deletions src/Compiler/TypedTree/TypedTreeOps.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -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
Original file line number Diff line number Diff line change
@@ -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
4 changes: 2 additions & 2 deletions tests/fsharp/typecheck/sigs/neg20.bsl
Original file line number Diff line number Diff line change
Expand Up @@ -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'.

Expand All @@ -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'.

Expand Down
4 changes: 2 additions & 2 deletions tests/fsharp/typecheck/sigs/version50/neg20.bsl
Original file line number Diff line number Diff line change
Expand Up @@ -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'.

Expand All @@ -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'.

Expand Down
Original file line number Diff line number Diff line change
Expand Up @@ -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"
Expand Down