Skip to content
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
58 changes: 24 additions & 34 deletions src/fsharp/ConstraintSolver.fs
Original file line number Diff line number Diff line change
Expand Up @@ -370,7 +370,6 @@ let ShowAccessDomain ad =
// Solve

exception NonRigidTypar of DisplayEnv * string option * range * TType * TType * range
exception LocallyAbortOperationThatFailsToResolveOverload
exception LocallyAbortOperationThatLosesAbbrevs
let localAbortD = ErrorD LocallyAbortOperationThatLosesAbbrevs

Expand Down Expand Up @@ -739,19 +738,19 @@ and solveTypMeetsTyparConstraints (csenv:ConstraintSolverEnv) ndeep m2 trace ty
| Some destTypar ->
AddConstraint csenv ndeep m2 trace destTypar (TyparConstraint.DefaultsTo(priority, dty, m))

| TyparConstraint.SupportsNull m2 -> SolveTypSupportsNull csenv ndeep m2 trace ty
| TyparConstraint.IsEnum(underlying, m2) -> SolveTypIsEnum csenv ndeep m2 trace ty underlying
| TyparConstraint.SupportsComparison(m2) -> SolveTypeSupportsComparison csenv ndeep m2 trace ty
| TyparConstraint.SupportsEquality(m2) -> SolveTypSupportsEquality csenv ndeep m2 trace ty
| TyparConstraint.SupportsNull m2 -> SolveTypSupportsNull csenv ndeep m2 trace ty
| TyparConstraint.IsEnum(underlying, m2) -> SolveTypIsEnum csenv ndeep m2 trace ty underlying
| TyparConstraint.SupportsComparison(m2) -> SolveTypeSupportsComparison csenv ndeep m2 trace ty
| TyparConstraint.SupportsEquality(m2) -> SolveTypSupportsEquality csenv ndeep m2 trace ty
| TyparConstraint.IsDelegate(aty, bty, m2) -> SolveTypIsDelegate csenv ndeep m2 trace ty aty bty
| TyparConstraint.IsNonNullableStruct m2 -> SolveTypIsNonNullableValueType csenv ndeep m2 trace ty
| TyparConstraint.IsUnmanaged m2 -> SolveTypIsUnmanaged csenv ndeep m2 trace ty
| TyparConstraint.IsReferenceType m2 -> SolveTypIsReferenceType csenv ndeep m2 trace ty
| TyparConstraint.RequiresDefaultConstructor m2 -> SolveTypRequiresDefaultConstructor csenv ndeep m2 trace ty
| TyparConstraint.IsNonNullableStruct m2 -> SolveTypIsNonNullableValueType csenv ndeep m2 trace ty
| TyparConstraint.IsUnmanaged m2 -> SolveTypIsUnmanaged csenv ndeep m2 trace ty
| TyparConstraint.IsReferenceType m2 -> SolveTypIsReferenceType csenv ndeep m2 trace ty
| TyparConstraint.RequiresDefaultConstructor m2 -> SolveTypRequiresDefaultConstructor csenv ndeep m2 trace ty
| TyparConstraint.SimpleChoice(tys, m2) -> SolveTypChoice csenv ndeep m2 trace ty tys
| TyparConstraint.CoercesTo(ty2, m2) -> SolveTypSubsumesTypKeepAbbrevs csenv ndeep m2 trace None ty2 ty
| TyparConstraint.MayResolveMember(traitInfo, m2) ->
SolveMemberConstraint csenv false false ndeep m2 trace traitInfo ++ (fun _ -> CompleteD)
| TyparConstraint.MayResolveMember(traitInfo, m2) ->
SolveMemberConstraint csenv false ndeep m2 trace traitInfo ++ (fun _ -> CompleteD)
)))


