diff --git a/src/fsharp/CheckDeclarations.fs b/src/fsharp/CheckDeclarations.fs index 14c0aff2831..37f563c8b41 100644 --- a/src/fsharp/CheckDeclarations.fs +++ b/src/fsharp/CheckDeclarations.fs @@ -5876,6 +5876,14 @@ let TypeCheckOneImplFile let extraAttribs = topAttrs.mainMethodAttrs@topAttrs.netModuleAttrs@topAttrs.assemblyAttrs + // Run any additional checks registered to be run before applying defaults + do + for check in cenv.css.GetPostInferenceChecksPreDefaults() do + try + check() + with e -> + errorRecovery e m + conditionallySuppressErrorReporting (checkForErrors()) (fun () -> ApplyDefaults cenv g denvAtEnd m mexpr extraAttribs) @@ -5899,10 +5907,9 @@ let TypeCheckOneImplFile conditionallySuppressErrorReporting (checkForErrors()) (fun () -> CheckModuleSignature g cenv m denvAtEnd rootSigOpt implFileTypePriorToSig implFileSpecPriorToSig mexpr) - // Run any additional checks registered for post-type-inference do conditionallySuppressErrorReporting (checkForErrors()) (fun () -> - for check in cenv.postInferenceChecks do + for check in cenv.css.GetPostInferenceChecksFinal() do try check() with e -> diff --git a/src/fsharp/CheckExpressions.fs b/src/fsharp/CheckExpressions.fs index f966e8e5b60..325217e52af 100644 --- a/src/fsharp/CheckExpressions.fs +++ b/src/fsharp/CheckExpressions.fs @@ -359,9 +359,6 @@ type TcFileState = /// we infer type parameters mutable recUses: ValMultiMap - /// Checks to run after all inference is complete. - mutable postInferenceChecks: ResizeArray unit> - /// Set to true if this file causes the creation of generated provided types. mutable createsGeneratedProvidedTypes: bool @@ -425,7 +422,6 @@ type TcFileState = { g = g amap = amap recUses = ValMultiMap<_>.Empty - postInferenceChecks = ResizeArray() createsGeneratedProvidedTypes = false topCcu = topCcu isScript = isScript @@ -2624,7 +2620,7 @@ let TcValEarlyGeneralizationConsistencyCheck cenv (env: TcEnv) (v: Val, vrec, ti match vrec with | ValInRecScope isComplete when isComplete && not (isNil tinst) -> //printfn "pushing post-inference check for '%s', vty = '%s'" v.DisplayName (DebugPrint.showType vty) - cenv.postInferenceChecks.Add (fun () -> + cenv.css.PushPostInferenceCheck (preDefaults=false, check=fun () -> //printfn "running post-inference check for '%s'" v.DisplayName //printfn "tau = '%s'" (DebugPrint.showType tau) //printfn "vty = '%s'" (DebugPrint.showType vty) @@ -9184,7 +9180,7 @@ and TcMethodApplication CanonicalizePartialInferenceProblem cenv.css denv mItem (unnamedCurriedCallerArgs |> List.collectSquared (fun callerArg -> freeInTypeLeftToRight cenv.g false callerArg.CallerArgumentType)) - let result, errors = ResolveOverloadingForCall denv cenv.css mMethExpr methodName 0 None callerArgs ad postArgumentTypeCheckingCalledMethGroup true (Some returnTy) + let result, errors = ResolveOverloadingForCall denv cenv.css mMethExpr methodName callerArgs ad postArgumentTypeCheckingCalledMethGroup true returnTy match afterResolution, result with | AfterResolution.DoNothing, _ -> () diff --git a/src/fsharp/CheckExpressions.fsi b/src/fsharp/CheckExpressions.fsi index 765ecd35c93..b64b1dfc853 100644 --- a/src/fsharp/CheckExpressions.fsi +++ b/src/fsharp/CheckExpressions.fsi @@ -180,9 +180,6 @@ type TcFileState = /// we infer type parameters mutable recUses: ValMultiMap - /// Checks to run after all inference is complete. - mutable postInferenceChecks: ResizeArray unit> - /// Set to true if this file causes the creation of generated provided types. mutable createsGeneratedProvidedTypes: bool diff --git a/src/fsharp/CompilerDiagnostics.fs b/src/fsharp/CompilerDiagnostics.fs index d0f80e1da0e..d368392468a 100644 --- a/src/fsharp/CompilerDiagnostics.fs +++ b/src/fsharp/CompilerDiagnostics.fs @@ -175,7 +175,6 @@ let GetRangeOfDiagnostic(err: PhasedDiagnostic) = | ConstraintSolverTypesNotInEqualityRelation(_, _, _, m, _, _) | ConstraintSolverError(_, m, _) | ConstraintSolverTypesNotInSubsumptionRelation(_, _, _, m, _) - | ConstraintSolverRelatedInformation(_, m, _) | SelfRefObjCtor(_, m) -> Some m @@ -373,6 +372,7 @@ let IsWarningOrInfoEnabled (err, severity) n level specificWarnOn = match n with | 1182 -> false // chkUnusedValue - off by default | 3180 -> false // abImplicitHeapAllocation - off by default + | 3186 -> false // pickleMissingDefinition - off by default | 3366 -> false //tcIndexNotationDeprecated - currently off by default | 3517 -> false // optFailedToInlineSuggestedValue - off by default | 3388 -> false // tcSubsumptionImplicitConversionUsed - off by default @@ -385,9 +385,6 @@ let IsWarningOrInfoEnabled (err, severity) n level specificWarnOn = let SplitRelatedDiagnostics(err: PhasedDiagnostic) : PhasedDiagnostic * PhasedDiagnostic list = let ToPhased e = {Exception=e; Phase = err.Phase} let rec SplitRelatedException = function - | ConstraintSolverRelatedInformation(fopt, m2, e) -> - let e, related = SplitRelatedException e - ConstraintSolverRelatedInformation(fopt, m2, e.Exception)|>ToPhased, related | ErrorFromAddingTypeEquation(g, denv, t1, t2, e, m) -> let e, related = SplitRelatedException e ErrorFromAddingTypeEquation(g, denv, t1, t2, e.Exception, m)|>ToPhased, related @@ -664,12 +661,6 @@ let OutputPhasedErrorR (os: StringBuilder) (err: PhasedDiagnostic) (canSuggestNa if m.StartLine <> m2.StartLine then os.Append(SeeAlsoE().Format (stringOfRange m2)) |> ignore - | ConstraintSolverRelatedInformation(fopt, _, e) -> - match e with - | ConstraintSolverError _ -> OutputExceptionR os e - | _ -> () - fopt |> Option.iter (Printf.bprintf os " %s") - | ErrorFromAddingTypeEquation(g, denv, t1, t2, ConstraintSolverTypesNotInEqualityRelation(_, t1', t2', m, _, contextInfo), _) when typeEquiv g t1 t1' && typeEquiv g t2 t2' -> diff --git a/src/fsharp/ConstraintSolver.fs b/src/fsharp/ConstraintSolver.fs index d178d9b23a2..a1ee59fa26e 100644 --- a/src/fsharp/ConstraintSolver.fs +++ b/src/fsharp/ConstraintSolver.fs @@ -234,8 +234,6 @@ exception ConstraintSolverMissingConstraint of displayEnv: DisplayEnv * Typar * exception ConstraintSolverError of string * range * range -exception ConstraintSolverRelatedInformation of string option * range * exn - exception ErrorFromApplyingDefault of tcGlobals: TcGlobals * displayEnv: DisplayEnv * Typar * TType * exn * range exception ErrorFromAddingTypeEquation of tcGlobals: TcGlobals * displayEnv: DisplayEnv * actualTy: TType * expectedTy: TType * exn * range @@ -266,6 +264,13 @@ type ConstraintSolverState = /// each outstanding, unsolved, ungeneralized trait constraint. Constraints are removed from the table and resolved /// each time a solution to an index variable is found. mutable ExtraCxs: HashMultiMap + + /// Checks to run after all inference is complete, but before defaults are applied and internal unknowns solved + PostInferenceChecksPreDefaults: ResizeArray unit> + + /// Checks to run after all inference is complete. + PostInferenceChecksFinal: ResizeArray unit> + } static member New(g, amap, infoReader, tcVal) = @@ -273,7 +278,27 @@ type ConstraintSolverState = amap = amap ExtraCxs = HashMultiMap(10, HashIdentity.Structural) InfoReader = infoReader - TcVal = tcVal } + TcVal = tcVal + PostInferenceChecksPreDefaults = ResizeArray() + PostInferenceChecksFinal = ResizeArray() } + + member this.PushPostInferenceCheck (preDefaults, check) = + if preDefaults then + this.PostInferenceChecksPreDefaults.Add check + else + this.PostInferenceChecksFinal.Add check + + member this.PopPostInferenceCheck (preDefaults) = + if preDefaults then + this.PostInferenceChecksPreDefaults.RemoveAt(this.PostInferenceChecksPreDefaults.Count-1) + else + this.PostInferenceChecksFinal.RemoveAt(this.PostInferenceChecksPreDefaults.Count-1) + + member this.GetPostInferenceChecksPreDefaults() = + this.PostInferenceChecksPreDefaults.ToArray() :> seq<_> + + member this.GetPostInferenceChecksFinal() = + this.PostInferenceChecksFinal.ToArray() :> seq<_> type ConstraintSolverEnv = { @@ -281,8 +306,16 @@ type ConstraintSolverEnv = eContextInfo: ContextInfo + // Is this speculative, with a trace allowing undo, and trial method overload resolution + IsSpeculativeForMethodOverloading: bool + + /// Indicates that when unifying ty1 = ty2, only type variables in ty1 may be solved MatchingOnly: bool + /// Indicates that special errors on unresolved SRTP constraint overloads may be generated. When + /// these are caught they result in postponed constraints. + ErrorOnFailedMemberConstraintResolution: bool + m: range EquivEnv: TypeEquivEnv @@ -302,10 +335,11 @@ let MakeConstraintSolverEnv contextInfo css m denv = { SolverState = css m = m eContextInfo = contextInfo - // Indicates that when unifying ty1 = ty2, only type variables in ty1 may be solved MatchingOnly = false + ErrorOnFailedMemberConstraintResolution = false EquivEnv = TypeEquivEnv.Empty - DisplayEnv = denv } + DisplayEnv = denv + IsSpeculativeForMethodOverloading = false } /// Check whether a type variable occurs in the r.h.s. of a type, e.g. to catch /// infinite equations such as @@ -528,12 +562,51 @@ exception NonRigidTypar of displayEnv: DisplayEnv * string option * range * TTyp // However, it seems likely that the abort may result in other processing associated // with an overall constraint being skipped (e.g. the processing related to subsequent elements // of a tuple constraint). -exception AbortForFailedOverloadResolution +exception AbortForFailedMemberConstraintResolution + +/// This is used internally in method overload resolution +let IgnoreFailedMemberConstraintResolution f1 f2 = + TryD + f1 + (function + | AbortForFailedMemberConstraintResolution -> CompleteD + | exn -> f2 exn) /// This is used at (nearly all) entry points into the constraint solver to make sure that the -/// AbortForFailedOverloadResolution is caught and processing continues. -let inline TryD_IgnoreAbortForFailedOverloadResolution f1 f2 = - TryD f1 (function AbortForFailedOverloadResolution -> CompleteD | exn -> f2 exn) +/// AbortForFailedMemberConstraintResolution error result is caught, the constraint recorded +/// as a post-inference check and processing continues. +/// +/// Due to the legacy of the change https://github.com/dotnet/fsharp/pull/1650, some constraint +/// applications must be allowed to "succeed" with partial processing of the unification being +/// left in place, and no error being raised. This happens in cases where SRTP overload +/// resolution has failed. SRTP resolution is delayed and presumably resolved by later type information. +/// +/// Quite a lot of code related to tasks has come to rely on this feature. +/// +/// To ensure soundness, we double-check the constraint at the end of inference +/// with 'ErrorOnFailedMemberConstraintResolution' set to false. +let PostponeOnFailedMemberConstraintResolution (csenv: ConstraintSolverEnv) (trace: OptionalTrace) f1 f2 = + TryD + (fun () -> + let csenv = { csenv with ErrorOnFailedMemberConstraintResolution = true } + f1 csenv) + (function + | AbortForFailedMemberConstraintResolution -> + // Postponed checking of constraints for failed SRTP resolutions is supported from F# 6.0 onwards + // and is required for the "tasks" (aka ResumableStateMachines) feature. + // + // See https://github.com/dotnet/fsharp/issues/12188 + if csenv.g.langVersion.SupportsFeature LanguageFeature.ResumableStateMachines then + trace.Exec + (fun () -> + csenv.SolverState.PushPostInferenceCheck (preDefaults=true, check = fun () -> + let csenv = { csenv with ErrorOnFailedMemberConstraintResolution = false } + f1 csenv |> RaiseOperationResult)) + (fun () -> + csenv.SolverState.PopPostInferenceCheck (preDefaults=true)) + + CompleteD + | exn -> f2 exn) /// used to provide detail about non matched argument in overload resolution error message exception ArgDoesNotMatchError of error: ErrorsFromAddingSubsumptionConstraint * calledMeth: CalledMeth * calledArg: CalledArg * callerArg: CallerArg @@ -1013,6 +1086,10 @@ and SolveTypeEqualsType (csenv: ConstraintSolverEnv) ndeep m2 (trace: OptionalTr let aenv = csenv.EquivEnv let g = csenv.g + // Pre F# 6.0 we asssert the trait solution here +#if TRAIT_CONSTRAINT_CORRECTIONS + if not (csenv.g.langVersion.SupportsFeature LanguageFeature.TraitConstraintCorrections) then +#endif match cxsln with | Some (traitInfo, traitSln) when traitInfo.Solution.IsNone -> // If this is an overload resolution at this point it's safe to assume the candidate member being evaluated solves this member constraint. @@ -1046,6 +1123,7 @@ and SolveTypeEqualsType (csenv: ConstraintSolverEnv) ndeep m2 (trace: OptionalTr | TType_tuple (tupInfo1, l1), TType_tuple (tupInfo2, l2) -> if evalTupInfoIsStruct tupInfo1 <> evalTupInfoIsStruct tupInfo2 then ErrorD (ConstraintSolverError(FSComp.SR.tcTupleStructMismatch(), csenv.m, m2)) else SolveTypeEqualsTypeEqns csenv ndeep m2 trace None l1 l2 + | TType_anon (anonInfo1, l1),TType_anon (anonInfo2, l2) -> SolveAnonInfoEqualsAnonInfo csenv m2 anonInfo1 anonInfo2 ++ (fun () -> SolveTypeEqualsTypeEqns csenv ndeep m2 trace None l1 l2) @@ -1061,7 +1139,6 @@ and SolveTypeEqualsType (csenv: ConstraintSolverEnv) ndeep m2 (trace: OptionalTr | TType_ucase (uc1, l1), TType_ucase (uc2, l2) when g.unionCaseRefEq uc1 uc2 -> SolveTypeEqualsTypeEqns csenv ndeep m2 trace None l1 l2 | _ -> localAbortD - and SolveTypeEqualsTypeKeepAbbrevs csenv ndeep m2 trace ty1 ty2 = SolveTypeEqualsTypeKeepAbbrevsWithCxsln csenv ndeep m2 trace None ty1 ty2 and private SolveTypeEqualsTypeKeepAbbrevsWithCxsln csenv ndeep m2 trace cxsln ty1 ty2 = @@ -1638,8 +1715,12 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload do! AddMemberConstraint csenv ndeep m2 trace traitInfo support frees match errors with - | ErrorResult (_, UnresolvedOverloading _) when not ignoreUnresolvedOverload && (not (nm = "op_Explicit" || nm = "op_Implicit")) -> - return! ErrorD AbortForFailedOverloadResolution + | ErrorResult (_, UnresolvedOverloading _) + when + not ignoreUnresolvedOverload && + csenv.ErrorOnFailedMemberConstraintResolution && + (not (nm = "op_Explicit" || nm = "op_Implicit")) -> + return! ErrorD AbortForFailedMemberConstraintResolution | _ -> return TTraitUnsolved } @@ -2012,7 +2093,6 @@ and AddConstraint (csenv: ConstraintSolverEnv) ndeep m2 trace tp newConstraint () } - and SolveTypeSupportsNull (csenv: ConstraintSolverEnv) ndeep m2 trace ty = let g = csenv.g let m = csenv.m @@ -2103,7 +2183,7 @@ and SolveTypeSupportsEquality (csenv: ConstraintSolverEnv) ndeep m2 trace ty = // Check the (possibly inferred) structural dependencies (tinst, tcref.TyparsNoRange) ||> Iterate2D (fun ty tp -> if tp.EqualityConditionalOn then - SolveTypeSupportsEquality (csenv: ConstraintSolverEnv) ndeep m2 trace ty + SolveTypeSupportsEquality csenv ndeep m2 trace ty else CompleteD) | _ -> @@ -2371,7 +2451,6 @@ and CanMemberSigsMatchUpToCheck subsumeOrConvertArg (CalledArg((-1, 0), false, NotOptional, NoCallerInfo, false, false, Some (mkSynId m name), ReflectedArgInfo.None, calledArgTy)) caller ) - // - Always take the return type into account for resolving overloading of // -- op_Explicit, op_Implicit // -- methods using tupling of unfilled out args @@ -2391,7 +2470,7 @@ and CanMemberSigsMatchUpToCheck return Array.reduce TypeDirectedConversionUsed.Combine [| usesTDC1; usesTDC2; usesTDC3; usesTDC4; usesTDC5; usesTDC6; usesTDC7 |] } -// Assert a subtype constraint, and wrap an ErrorsFromAddingSubsumptionConstraint error around any failure +// Wrap an ErrorsFromAddingSubsumptionConstraint error around any failure // to allow us to report the outer types involved in the constraint // // ty1: expected @@ -2399,27 +2478,43 @@ and CanMemberSigsMatchUpToCheck // // "ty2 casts to ty1" // "a value of type ty2 can be used where a value of type ty1 is expected" -and private SolveTypeSubsumesTypeWithWrappedContextualReport (csenv: ConstraintSolverEnv) ndeep m trace cxsln ty1 ty2 wrapper = - TryD_IgnoreAbortForFailedOverloadResolution - (fun () -> SolveTypeSubsumesTypeKeepAbbrevs csenv ndeep m trace cxsln ty1 ty2) - (fun res -> - match csenv.eContextInfo with - | ContextInfo.RuntimeTypeTest isOperator -> - // test if we can cast other way around - match CollectThenUndo (fun newTrace -> SolveTypeSubsumesTypeKeepAbbrevs csenv ndeep m (OptionalTrace.WithTrace newTrace) cxsln ty2 ty1) with - | OkResult _ -> ErrorD (wrapper (ErrorsFromAddingSubsumptionConstraint(csenv.g, csenv.DisplayEnv, ty1, ty2, res, ContextInfo.DowncastUsedInsteadOfUpcast isOperator, m))) - | _ -> ErrorD (wrapper (ErrorsFromAddingSubsumptionConstraint(csenv.g, csenv.DisplayEnv, ty1, ty2, res, ContextInfo.NoContext, m))) - | _ -> ErrorD (wrapper (ErrorsFromAddingSubsumptionConstraint(csenv.g, csenv.DisplayEnv, ty1, ty2, res, csenv.eContextInfo, m)))) - -and private SolveTypeSubsumesTypeWithReport (csenv: ConstraintSolverEnv) ndeep m trace cxsln ty1 ty2 = +and AddWrappedContextualSubsumptionReport (csenv: ConstraintSolverEnv) ndeep m cxsln ty1 ty2 res wrapper = + match csenv.eContextInfo with + | ContextInfo.RuntimeTypeTest isOperator -> + // test if we can cast other way around + let results = + CollectThenUndo (fun newTrace -> + SolveTypeSubsumesTypeKeepAbbrevs csenv ndeep m (WithTrace newTrace) cxsln ty2 ty1) + match results with + | OkResult _ -> ErrorD (wrapper (ErrorsFromAddingSubsumptionConstraint(csenv.g, csenv.DisplayEnv, ty1, ty2, res, ContextInfo.DowncastUsedInsteadOfUpcast isOperator, m))) + | _ -> ErrorD (wrapper (ErrorsFromAddingSubsumptionConstraint(csenv.g, csenv.DisplayEnv, ty1, ty2, res, ContextInfo.NoContext, m))) + | _ -> ErrorD (wrapper (ErrorsFromAddingSubsumptionConstraint(csenv.g, csenv.DisplayEnv, ty1, ty2, res, csenv.eContextInfo, m))) + +/// Assert a subtype constraint +and SolveTypeSubsumesTypeWithWrappedContextualReport (csenv: ConstraintSolverEnv) ndeep m trace cxsln ty1 ty2 wrapper = + // Due to the legacy of the change https://github.com/dotnet/fsharp/pull/1650, + // when doing nested, speculative overload resolution, we ignore failed member constraints and continue. The + // constraint is not recorded for later solution. + if csenv.IsSpeculativeForMethodOverloading then + IgnoreFailedMemberConstraintResolution + (fun () -> SolveTypeSubsumesTypeKeepAbbrevs csenv ndeep m trace cxsln ty1 ty2) + (fun res -> AddWrappedContextualSubsumptionReport csenv ndeep m cxsln ty1 ty2 res wrapper) + else + PostponeOnFailedMemberConstraintResolution csenv trace + (fun csenv -> SolveTypeSubsumesTypeKeepAbbrevs csenv ndeep m trace cxsln ty1 ty2) + (fun res -> AddWrappedContextualSubsumptionReport csenv ndeep m cxsln ty1 ty2 res wrapper) + +and SolveTypeSubsumesTypeWithReport (csenv: ConstraintSolverEnv) ndeep m trace cxsln ty1 ty2 = SolveTypeSubsumesTypeWithWrappedContextualReport csenv ndeep m trace cxsln ty1 ty2 id - + // ty1: actual // ty2: expected -and private SolveTypeEqualsTypeWithReport (csenv: ConstraintSolverEnv) ndeep m trace cxsln actual expected = - TryD_IgnoreAbortForFailedOverloadResolution +and private SolveTypeEqualsTypeWithReport (csenv: ConstraintSolverEnv) ndeep m trace cxsln actual expected = + TryD (fun () -> SolveTypeEqualsTypeKeepAbbrevsWithCxsln csenv ndeep m trace cxsln actual expected) - (fun res -> ErrorD (ErrorFromAddingTypeEquation(csenv.g, csenv.DisplayEnv, actual, expected, res, m))) + (function + | AbortForFailedMemberConstraintResolution as err -> ErrorD err + | res -> ErrorD (ErrorFromAddingTypeEquation(csenv.g, csenv.DisplayEnv, actual, expected, res, m))) and ArgsMustSubsumeOrConvert (csenv: ConstraintSolverEnv) @@ -2646,6 +2741,31 @@ and ReportNoCandidatesErrorSynExpr csenv callerArgCounts methodName ad calledMet let isSequential e = match e with | SynExpr.Sequential _ -> true | _ -> false ReportNoCandidatesError csenv callerArgCounts methodName ad calledMethGroup isSequential +/// When checking whether a method solves a trait constraint, we can assume the trait is solved +/// by that method for the purposes of further type checking (just as we assume a type equation +/// for the purposes of checking constraints arising from that type equation). +/// +/// In F# 5.0 and 6.0 we assert this late by passing the cxsln parameter around. However this +/// relies on not checking return types for SRTP constraints eagerly +/// +/// Post F# 6.0 (TraitConstraintCorrections) we will assert this early and add a proper check that return types match for SRTP constraint solving +/// (see alwaysCheckReturn) +and AssumeMethodSolvesTrait (csenv: ConstraintSolverEnv) (cx: TraitConstraintInfo option) m trace (calledMeth: CalledMeth<_>) = + match cx with + | Some traitInfo when traitInfo.Solution.IsNone -> + let traitSln = MemberConstraintSolutionOfMethInfo csenv.SolverState m calledMeth.Method calledMeth.CalledTyArgs +#if TRAIT_CONSTRAINT_CORRECTIONS + if csenv.g.langVersion.SupportsFeature LanguageFeature.TraitConstraintCorrections then + TransactMemberConstraintSolution traitInfo trace traitSln + None + else +#else + ignore trace +#endif + Some (traitInfo, traitSln) + | _ -> + None + // Resolve the overloading of a method // This is used after analyzing the types of arguments and ResolveOverloading @@ -2682,10 +2802,16 @@ and ResolveOverloading | _, _ -> - // - Always take the return type into account for - // -- op_Explicit, op_Implicit - // -- candidate method sets that potentially use tupling of unfilled out args - let alwaysCheckReturn = isOpConversion || candidates |> List.exists (fun cmeth -> cmeth.HasOutArgs) + // Always take the return type into account for + // -- op_Explicit, op_Implicit + // -- candidate method sets that potentially use tupling of unfilled out args + /// -- if TraitConstraintCorrections is enabled, also check return types for SRTP constraints + let alwaysCheckReturn = + isOpConversion || + candidates |> List.exists (fun cmeth -> cmeth.HasOutArgs) +#if TRAIT_CONSTRAINT_CORRECTIONS + || (csenv.g.langVersion.SupportsFeature LanguageFeature.TraitConstraintCorrections && cx.IsSome) +#endif // Exact match rule. // @@ -2693,7 +2819,8 @@ and ResolveOverloading // and exact matches of argument types. let exactMatchCandidates = candidates |> FilterEachThenUndo (fun newTrace calledMeth -> - let cxsln = Option.map (fun traitInfo -> (traitInfo, MemberConstraintSolutionOfMethInfo csenv.SolverState m calledMeth.Method calledMeth.CalledTyArgs)) cx + let csenv = { csenv with IsSpeculativeForMethodOverloading = true } + let cxsln = AssumeMethodSolvesTrait csenv cx m (WithTrace newTrace) calledMeth CanMemberSigsMatchUpToCheck csenv permitOptArgs @@ -2714,7 +2841,8 @@ and ResolveOverloading // Subsumption on arguments is allowed. let applicable = candidates |> FilterEachThenUndo (fun newTrace candidate -> - let cxsln = Option.map (fun traitInfo -> (traitInfo, MemberConstraintSolutionOfMethInfo csenv.SolverState m candidate.Method candidate.CalledTyArgs)) cx + let csenv = { csenv with IsSpeculativeForMethodOverloading = true } + let cxsln = AssumeMethodSolvesTrait csenv cx m (WithTrace newTrace) candidate CanMemberSigsMatchUpToCheck csenv permitOptArgs @@ -2751,7 +2879,8 @@ and ResolveOverloading candidates |> List.choose (fun calledMeth -> match CollectThenUndo (fun newTrace -> - let cxsln = Option.map (fun traitInfo -> (traitInfo, MemberConstraintSolutionOfMethInfo csenv.SolverState m calledMeth.Method calledMeth.CalledTyArgs)) cx + let csenv = { csenv with IsSpeculativeForMethodOverloading = true } + let cxsln = AssumeMethodSolvesTrait csenv cx m (WithTrace newTrace) calledMeth CanMemberSigsMatchUpToCheck csenv permitOptArgs @@ -2785,7 +2914,7 @@ and ResolveOverloading /// Compare types under the feasibly-subsumes ordering let compareTypes ty1 ty2 = (ty1, ty2) ||> compareCond (fun x1 x2 -> TypeFeasiblySubsumesType ndeep csenv.g csenv.amap m x2 CanCoerce x1) - + /// Compare arguments under the feasibly-subsumes ordering and the adhoc Func-is-better-than-other-delegates rule let compareArg (calledArg1: CalledArg) (calledArg2: CalledArg) = let c = compareTypes calledArg1.CalledArgumentType calledArg2.CalledArgumentType @@ -2813,7 +2942,7 @@ and ResolveOverloading true | _ -> false) - + if c <> 0 then c else 0 @@ -2830,7 +2959,7 @@ and ResolveOverloading // Note: Relies on 'compare' respecting true > false let c = compare (candidateWarnCount = 0) (otherWarnCount = 0) if c <> 0 then c else - + // Prefer methods that don't use param array arg // Note: Relies on 'compare' respecting true > false let c = compare (not candidate.UsesParamArrayConversion) (not other.UsesParamArrayConversion) @@ -2843,7 +2972,7 @@ and ResolveOverloading else 0 if c <> 0 then c else - + // Prefer methods that don't use out args // Note: Relies on 'compare' respecting true > false let c = compare (not candidate.HasOutArgs) (not other.HasOutArgs) @@ -2899,7 +3028,7 @@ and ResolveOverloading // Note: Relies on 'compare' respecting true > false let c = compare candidate.CalledTyArgs.IsEmpty other.CalledTyArgs.IsEmpty if c <> 0 then c else - + // F# 5.0 rule - prior to F# 5.0 named arguments (on the caller side) were not being taken // into account when comparing overloads. So adding a name to an argument might mean // overloads ould no longer be distinguished. We thus look at *all* arguments (whether @@ -2947,7 +3076,6 @@ and ResolveOverloading | [] -> yield { methodSlot = methodSlot; error = Unchecked.defaultof; infoReader = infoReader } | errors -> for error in errors do yield { methodSlot = methodSlot; error = error; infoReader = infoReader } ] - // use the most precise set // - if after filtering bestMethods still contains something - use it // - otherwise use applicableMeths or initial set of candidate methods @@ -2976,7 +3104,7 @@ and ResolveOverloading calledMethOpt, trackErrors { do! errors - let cxsln = Option.map (fun traitInfo -> (traitInfo, MemberConstraintSolutionOfMethInfo csenv.SolverState m calledMeth.Method calledMeth.CalledTyArgs)) cx + let cxsln = AssumeMethodSolvesTrait csenv cx m trace calledMeth match calledMethTrace with | NoTrace -> let! _usesTDC = @@ -3017,9 +3145,9 @@ and ResolveOverloading | None -> None, errors -let ResolveOverloadingForCall denv css m methodName ndeep cx callerArgs ad calledMethGroup permitOptArgs reqdRetTyOpt = +let ResolveOverloadingForCall denv css m methodName callerArgs ad calledMethGroup permitOptArgs reqdRetTy = let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv - ResolveOverloading csenv NoTrace methodName ndeep cx callerArgs ad calledMethGroup permitOptArgs reqdRetTyOpt + ResolveOverloading csenv NoTrace methodName 0 None callerArgs ad calledMethGroup permitOptArgs (Some reqdRetTy) /// This is used before analyzing the types of arguments in a single overload resolution let UnifyUniqueOverloading @@ -3085,7 +3213,9 @@ let EliminateConstraintsForGeneralizedTypars denv css m (trace: OptionalTrace) ( let AddCxTypeEqualsType contextInfo denv css m actual expected = let csenv = MakeConstraintSolverEnv contextInfo css m denv - SolveTypeEqualsTypeWithReport csenv 0 m NoTrace None actual expected + PostponeOnFailedMemberConstraintResolution csenv NoTrace + (fun csenv -> SolveTypeEqualsTypeWithReport csenv 0 m NoTrace None actual expected) + ErrorD |> RaiseOperationResult let UndoIfFailed f = @@ -3122,26 +3252,32 @@ let UndoIfFailedOrWarnings f = let AddCxTypeEqualsTypeUndoIfFailed denv css m ty1 ty2 = UndoIfFailed (fun trace -> let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv + let csenv = { csenv with ErrorOnFailedMemberConstraintResolution = true } SolveTypeEqualsTypeKeepAbbrevs csenv 0 m (WithTrace trace) ty1 ty2) let AddCxTypeEqualsTypeUndoIfFailedOrWarnings denv css m ty1 ty2 = UndoIfFailedOrWarnings (fun trace -> let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv + let csenv = { csenv with ErrorOnFailedMemberConstraintResolution = true } SolveTypeEqualsTypeKeepAbbrevs csenv 0 m (WithTrace trace) ty1 ty2) let AddCxTypeEqualsTypeMatchingOnlyUndoIfFailed denv css m ty1 ty2 = - let csenv = { MakeConstraintSolverEnv ContextInfo.NoContext css m denv with MatchingOnly = true } - UndoIfFailed (fun trace -> SolveTypeEqualsTypeKeepAbbrevs csenv 0 m (WithTrace trace) ty1 ty2) + UndoIfFailed (fun trace -> + let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv + let csenv = { csenv with MatchingOnly = true; ErrorOnFailedMemberConstraintResolution = true } + SolveTypeEqualsTypeKeepAbbrevs csenv 0 m (WithTrace trace) ty1 ty2) let AddCxTypeMustSubsumeTypeUndoIfFailed denv css m ty1 ty2 = UndoIfFailed (fun trace -> let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv + let csenv = { csenv with ErrorOnFailedMemberConstraintResolution = true } SolveTypeSubsumesTypeKeepAbbrevs csenv 0 m (WithTrace trace) None ty1 ty2) let AddCxTypeMustSubsumeTypeMatchingOnlyUndoIfFailed denv css m ty1 ty2 = - let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv - let csenv = { csenv with MatchingOnly = true } - UndoIfFailed (fun trace -> SolveTypeSubsumesTypeKeepAbbrevs csenv 0 m (WithTrace trace) None ty1 ty2) + UndoIfFailed (fun trace -> + let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv + let csenv = { csenv with MatchingOnly = true; ErrorOnFailedMemberConstraintResolution = true } + SolveTypeSubsumesTypeKeepAbbrevs csenv 0 m (WithTrace trace) None ty1 ty2) let AddCxTypeMustSubsumeType contextInfo denv css m trace ty1 ty2 = let csenv = MakeConstraintSolverEnv contextInfo css m denv @@ -3150,8 +3286,8 @@ let AddCxTypeMustSubsumeType contextInfo denv css m trace ty1 ty2 = let AddCxMethodConstraint denv css m trace traitInfo = let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv - TryD_IgnoreAbortForFailedOverloadResolution - (fun () -> + PostponeOnFailedMemberConstraintResolution csenv trace + (fun csenv -> trackErrors { do! SolveMemberConstraint csenv true PermitWeakResolution.No 0 m trace traitInfo @@ -3162,71 +3298,71 @@ let AddCxMethodConstraint denv css m trace traitInfo = let AddCxTypeMustSupportNull denv css m trace ty = let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv - TryD_IgnoreAbortForFailedOverloadResolution - (fun () -> SolveTypeSupportsNull csenv 0 m trace ty) + PostponeOnFailedMemberConstraintResolution csenv trace + (fun csenv -> SolveTypeSupportsNull csenv 0 m trace ty) (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) |> RaiseOperationResult let AddCxTypeMustSupportComparison denv css m trace ty = let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv - TryD_IgnoreAbortForFailedOverloadResolution - (fun () -> SolveTypeSupportsComparison csenv 0 m trace ty) + PostponeOnFailedMemberConstraintResolution csenv trace + (fun csenv -> SolveTypeSupportsComparison csenv 0 m trace ty) (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) |> RaiseOperationResult let AddCxTypeMustSupportEquality denv css m trace ty = let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv - TryD_IgnoreAbortForFailedOverloadResolution - (fun () -> SolveTypeSupportsEquality csenv 0 m trace ty) + PostponeOnFailedMemberConstraintResolution csenv trace + (fun csenv -> SolveTypeSupportsEquality csenv 0 m trace ty) (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) |> RaiseOperationResult let AddCxTypeMustSupportDefaultCtor denv css m trace ty = let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv - TryD_IgnoreAbortForFailedOverloadResolution - (fun () -> SolveTypeRequiresDefaultConstructor csenv 0 m trace ty) + PostponeOnFailedMemberConstraintResolution csenv trace + (fun csenv -> SolveTypeRequiresDefaultConstructor csenv 0 m trace ty) (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) |> RaiseOperationResult let AddCxTypeIsReferenceType denv css m trace ty = let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv - TryD_IgnoreAbortForFailedOverloadResolution - (fun () -> SolveTypeIsReferenceType csenv 0 m trace ty) + PostponeOnFailedMemberConstraintResolution csenv trace + (fun csenv -> SolveTypeIsReferenceType csenv 0 m trace ty) (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) |> RaiseOperationResult let AddCxTypeIsValueType denv css m trace ty = let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv - TryD_IgnoreAbortForFailedOverloadResolution - (fun () -> SolveTypeIsNonNullableValueType csenv 0 m trace ty) + PostponeOnFailedMemberConstraintResolution csenv trace + (fun csenv -> SolveTypeIsNonNullableValueType csenv 0 m trace ty) (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) |> RaiseOperationResult let AddCxTypeIsUnmanaged denv css m trace ty = let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv - TryD_IgnoreAbortForFailedOverloadResolution - (fun () -> SolveTypeIsUnmanaged csenv 0 m trace ty) + PostponeOnFailedMemberConstraintResolution csenv trace + (fun csenv -> SolveTypeIsUnmanaged csenv 0 m trace ty) (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) |> RaiseOperationResult let AddCxTypeIsEnum denv css m trace ty underlying = let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv - TryD_IgnoreAbortForFailedOverloadResolution - (fun () -> SolveTypeIsEnum csenv 0 m trace ty underlying) + PostponeOnFailedMemberConstraintResolution csenv trace + (fun csenv -> SolveTypeIsEnum csenv 0 m trace ty underlying) (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) |> RaiseOperationResult let AddCxTypeIsDelegate denv css m trace ty aty bty = let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv - TryD_IgnoreAbortForFailedOverloadResolution - (fun () -> SolveTypeIsDelegate csenv 0 m trace ty aty bty) + PostponeOnFailedMemberConstraintResolution csenv trace + (fun csenv -> SolveTypeIsDelegate csenv 0 m trace ty aty bty) (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) |> RaiseOperationResult let AddCxTyparDefaultsTo denv css m ctxtInfo tp ridx ty = let csenv = MakeConstraintSolverEnv ctxtInfo css m denv - TryD_IgnoreAbortForFailedOverloadResolution - (fun () -> AddConstraint csenv 0 m NoTrace tp (TyparConstraint.DefaultsTo(ridx, ty, m))) + PostponeOnFailedMemberConstraintResolution csenv NoTrace + (fun csenv -> AddConstraint csenv 0 m NoTrace tp (TyparConstraint.DefaultsTo(ridx, ty, m))) (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) |> RaiseOperationResult @@ -3243,8 +3379,8 @@ let ApplyTyparDefaultAtPriority denv css priority (tp: Typar) = let ty1 = mkTyparTy tp if not tp.IsSolved && not (typeEquiv css.g ty1 ty2) then let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv - TryD_IgnoreAbortForFailedOverloadResolution - (fun () -> + PostponeOnFailedMemberConstraintResolution csenv NoTrace + (fun csenv -> SolveTyparEqualsType csenv 0 m NoTrace ty1 ty2) (fun res -> SolveTypeAsError denv css m ty1 @@ -3257,7 +3393,9 @@ let CreateCodegenState tcVal g amap = amap = amap TcVal = tcVal ExtraCxs = HashMultiMap(10, HashIdentity.Structural) - InfoReader = InfoReader(g, amap) } + InfoReader = InfoReader(g, amap) + PostInferenceChecksPreDefaults = ResizeArray() + PostInferenceChecksFinal = ResizeArray() } /// Generate a witness expression if none is otherwise available, e.g. in legacy non-witness-passing code let CodegenWitnessExprForTraitConstraint tcVal g amap m (traitInfo:TraitConstraintInfo) argExprs = trackErrors { @@ -3293,17 +3431,17 @@ let ChooseTyparSolutionAndSolve css denv tp = let amap = css.amap let max, m = ChooseTyparSolutionAndRange g amap tp let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv - TryD_IgnoreAbortForFailedOverloadResolution - (fun () -> SolveTyparEqualsType csenv 0 m NoTrace (mkTyparTy tp) max) + PostponeOnFailedMemberConstraintResolution csenv NoTrace + (fun csenv -> SolveTyparEqualsType csenv 0 m NoTrace (mkTyparTy tp) max) (fun err -> ErrorD(ErrorFromApplyingDefault(g, denv, tp, max, err, m))) |> RaiseOperationResult let CheckDeclaredTypars denv css m typars1 typars2 = let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv - TryD_IgnoreAbortForFailedOverloadResolution - (fun () -> - CollectThenUndo (fun trace -> - SolveTypeEqualsTypeEqns csenv 0 m (WithTrace trace) None + PostponeOnFailedMemberConstraintResolution csenv NoTrace + (fun csenv -> + CollectThenUndo (fun newTrace -> + SolveTypeEqualsTypeEqns csenv 0 m (WithTrace newTrace) None (List.map mkTyparTy typars1) (List.map mkTyparTy typars2))) (fun res -> @@ -3313,7 +3451,8 @@ let CheckDeclaredTypars denv css m typars1 typars2 = let CanonicalizePartialInferenceProblem css denv m tps = // Canonicalize constraints prior to generalization let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv - TryD_IgnoreAbortForFailedOverloadResolution + let csenv = { csenv with ErrorOnFailedMemberConstraintResolution = true } + IgnoreFailedMemberConstraintResolution (fun () -> CanonicalizeRelevantMemberConstraints csenv 0 NoTrace tps) (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) |> RaiseOperationResult @@ -3330,7 +3469,9 @@ let IsApplicableMethApprox g amap m (minfo: MethInfo) availObjTy = amap = amap TcVal = (fun _ -> failwith "should not be called") ExtraCxs = HashMultiMap(10, HashIdentity.Structural) - InfoReader = InfoReader(g, amap) } + InfoReader = InfoReader(g, amap) + PostInferenceChecksPreDefaults = ResizeArray() + PostInferenceChecksFinal = ResizeArray() } let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m (DisplayEnv.Empty g) let minst = FreshenMethInfo m minfo match minfo.GetObjArgTypes(amap, m, minst) with diff --git a/src/fsharp/ConstraintSolver.fsi b/src/fsharp/ConstraintSolver.fsi index dee696470e5..e960daa8f6e 100644 --- a/src/fsharp/ConstraintSolver.fsi +++ b/src/fsharp/ConstraintSolver.fsi @@ -123,7 +123,6 @@ exception ConstraintSolverTypesNotInEqualityRelation of displayEnv: DisplayEn exception ConstraintSolverTypesNotInSubsumptionRelation of displayEnv: DisplayEnv * argTy: TType * paramTy: TType * callRange: range * parameterRange: range exception ConstraintSolverMissingConstraint of displayEnv: DisplayEnv * Typar * TyparConstraint * range * range exception ConstraintSolverError of string * range * range -exception ConstraintSolverRelatedInformation of string option * range * exn exception ErrorFromApplyingDefault of tcGlobals: TcGlobals * displayEnv: DisplayEnv * Typar * TType * exn * range exception ErrorFromAddingTypeEquation of tcGlobals: TcGlobals * displayEnv: DisplayEnv * actualTy: TType * expectedTy: TType * exn * range @@ -141,6 +140,15 @@ type TcValF = ValRef -> ValUseFlag -> TType list -> range -> Expr * TType type ConstraintSolverState = static member New: TcGlobals * ImportMap * InfoReader * TcValF -> ConstraintSolverState + /// Add a post-inference check to run at the end of inference + member PushPostInferenceCheck: preDefaults: bool * check: (unit -> unit) -> unit + + /// Get the post-inference checks to run near the end of inference, but before defaults are applied + member GetPostInferenceChecksPreDefaults: unit -> seq unit> + + /// Get the post-inference checks to run at the end of inference + member GetPostInferenceChecksFinal: unit -> seq unit> + val BakedInTraitConstraintNames: Set [] @@ -152,7 +160,8 @@ type OptionalTrace = val SimplifyMeasuresInTypeScheme: TcGlobals -> bool -> Typars -> TType -> TyparConstraint list -> Typars -val ResolveOverloadingForCall: DisplayEnv -> ConstraintSolverState -> range -> methodName: string -> ndeep: int -> cx: TraitConstraintInfo option -> callerArgs: CallerArgs -> AccessorDomain -> calledMethGroup: CalledMeth list -> permitOptArgs: bool -> reqdRetTyOpt: OverallTy option -> CalledMeth option * OperationResult +/// The entry point to resolve the overloading for an entire call +val ResolveOverloadingForCall: DisplayEnv -> ConstraintSolverState -> range -> methodName: string -> callerArgs: CallerArgs -> AccessorDomain -> calledMethGroup: CalledMeth list -> permitOptArgs: bool -> reqdRetTy: OverallTy -> CalledMeth option * OperationResult val UnifyUniqueOverloading: DisplayEnv -> ConstraintSolverState -> range -> int * int -> string -> AccessorDomain -> CalledMeth list -> OverallTy -> OperationResult diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs index 6881f8d43f2..a8c0c0285cd 100644 --- a/src/fsharp/IlxGen.fs +++ b/src/fsharp/IlxGen.fs @@ -395,13 +395,15 @@ let ComputeTypeAccess (tref: ILTypeRef) hidden = /// Indicates how type parameters are mapped to IL type variables [] -type TypeReprEnv(reprs: Map, count: int, templateReplacement: (TyconRef * ILType * TyparInst) option) = +type TypeReprEnv(reprs: Map, count: int, templateReplacement: (TyconRef * ILTypeRef * Typars * TyparInst) option) = static let empty = TypeReprEnv(count = 0, reprs = Map.empty, templateReplacement = None) + /// Get the template replacement information used when using struct types for state machines based on a "template" struct member __.TemplateReplacement = templateReplacement - member __.WithTemplateReplacement(tcref, ilty, tpinst) = TypeReprEnv(reprs, count, Some (tcref, ilty, tpinst)) + member __.WithTemplateReplacement(tcref, ilCloTyRef, cloFreeTyvars, templateTypeInst) = + TypeReprEnv(reprs, count, Some (tcref, ilCloTyRef, cloFreeTyvars, templateTypeInst)) /// Lookup a type parameter member _.Item (tp: Typar, m: range) = @@ -514,7 +516,10 @@ and GenILTyAppAux amap m tyenv (tref, boxity, ilTypeOpt) tinst = and GenNamedTyAppAux (amap: ImportMap) m (tyenv: TypeReprEnv) ptrsOK tcref tinst = let g = amap.g match tyenv.TemplateReplacement with - | Some (tcref2, ilty, _) when tyconRefEq g tcref tcref2 -> ilty + | Some (tcref2, ilCloTyRef, cloFreeTyvars, _) when tyconRefEq g tcref tcref2 -> + let cloInst = List.map mkTyparTy cloFreeTyvars + let ilTypeInst = GenTypeArgsAux amap m tyenv cloInst + mkILValueTy ilCloTyRef ilTypeInst | _ -> let tinst = DropErasedTyargs tinst // See above note on ptrsOK @@ -685,11 +690,25 @@ let GenFieldSpecForStaticField (isInteractive, g, ilContainerTy, vspec: Val, nm, let GenRecdFieldRef m cenv (tyenv: TypeReprEnv) (rfref: RecdFieldRef) tyargs = // Fixup references to the fields of a struct machine template + // templateStructTy = ResumableStateMachine + // templateTyconRef = ResumableStateMachine<'Data> + // templateTypeArgs = + // templateTypeInst = 'Data -> TaskStateMachineData + // cloFreeTyvars = <'FreeTyVars> + // ilCloTy = clo<'FreeTyVars> w.r.t envinner + // rfref = ResumableStateMachine<'Data>::Result + // rfref.RecdField.FormalType = 'Data match tyenv.TemplateReplacement with - | Some (tcref2, ilty, inst) when tyconRefEq cenv.g rfref.TyconRef tcref2 -> - mkILFieldSpecInTy(ilty, + | Some (tcref2, ilCloTyRef, cloFreeTyvars, templateTypeInst) when tyconRefEq cenv.g rfref.TyconRef tcref2 -> + let ilCloTy = + let cloInst = List.map mkTyparTy cloFreeTyvars + let ilTypeInst = GenTypeArgsAux cenv.amap m tyenv cloInst + mkILValueTy ilCloTyRef ilTypeInst + + let tyenvinner = TypeReprEnv.Empty.ForTypars cloFreeTyvars + mkILFieldSpecInTy(ilCloTy, ComputeFieldName rfref.Tycon rfref.RecdField, - GenType cenv.amap m tyenv (instType inst rfref.RecdField.FormalType)) + GenType cenv.amap m tyenvinner (instType templateTypeInst rfref.RecdField.FormalType)) | _ -> let tyenvinner = TypeReprEnv.Empty.ForTycon rfref.Tycon let ilty = GenTyApp cenv.amap m tyenv rfref.TyconRef.CompiledRepresentation tyargs @@ -1094,8 +1113,8 @@ let AddStorageForVal (g: TcGlobals) (v, s) eenv = let AddStorageForLocalVals g vals eenv = List.foldBack (fun (v, s) acc -> AddStorageForVal g (v, notlazy s) acc) vals eenv -let AddTemplateReplacement eenv (tcref, ilty, inst) = - { eenv with tyenv = eenv.tyenv.WithTemplateReplacement (tcref, ilty, inst) } +let AddTemplateReplacement eenv (tcref, ftyvs, ilty, inst) = + { eenv with tyenv = eenv.tyenv.WithTemplateReplacement (tcref, ftyvs, ilty, inst) } let AddStorageForLocalWitness eenv (w,s) = { eenv with witnessesInScope = eenv.witnessesInScope.SetItem (w, s) } @@ -4833,7 +4852,8 @@ and GenStructStateMachine cenv cgbuf eenvouter (res: LoweredStateMachine) sequel let templateTyconRef, templateTypeArgs = destAppTy g templateStructTy let templateTypeInst = mkTyconRefInst templateTyconRef templateTypeArgs - let eenvinner = AddTemplateReplacement eenvinner (templateTyconRef, ilCloTy, templateTypeInst) + let eenvinner = + AddTemplateReplacement eenvinner (templateTyconRef, ilCloTypeRef, cloinfo.cloFreeTyvars, templateTypeInst) let infoReader = InfoReader.InfoReader(g, cenv.amap) @@ -4949,13 +4969,15 @@ and GenStructStateMachine cenv cgbuf eenvouter (res: LoweredStateMachine) sequel CountClosure() LocalScope "machine" cgbuf (fun scopeMarks -> + let eenvouter = AddTemplateReplacement eenvouter (templateTyconRef, ilCloTypeRef, cloinfo.cloFreeTyvars, templateTypeInst) let ilMachineAddrTy = ILType.Byref ilCloTy // The local for the state machine - let locIdx, realloc, _ = AllocLocal cenv cgbuf eenvinner true (g.CompilerGlobalState.Value.IlxGenNiceNameGenerator.FreshCompilerGeneratedName ("machine", m), ilCloTy, false) scopeMarks + let locIdx, realloc, _ = AllocLocal cenv cgbuf eenvouter true (g.CompilerGlobalState.Value.IlxGenNiceNameGenerator.FreshCompilerGeneratedName ("machine", m), ilCloTy, false) scopeMarks // The local for the state machine address - let locIdx2, _realloc2, _ = AllocLocal cenv cgbuf eenvinner true (g.CompilerGlobalState.Value.IlxGenNiceNameGenerator.FreshCompilerGeneratedName (afterCodeThisVar.DisplayName, m), ilMachineAddrTy, false) scopeMarks + let locIdx2, _realloc2, _ = AllocLocal cenv cgbuf eenvouter true (g.CompilerGlobalState.Value.IlxGenNiceNameGenerator.FreshCompilerGeneratedName (afterCodeThisVar.DisplayName, m), ilMachineAddrTy, false) scopeMarks + let eenvouter = eenvouter |> AddStorageForLocalVals g [(afterCodeThisVar, Local (locIdx2, realloc, None)) ] // Zero-initialize the machine EmitInitLocal cgbuf ilCloTy locIdx @@ -4964,8 +4986,6 @@ and GenStructStateMachine cenv cgbuf eenvouter (res: LoweredStateMachine) sequel CG.EmitInstr cgbuf (pop 0) (Push [ ilMachineAddrTy ]) (I_ldloca (uint16 locIdx) ) CG.EmitInstr cgbuf (pop 1) (Push [ ]) (I_stloc (uint16 locIdx2) ) - let eenvinner = eenvinner |> AddStorageForLocalVals g [(afterCodeThisVar, Local (locIdx2, realloc, None)) ] - // Initialize the closure variables for fv, ilv in Seq.zip cloFreeVars cloinfo.ilCloAllFreeVars do if stateVarsSet.Contains fv then @@ -4980,8 +5000,8 @@ and GenStructStateMachine cenv cgbuf eenvouter (res: LoweredStateMachine) sequel GenGetLocalVal cenv cgbuf eenvouter m fv None CG.EmitInstr cgbuf (pop 2) (Push [ ]) (mkNormalStfld (mkILFieldSpecInTy (ilCloTy, ilv.fvName, ilv.fvType))) - // Generate the start expression - eenvinner is used as it contains the binding for machineAddrVar - GenExpr cenv cgbuf eenvinner SPSuppress afterCodeBody sequel + // Generate the start expression + GenExpr cenv cgbuf eenvouter SPSuppress afterCodeBody sequel ) diff --git a/tests/fsharp/Compiler/CodeGen/EmittedIL/TaskGeneratedCode.fs b/tests/fsharp/Compiler/CodeGen/EmittedIL/TaskGeneratedCode.fs index d75e1849213..b956480ef58 100644 --- a/tests/fsharp/Compiler/CodeGen/EmittedIL/TaskGeneratedCode.fs +++ b/tests/fsharp/Compiler/CodeGen/EmittedIL/TaskGeneratedCode.fs @@ -1059,6 +1059,272 @@ let testTask() = task { while x > 4 do System.Console.WriteLine("loop") } #endif +module TaskTypeInference = + // This tests the compilation of a case that hits corner cases in SRTP constraint processing. + // See https://github.com/dotnet/fsharp/issues/12188 + [] + let ``check initially ambiguous SRTP task code ``() = + CompilerAssert.CompileExeAndRunWithOptions [| "/langversion:preview";"/optimize-";"/debug:portable";"/tailcalls-" |] + """ +module Test + +open System.Threading.Tasks + +let myFunction (f: string -> _, _i: 'T) = + task { + do! f "" + return () + } + +let myTuple : (string -> Task) * int = (fun (_s: string) -> Task.FromResult()), 1 +(myFunction myTuple).Wait() + """ + + // Test task code in generic position + [] + let ``check generic task code ``() = + CompilerAssert.CompileExeAndRunWithOptions [| "/langversion:preview";"/optimize-";"/debug:portable";"/tailcalls-" |] + """ +module Test + +open System.Threading.Tasks + +type Generic1InGeneric1<'T>() = + let run (computation: Task<'A>) = + task { return! computation } + + member _.Run() = run (Task.FromResult 3) + +type Generic2InGeneric1<'T1, 'T2>() = + let run (computation: Task<'A>) = + task { return! computation } + + member _.Run() = run (Task.FromResult 3) + +let checkEquals s e a = if e = a then printfn $"test '{s}' passed" else failwith $"test '{s}' failed!, expected {e} got {a}" +Generic1InGeneric1().Run().Result |> checkEquals "cwewe21" 3 +Generic1InGeneric1().Run().Result |> checkEquals "cwewe22" 3 +Generic2InGeneric1().Run().Result |> checkEquals "cwewe23" 3 +Generic2InGeneric1().Run().Result |> checkEquals "cwewe24" 3 +printfn "test passed" + + """ + + +#if !DEBUG + + [] + let ``check generic task exact code``() = + CompilerAssert.CompileLibraryAndVerifyILWithOptions [| "/langversion:preview";"/optimize-";"/debug:portable";"/tailcalls-" |] + """ +module Test + +open System.Threading.Tasks +type Generic1InGeneric1<'T>() = + let run (computation: Task<'A>) = + task { return! computation } + + member _.Run() = run (Task.FromResult 3) + """ + (fun verifier -> verifier.VerifyIL [ + """ +.method assembly hidebysig instance class [runtime]System.Threading.Tasks.Task`1 + run(class [runtime]System.Threading.Tasks.Task`1 computation) cil managed +{ + .custom instance void [runtime]System.Runtime.CompilerServices.CompilerGeneratedAttribute::.ctor() = ( 01 00 00 00 ) + + .maxstack 4 + .locals init (valuetype Test/clo@7 V_0, + valuetype Test/clo@7& V_1) + IL_0000: ldloca.s V_0 + IL_0002: initobj valuetype Test/clo@7 + IL_0008: ldloca.s V_0 + IL_000a: stloc.1 + IL_000b: ldloc.1 + IL_000c: ldarg.1 + IL_000d: stfld class [runtime]System.Threading.Tasks.Task`1 valuetype Test/clo@7::computation + IL_0012: ldloc.1 + IL_0013: ldflda valuetype [FSharp.Core]Microsoft.FSharp.Control.TaskStateMachineData`1 valuetype Test/clo@7::Data + IL_0018: call valuetype [netstandard]System.Runtime.CompilerServices.AsyncTaskMethodBuilder`1 valuetype [netstandard]System.Runtime.CompilerServices.AsyncTaskMethodBuilder`1::Create() + IL_001d: stfld valuetype [runtime]System.Runtime.CompilerServices.AsyncTaskMethodBuilder`1 valuetype [FSharp.Core]Microsoft.FSharp.Control.TaskStateMachineData`1::MethodBuilder + IL_0022: ldloc.1 + IL_0023: ldflda valuetype [FSharp.Core]Microsoft.FSharp.Control.TaskStateMachineData`1 valuetype Test/clo@7::Data + IL_0028: ldflda valuetype [runtime]System.Runtime.CompilerServices.AsyncTaskMethodBuilder`1 valuetype [FSharp.Core]Microsoft.FSharp.Control.TaskStateMachineData`1::MethodBuilder + IL_002d: ldloc.1 + IL_002e: call instance void valuetype [netstandard]System.Runtime.CompilerServices.AsyncTaskMethodBuilder`1::Start>(!!0&) + IL_0033: ldloc.1 + IL_0034: ldflda valuetype [FSharp.Core]Microsoft.FSharp.Control.TaskStateMachineData`1 valuetype Test/clo@7::Data + IL_0039: ldflda valuetype [runtime]System.Runtime.CompilerServices.AsyncTaskMethodBuilder`1 valuetype [FSharp.Core]Microsoft.FSharp.Control.TaskStateMachineData`1::MethodBuilder + IL_003e: call instance class [netstandard]System.Threading.Tasks.Task`1 valuetype [netstandard]System.Runtime.CompilerServices.AsyncTaskMethodBuilder`1::get_Task() + IL_0043: ret +} + + """ + """ + .method public strict virtual instance void + MoveNext() cil managed + { + .override [runtime]System.Runtime.CompilerServices.IAsyncStateMachine::MoveNext + + .maxstack 5 + .locals init (int32 V_0, + class [runtime]System.Exception V_1, + bool V_2, + class [runtime]System.Threading.Tasks.Task`1 V_3, + bool V_4, + bool V_5, + !A V_6, + !A V_7, + valuetype [runtime]System.Runtime.CompilerServices.TaskAwaiter`1 V_8, + class [runtime]System.Exception V_9, + class [runtime]System.Exception V_10) + IL_0000: ldarg.0 + IL_0001: ldfld int32 valuetype Test/clo@7::ResumptionPoint + IL_0006: stloc.0 + IL_0007: ldloc.0 + IL_0008: ldc.i4.1 + IL_0009: sub + IL_000a: switch ( + IL_0015) + IL_0013: br.s IL_0018 + + IL_0015: nop + IL_0016: br.s IL_001b + + IL_0018: nop + IL_0019: ldnull + IL_001a: stloc.1 + .try + { + IL_001b: ldloc.0 + IL_001c: ldc.i4.1 + IL_001d: sub + IL_001e: switch ( + IL_0029) + IL_0027: br.s IL_002c + + IL_0029: nop + IL_002a: br.s IL_0055 + + IL_002c: nop + IL_002d: ldarg.0 + IL_002e: ldfld class [runtime]System.Threading.Tasks.Task`1 valuetype Test/clo@7::computation + IL_0033: stloc.3 + IL_0034: ldarg.0 + IL_0035: ldloc.3 + IL_0036: callvirt instance valuetype [netstandard]System.Runtime.CompilerServices.TaskAwaiter`1 class [netstandard]System.Threading.Tasks.Task`1::GetAwaiter() + IL_003b: stfld valuetype [runtime]System.Runtime.CompilerServices.TaskAwaiter`1 valuetype Test/clo@7::awaiter + IL_0040: ldc.i4.1 + IL_0041: stloc.s V_4 + IL_0043: ldarg.0 + IL_0044: ldflda valuetype [runtime]System.Runtime.CompilerServices.TaskAwaiter`1 valuetype Test/clo@7::awaiter + IL_0049: call instance bool valuetype [netstandard]System.Runtime.CompilerServices.TaskAwaiter`1::get_IsCompleted() + IL_004e: brfalse.s IL_0052 + + IL_0050: br.s IL_006b + + IL_0052: ldc.i4.0 + IL_0053: brfalse.s IL_0059 + + IL_0055: ldc.i4.1 + IL_0056: nop + IL_0057: br.s IL_0062 + + IL_0059: ldarg.0 + IL_005a: ldc.i4.1 + IL_005b: stfld int32 valuetype Test/clo@7::ResumptionPoint + IL_0060: ldc.i4.0 + IL_0061: nop + IL_0062: stloc.s V_5 + IL_0064: ldloc.s V_5 + IL_0066: stloc.s V_4 + IL_0068: nop + IL_0069: br.s IL_006c + + IL_006b: nop + IL_006c: ldloc.s V_4 + IL_006e: brfalse.s IL_0092 + + IL_0070: ldarg.0 + IL_0071: ldflda valuetype [runtime]System.Runtime.CompilerServices.TaskAwaiter`1 valuetype Test/clo@7::awaiter + IL_0076: call instance !0 valuetype [netstandard]System.Runtime.CompilerServices.TaskAwaiter`1::GetResult() + IL_007b: stloc.s V_6 + IL_007d: ldloc.s V_6 + IL_007f: stloc.s V_7 + IL_0081: ldarg.0 + IL_0082: ldflda valuetype [FSharp.Core]Microsoft.FSharp.Control.TaskStateMachineData`1 valuetype Test/clo@7::Data + IL_0087: ldloc.s V_7 + IL_0089: stfld !0 valuetype [FSharp.Core]Microsoft.FSharp.Control.TaskStateMachineData`1::Result + IL_008e: ldc.i4.1 + IL_008f: nop + IL_0090: br.s IL_00ab + + IL_0092: ldarg.0 + IL_0093: ldflda valuetype [FSharp.Core]Microsoft.FSharp.Control.TaskStateMachineData`1 valuetype Test/clo@7::Data + IL_0098: ldflda valuetype [runtime]System.Runtime.CompilerServices.AsyncTaskMethodBuilder`1 valuetype [FSharp.Core]Microsoft.FSharp.Control.TaskStateMachineData`1::MethodBuilder + IL_009d: ldarg.0 + IL_009e: ldflda valuetype [runtime]System.Runtime.CompilerServices.TaskAwaiter`1 valuetype Test/clo@7::awaiter + IL_00a3: ldarg.0 + IL_00a4: call instance void valuetype [netstandard]System.Runtime.CompilerServices.AsyncTaskMethodBuilder`1::AwaitUnsafeOnCompleted,valuetype Test/clo@7>(!!0&, + !!1&) + IL_00a9: ldc.i4.0 + IL_00aa: nop + IL_00ab: brfalse.s IL_00b9 + + IL_00ad: ldarg.0 + IL_00ae: ldloc.s V_8 + IL_00b0: stfld valuetype [runtime]System.Runtime.CompilerServices.TaskAwaiter`1 valuetype Test/clo@7::awaiter + IL_00b5: ldc.i4.1 + IL_00b6: nop + IL_00b7: br.s IL_00bb + + IL_00b9: ldc.i4.0 + IL_00ba: nop + IL_00bb: stloc.2 + IL_00bc: ldloc.2 + IL_00bd: brfalse.s IL_00dc + + IL_00bf: ldarg.0 + IL_00c0: ldflda valuetype [FSharp.Core]Microsoft.FSharp.Control.TaskStateMachineData`1 valuetype Test/clo@7::Data + IL_00c5: ldflda valuetype [runtime]System.Runtime.CompilerServices.AsyncTaskMethodBuilder`1 valuetype [FSharp.Core]Microsoft.FSharp.Control.TaskStateMachineData`1::MethodBuilder + IL_00ca: ldarg.0 + IL_00cb: ldflda valuetype [FSharp.Core]Microsoft.FSharp.Control.TaskStateMachineData`1 valuetype Test/clo@7::Data + IL_00d0: ldfld !0 valuetype [FSharp.Core]Microsoft.FSharp.Control.TaskStateMachineData`1::Result + IL_00d5: call instance void valuetype [netstandard]System.Runtime.CompilerServices.AsyncTaskMethodBuilder`1::SetResult(!0) + IL_00da: leave.s IL_00ea + + IL_00dc: leave.s IL_00ea + + } + catch [runtime]System.Object + { + IL_00de: castclass [runtime]System.Exception + IL_00e3: stloc.s V_9 + IL_00e5: ldloc.s V_9 + IL_00e7: stloc.1 + IL_00e8: leave.s IL_00ea + + } + IL_00ea: ldloc.1 + IL_00eb: stloc.s V_10 + IL_00ed: ldloc.s V_10 + IL_00ef: brtrue.s IL_00f2 + + IL_00f1: ret + + IL_00f2: ldarg.0 + IL_00f3: ldflda valuetype [FSharp.Core]Microsoft.FSharp.Control.TaskStateMachineData`1 valuetype Test/clo@7::Data + IL_00f8: ldflda valuetype [runtime]System.Runtime.CompilerServices.AsyncTaskMethodBuilder`1 valuetype [FSharp.Core]Microsoft.FSharp.Control.TaskStateMachineData`1::MethodBuilder + IL_00fd: ldloc.s V_10 + IL_00ff: call instance void valuetype [netstandard]System.Runtime.CompilerServices.AsyncTaskMethodBuilder`1::SetException(class [netstandard]System.Exception) + IL_0104: ret + } + + """ + ]) +#endif + + #if NETCOREAPP [] module ``Check stack traces`` =