diff --git a/src/fsharp/ConstraintSolver.fs b/src/fsharp/ConstraintSolver.fs index a03b1911088..70fb8723440 100644 --- a/src/fsharp/ConstraintSolver.fs +++ b/src/fsharp/ConstraintSolver.fs @@ -310,9 +310,12 @@ let rec occursCheck g un ty = /// During code gen we run with permitWeakResolution on, but we only apply it where one of the argument types for the built-in constraint resolution is /// a variable type. type PermitWeakResolution = - | Yes of codegen: bool + | YesAtInlineGeneralization + | YesAtResolution + | YesAtCodeGen | No - member x.Permit = match x with Yes _ -> true | No -> false + member x.PerformWeakBuiltInResolution = match x with YesAtInlineGeneralization | YesAtResolution | YesAtCodeGen -> true | No -> false + member x.PerformWeakOverloadResolution = match x with YesAtResolution -> true | YesAtInlineGeneralization | YesAtCodeGen | No -> false let rec isNativeIntegerTy g ty = typeEquivAux EraseMeasures g g.nativeint_ty ty || @@ -410,7 +413,8 @@ let IsBinaryOpArgTypePair p1 p2 permitWeakResolution minfos g ty1 ty2 = // During regular canonicalization (weak resolution) we don't do any check on the other type at all - we // ignore the possibility that method overloads may resolve the constraint - | PermitWeakResolution.Yes false -> + | PermitWeakResolution.YesAtInlineGeneralization + | PermitWeakResolution.YesAtResolution -> // weak resolution lets the other type be a variable type isTyparTy g ty2 || // If the other type is not a variable type, it is nominal, @@ -419,7 +423,7 @@ let IsBinaryOpArgTypePair p1 p2 permitWeakResolution minfos g ty1 ty2 = typeEquivAux EraseMeasures g ty1 ty2 // During codegen we only apply a builtin resolution if both the types are correct - | PermitWeakResolution.Yes true -> + | PermitWeakResolution.YesAtCodeGen -> p2 ty2 && // All built-in rules only apply in cases where left and right operator types are equal (after // erasing units) @@ -1603,7 +1607,7 @@ and SolveMemberConstraint (csenv: ConstraintSolverEnv) ignoreUnresolvedOverload // If there's nothing left to learn then raise the errors. // Note: we should likely call MemberConstraintIsReadyForResolution here when permitWeakResolution=false but for stability // reasons we use the more restrictive isNil frees. - if (permitWeakResolution.Permit && MemberConstraintIsReadyForWeakResolution csenv traitInfo) || isNil frees then + if (permitWeakResolution.PerformWeakOverloadResolution && MemberConstraintIsReadyForWeakResolution csenv traitInfo) || isNil frees then do! errors else do! AddMemberConstraint csenv ndeep m2 trace traitInfo support frees @@ -1709,7 +1713,7 @@ and GetRelevantExtensionMethodsForTrait m (amap: Import.ImportMap) (traitInfo: T /// That is, don't perform resolution if more nominal information may influence the set of available overloads and GetRelevantMethodsForTrait (csenv: ConstraintSolverEnv) (permitWeakResolution: PermitWeakResolution) nm (TTrait(tys, _, memFlags, argtys, rty, soln, extSlns, ad) as traitInfo) : MethInfo list = let results = - if permitWeakResolution.Permit || MemberConstraintSupportIsReadyForDeterminingOverloads csenv traitInfo then + if permitWeakResolution.PerformWeakOverloadResolution || MemberConstraintSupportIsReadyForDeterminingOverloads csenv traitInfo then let m = csenv.m let minfos = match memFlags.MemberKind with @@ -1816,8 +1820,9 @@ and SolveRelevantMemberConstraintsForTypar (csenv:ConstraintSolverEnv) ndeep (pe let csenv = { csenv with m = m2 } SolveMemberConstraint csenv true permitWeakResolution (ndeep+1) m2 trace traitInfo) -and CanonicalizeRelevantMemberConstraints (csenv: ConstraintSolverEnv) ndeep trace tps = - SolveRelevantMemberConstraints csenv ndeep (PermitWeakResolution.Yes false) trace tps +and CanonicalizeRelevantMemberConstraints (csenv: ConstraintSolverEnv) ndeep trace tps isInline = + let permitWeakResolution = (if isInline then PermitWeakResolution.YesAtInlineGeneralization else PermitWeakResolution.YesAtResolution) + SolveRelevantMemberConstraints csenv ndeep permitWeakResolution trace tps and AddMemberConstraint (csenv: ConstraintSolverEnv) ndeep m2 (trace: OptionalTrace) traitInfo support (frees: Typar list) = let g = csenv.g @@ -3080,7 +3085,7 @@ let CodegenWitnessThatTypeSupportsTraitConstraint tcVal g amap m (traitInfo: Tra let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m (DisplayEnv.Empty g) - let! _res = SolveMemberConstraint csenv true (PermitWeakResolution.Yes true) 0 m NoTrace traitInfo + let! _res = SolveMemberConstraint csenv true PermitWeakResolution.YesAtCodeGen 0 m NoTrace traitInfo let sln = match traitInfo.Solution with @@ -3225,11 +3230,11 @@ let CheckDeclaredTypars denv css m typars1 typars2 = ErrorD (ErrorFromAddingConstraint(denv, res, m))) |> RaiseOperationResult -let CanonicalizePartialInferenceProblem css denv m tps = +let CanonicalizePartialInferenceProblem css denv m tps isInline = // Canonicalize constraints prior to generalization let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m denv TryD_IgnoreAbortForFailedOverloadResolution - (fun () -> CanonicalizeRelevantMemberConstraints csenv 0 NoTrace tps) + (fun () -> CanonicalizeRelevantMemberConstraints csenv 0 NoTrace tps isInline) (fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m))) |> RaiseOperationResult diff --git a/src/fsharp/ConstraintSolver.fsi b/src/fsharp/ConstraintSolver.fsi index 4045d26f9d9..3089ac2337c 100644 --- a/src/fsharp/ConstraintSolver.fsi +++ b/src/fsharp/ConstraintSolver.fsi @@ -190,4 +190,4 @@ val ChooseTyparSolutionAndSolve: ConstraintSolverState -> DisplayEnv -> Typar -> val IsApplicableMethApprox: TcGlobals -> ImportMap -> range -> MethInfo -> TType -> bool -val CanonicalizePartialInferenceProblem: ConstraintSolverState -> DisplayEnv -> range -> Typars -> unit \ No newline at end of file +val CanonicalizePartialInferenceProblem: ConstraintSolverState -> DisplayEnv -> range -> Typars -> bool -> unit \ No newline at end of file diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index be49db4ec89..dd9c575f885 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -6772,7 +6772,7 @@ and TcObjectExprBinding cenv (env: TcEnv) implty tpenv (absSlotInfo, bind) = | _ -> declaredTypars // Canonicalize constraints prior to generalization - ConstraintSolver.CanonicalizePartialInferenceProblem cenv.css denv m declaredTypars + ConstraintSolver.CanonicalizePartialInferenceProblem cenv.css denv m declaredTypars true let freeInEnv = GeneralizationHelpers.ComputeUngeneralizableTypars env @@ -9862,7 +9862,7 @@ and TcLookupThen cenv overallTy env tpenv mObjExpr objExpr objExprTy longId dela // Canonicalize inference problem prior to '.' lookup on variable types if isTyparTy cenv.g objExprTy then - ConstraintSolver.CanonicalizePartialInferenceProblem cenv.css env.DisplayEnv mExprAndLongId (freeInTypeLeftToRight cenv.g false objExprTy) + ConstraintSolver.CanonicalizePartialInferenceProblem cenv.css env.DisplayEnv mExprAndLongId (freeInTypeLeftToRight cenv.g false objExprTy) false let item, mItem, rest, afterResolution = ResolveExprDotLongIdentAndComputeRange cenv.tcSink cenv.nameResolver mExprAndLongId ad env.NameEnv objExprTy longId findFlag false let mExprAndItem = unionRanges mObjExpr mItem @@ -10410,8 +10410,8 @@ and TcMethodApplication // about the possible target of the call. if not uniquelyResolved then ConstraintSolver.CanonicalizePartialInferenceProblem cenv.css denv mItem - (//freeInTypeLeftToRight cenv.g false returnTy @ - (unnamedCurriedCallerArgs |> List.collectSquared (fun callerArg -> freeInTypeLeftToRight cenv.g false callerArg.Type))) + (unnamedCurriedCallerArgs |> List.collectSquared (fun callerArg -> freeInTypeLeftToRight cenv.g false callerArg.Type)) + false let result, errors = ResolveOverloadingForCall denv cenv.css mMethExpr methodName 0 None callerArgCounts ad postArgumentTypeCheckingCalledMethGroup true (Some returnTy) @@ -11371,12 +11371,17 @@ and TcLetBinding cenv isUse env containerInfo declKind tpenv (synBinds, synBinds // Canonicalize constraints prior to generalization let denv = env.DisplayEnv + let isInline = + (checkedBinds |> List.forall (fun tbinfo -> + let (CheckedBindingInfo(inl, _, _, _, _, _, _, _, _, _, _, _, _, _)) = tbinfo + (inl = ValInline.PseudoVal))) ConstraintSolver.CanonicalizePartialInferenceProblem cenv.css denv synBindsRange (checkedBinds |> List.collect (fun tbinfo -> let (CheckedBindingInfo(_, _, _, _, flex, _, _, _, tauTy, _, _, _, _, _)) = tbinfo let (ExplicitTyparInfo(_, declaredTypars, _)) = flex let maxInferredTypars = (freeInTypeLeftToRight cenv.g false tauTy) declaredTypars @ maxInferredTypars)) + isInline let lazyFreeInEnv = lazy (GeneralizationHelpers.ComputeUngeneralizableTypars env) @@ -12246,7 +12251,11 @@ and TcIncrementalLetRecGeneralization cenv scopem else let supportForBindings = newGeneralizableBindings |> List.collect (TcLetrecComputeSupportForBinding cenv) - ConstraintSolver.CanonicalizePartialInferenceProblem cenv.css denv scopem supportForBindings + let isInline = + (newGeneralizableBindings |> List.forall (fun tbinfo -> + let (CheckedBindingInfo(inl, _, _, _, _, _, _, _, _, _, _, _, _, _)) = tbinfo.CheckedBinding + (inl = ValInline.PseudoVal))) + ConstraintSolver.CanonicalizePartialInferenceProblem cenv.css denv scopem supportForBindings isInline let generalizedTyparsL = newGeneralizableBindings |> List.map (TcLetrecComputeAndGeneralizeGenericTyparsForBinding cenv denv freeInEnv) @@ -17751,7 +17760,7 @@ let ApplyDefaults cenv g denvAtEnd m mexpr extraAttribs = try let unsolved = FSharp.Compiler.FindUnsolved.UnsolvedTyparsOfModuleDef g cenv.amap denvAtEnd (mexpr, extraAttribs) - ConstraintSolver.CanonicalizePartialInferenceProblem cenv.css denvAtEnd m unsolved + ConstraintSolver.CanonicalizePartialInferenceProblem cenv.css denvAtEnd m unsolved false // The priority order comes from the order of declaration of the defaults in FSharp.Core. for priority = 10 downto 0 do