Expand All @@ -761,15 +760,14 @@ and SolveTypEqualsTyp (csenv:ConstraintSolverEnv) ndeep m2 (trace: OptionalTrace
let ndeep = ndeep + 1
let aenv = csenv.EquivEnv
let g = csenv.g
if ty1 === ty2 then CompleteD else

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.
TransactMemberConstraintSolution traitInfo trace traitSln
| _ -> ()

if ty1 === ty2 then CompleteD else

let canShortcut = not trace.HasTrace
let sty1 = stripTyEqnsA csenv.g canShortcut ty1
let sty2 = stripTyEqnsA csenv.g canShortcut ty2
Expand Down Expand Up @@ -943,7 +941,7 @@ and SolveDimensionlessNumericType (csenv:ConstraintSolverEnv) ndeep m2 trace ty
/// We pretend int and other types support a number of operators. In the actual IL for mscorlib they
/// don't, however the type-directed static optimization rules in the library code that makes use of this
/// will deal with the problem.
and SolveMemberConstraint (csenv:ConstraintSolverEnv) ignoreUnresolvedOverload permitWeakResolution ndeep m2 trace (TTrait(tys, nm, memFlags, argtys, rty, sln)): OperationResult<bool> =
and SolveMemberConstraint (csenv:ConstraintSolverEnv) permitWeakResolution ndeep m2 trace (TTrait(tys,nm,memFlags,argtys,rty,sln)) : OperationResult<bool> =
// Do not re-solve if already solved
if sln.Value.IsSome then ResultD true else
let g = csenv.g
Expand Down Expand Up @@ -1300,12 +1298,9 @@ and SolveMemberConstraint (csenv:ConstraintSolverEnv) ignoreUnresolvedOverload p
let frees = GetFreeTyparsOfMemberConstraint csenv traitInfo

// If there's nothing left to learn then raise the errors
(if (permitWeakResolution && isNil support) || isNil frees then errors
// Otherwise re-record the trait waiting for canonicalization
else AddMemberConstraint csenv ndeep m2 trace traitInfo support frees) ++ (fun () ->
match errors with
| ErrorResult (_, UnresolvedOverloading _) when not ignoreUnresolvedOverload && (not (nm = "op_Explicit" || nm = "op_Implicit")) -> ErrorD LocallyAbortOperationThatFailsToResolveOverload
| _ -> ResultD TTraitUnsolved)
(if (permitWeakResolution && isNil support) || isNil frees then errors
// Otherwise re-record the trait waiting for canonicalization
else AddMemberConstraint csenv ndeep m2 trace traitInfo support frees) ++ (fun () -> ResultD TTraitUnsolved)
)
++
(fun res -> RecordMemberConstraintSolution csenv.SolverState m trace traitInfo res))
Expand Down Expand Up @@ -1447,7 +1442,7 @@ and SolveRelevantMemberConstraintsForTypar (csenv:ConstraintSolverEnv) ndeep per
cxs
|> AtLeastOneD (fun (traitInfo, m2) ->
let csenv = { csenv with m = m2 }
SolveMemberConstraint csenv true permitWeakResolution (ndeep+1) m2 trace traitInfo)
SolveMemberConstraint csenv permitWeakResolution (ndeep+1) m2 trace traitInfo)

and CanonicalizeRelevantMemberConstraints (csenv:ConstraintSolverEnv) ndeep trace tps =
SolveRelevantMemberConstraints csenv ndeep true trace tps
Expand Down Expand Up @@ -1962,22 +1957,18 @@ and CanMemberSigsMatchUpToCheck
// to allow us to report the outer types involved in the constraint
and private SolveTypSubsumesTypWithReport (csenv:ConstraintSolverEnv) ndeep m trace cxsln ty1 ty2 =
TryD (fun () -> SolveTypSubsumesTypKeepAbbrevs csenv ndeep m trace cxsln ty1 ty2)
(function
| LocallyAbortOperationThatFailsToResolveOverload -> CompleteD
| res ->
match csenv.eContextInfo with
| ContextInfo.RuntimeTypeTest isOperator ->
// test if we can cast other way around
(fun res ->
match csenv.eContextInfo with
| ContextInfo.RuntimeTypeTest isOperator ->
// test if we can cast other way around
match CollectThenUndo (fun newTrace -> SolveTypSubsumesTypKeepAbbrevs csenv ndeep m (OptionalTrace.WithTrace newTrace) cxsln ty2 ty1) with
| OkResult _ -> ErrorD (ErrorsFromAddingSubsumptionConstraint(csenv.g, csenv.DisplayEnv, ty1, ty2, res, ContextInfo.DowncastUsedInsteadOfUpcast isOperator, m))
| _ -> ErrorD (ErrorsFromAddingSubsumptionConstraint(csenv.g, csenv.DisplayEnv, ty1, ty2, res, ContextInfo.NoContext, m))
| _ -> ErrorD (ErrorsFromAddingSubsumptionConstraint(csenv.g, csenv.DisplayEnv, ty1, ty2, res, csenv.eContextInfo, m)))

and private SolveTypEqualsTypWithReport (csenv:ConstraintSolverEnv) ndeep m trace cxsln ty1 ty2 =
TryD (fun () -> SolveTypEqualsTypKeepAbbrevsWithCxsln csenv ndeep m trace cxsln ty1 ty2)
(function
| LocallyAbortOperationThatFailsToResolveOverload -> CompleteD
| res -> ErrorD (ErrorFromAddingTypeEquation(csenv.g, csenv.DisplayEnv, ty1, ty2, res, m)))
(fun res -> ErrorD (ErrorFromAddingTypeEquation(csenv.g, csenv.DisplayEnv, ty1, ty2, res, m)))

and ArgsMustSubsumeOrConvert
(csenv:ConstraintSolverEnv)
Expand Down Expand Up @@ -2543,7 +2534,7 @@ let AddCxTypeMustSubsumeType contextInfo denv css m trace ty1 ty2 =
|> RaiseOperationResult

let AddCxMethodConstraint denv css m trace traitInfo =
TryD (fun () -> SolveMemberConstraint (MakeConstraintSolverEnv ContextInfo.NoContext css m denv) true false 0 m trace traitInfo ++ (fun _ -> CompleteD))
TryD (fun () -> SolveMemberConstraint (MakeConstraintSolverEnv ContextInfo.NoContext css m denv) false 0 m trace traitInfo ++ (fun _ -> CompleteD))
(fun res -> ErrorD (ErrorFromAddingConstraint(denv, res, m)))
|> RaiseOperationResult

Expand Down Expand Up @@ -2601,7 +2592,7 @@ let CodegenWitnessThatTypSupportsTraitConstraint tcVal g amap m (traitInfo:Trait
InfoReader = new InfoReader(g, amap) }

let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m (DisplayEnv.Empty g)
SolveMemberConstraint csenv true true 0 m NoTrace traitInfo ++ (fun _res ->
SolveMemberConstraint csenv true 0 m NoTrace traitInfo ++ (fun _res ->
let sln =
match traitInfo.Solution with
| None -> Choice4Of4()
Expand Down Expand Up @@ -2725,5 +2716,4 @@ let IsApplicableMethApprox g amap m (minfo:MethInfo) availObjTy =
|> CommitOperationResult
| _ -> true
else
true

true
Original file line number Diff line number Diff line change
@@ -0,0 +1,38 @@
// #Conformance #DeclarationElements #MemberDefinitions #Overloading
// Exotic case from F#+ https://github.com/gusty/FSharpPlus

module Applicatives =
open System

type Ap = Ap with
static member inline Invoke (x:'T) : '``Applicative<'T>`` =
let inline call (mthd : ^M, output : ^R) = ((^M or ^R) : (static member Return: _*_ -> _) output, mthd)
call (Ap, Unchecked.defaultof<'``Applicative<'T>``>) x
static member inline InvokeOnInstance (x:'T) = (^``Applicative<'T>`` : (static member Return: ^T -> ^``Applicative<'T>``) x)
static member inline Return (r:'R , _:obj) = Ap.InvokeOnInstance :_ -> 'R
static member Return (_:seq<'a> , Ap ) = fun x -> Seq.singleton x : seq<'a>
static member Return (_:Tuple<'a>, Ap ) = fun x -> Tuple x : Tuple<'a>
static member Return (_:'r -> 'a , Ap ) = fun k _ -> k : 'a -> 'r -> _

let inline result (x:'T) = Ap.Invoke x

let inline (<*>) (f:'``Applicative<'T->'U>``) (x:'``Applicative<'T>``) : '``Applicative<'U>`` =
(( ^``Applicative<'T->'U>`` or ^``Applicative<'T>`` or ^``Applicative<'U>``) : (static member (<*>): _*_ -> _) f, x)

let inline (+) (a:'Num) (b:'Num) :'Num = a + b

type ZipList<'s> = ZipList of 's seq with
static member Return (x:'a) = ZipList (Seq.initInfinite (fun _ -> x))
static member (<*>) (ZipList (f:seq<'a->'b>), ZipList x) = ZipList (Seq.zip f x |> Seq.map (fun (f, x) -> f x)) :ZipList<'b>

type Ii = Ii
type Idiomatic = Idiomatic with
static member inline ($) (Idiomatic, si) = fun sfi x -> (Idiomatic $ x) (sfi <*> si)
static member ($) (Idiomatic, Ii) = id
let inline idiomatic a b = (Idiomatic $ b) a
let inline iI x = (idiomatic << result) x

let res1n2n3 = iI (+) (result 0M ) (ZipList [1M;2M;3M]) Ii
let res2n3n4 = iI (+) (result LanguagePrimitives.GenericOne) (ZipList [1 ;2 ;3 ]) Ii

exit 0
Original file line number Diff line number Diff line change
@@ -0,0 +1,26 @@
// #Conformance #DeclarationElements #MemberDefinitions #Overloading
// Originally from https://gist.github.com/gusty/b6fac370bff36a665d75
type FoldArgs<'t> = FoldArgs of ('t -> 't -> 't)

let inline foldArgs f (x:'t) (y:'t) :'rest = (FoldArgs f $ Unchecked.defaultof<'rest>) x y

type FoldArgs<'t> with
static member inline ($) (FoldArgs f, _:'t-> 'rest) = fun (a:'t) -> f a >> foldArgs f
static member ($) (FoldArgs f, _:'t ) = f

let test1() =
let x:int = foldArgs (+) 2 3
let y:int = foldArgs (+) 2 3 4
let z:int = foldArgs (+) 2 3 4 5
let d:decimal = foldArgs (+) 2M 3M 4M
let e:string = foldArgs (+) "h" "e" "l" "l" "o"
let f:float = foldArgs (+) 2. 3. 4.

let mult3Numbers a b c = a * b * c
let res2 = mult3Numbers 3 (foldArgs (+) 3 4) (foldArgs (+) 2 2 3 3)
()

// Run the test
test1()

exit 0
Original file line number Diff line number Diff line change
@@ -1,6 +1,6 @@
// #Conformance #DeclarationElements #MemberDefinitions #Overloading
// https://github.com/Microsoft/visualfsharp/issues/351 - slow overlaod resolution
//<Expects id="FS0003" status="error">This value is not a function and cannot be applied</Expects>
//<Expects id="FS0001" status="error">No overloads match</Expects>
type Switcher = Switcher

let inline checker< ^s, ^r when (^s or ^r) : (static member pass : ^r -> unit)> (s : ^s) (r : ^r) = ()
Expand All @@ -22,4 +22,4 @@ let main argv =
let res : unit = format () "text" 5 "more text" ()
printfn "%A" res
System.Console.ReadKey()
0 // return an integer exit code
0 // return an integer exit code
Original file line number Diff line number Diff line change
Expand Up @@ -27,6 +27,8 @@ NOMONO,NoMT SOURCE=ConsumeOverloadGenericMethods.fs SCFLAGS="-r:lib.dll" PRECMD=
SOURCE=InferenceForLambdaArgs.fs # InferenceForLambdaArgs.fs

SOURCE=SlowOverloadResolution.fs # SlowOverloadResolution.fs
SOURCE=RecursiveOverload01.fs # RecursiveOverload01.fs
SOURCE=OverloadsAndSRTPs01.fs # OverloadsAndSRTPs01.fs

SOURCE=E_OverloadCurriedFunc.fs # E_OverloadCurriedFunc.fs
SOURCE=NoWarningWhenOverloadingInSubClass01.fs SCFLAGS="--warnaserror" # NoWarningWhenOverloadingInSubClass01.fs
Expand Down