Skip to content

Commit f9893b6

Browse files
gustyKevinRansom
gusty
authored and
KevinRansom
committed
Revert #1650 (and #3366) (#4173)
1 parent 939050e commit f9893b6

File tree

5 files changed

+92
-36
lines changed

5 files changed

+92
-36
lines changed

‎src/fsharp/ConstraintSolver.fs‎

Lines changed: 24 additions & 34 deletions
Original file line numberDiff line numberDiff line change
@@ -370,7 +370,6 @@ let ShowAccessDomain ad =
370370
// Solve
371371

372372
exception NonRigidTypar of DisplayEnv * string option * range * TType * TType * range
373-
exception LocallyAbortOperationThatFailsToResolveOverload
374373
exception LocallyAbortOperationThatLosesAbbrevs
375374
let localAbortD = ErrorD LocallyAbortOperationThatLosesAbbrevs
376375

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

742-
| TyparConstraint.SupportsNull m2 -> SolveTypSupportsNull csenv ndeep m2 trace ty
743-
| TyparConstraint.IsEnum(underlying, m2) -> SolveTypIsEnum csenv ndeep m2 trace ty underlying
744-
| TyparConstraint.SupportsComparison(m2) -> SolveTypeSupportsComparison csenv ndeep m2 trace ty
745-
| TyparConstraint.SupportsEquality(m2) -> SolveTypSupportsEquality csenv ndeep m2 trace ty
741+
| TyparConstraint.SupportsNull m2 -> SolveTypSupportsNull csenv ndeep m2 trace ty
742+
| TyparConstraint.IsEnum(underlying, m2) -> SolveTypIsEnum csenv ndeep m2 trace ty underlying
743+
| TyparConstraint.SupportsComparison(m2) -> SolveTypeSupportsComparison csenv ndeep m2 trace ty
744+
| TyparConstraint.SupportsEquality(m2) -> SolveTypSupportsEquality csenv ndeep m2 trace ty
746745
| TyparConstraint.IsDelegate(aty, bty, m2) -> SolveTypIsDelegate csenv ndeep m2 trace ty aty bty
747-
| TyparConstraint.IsNonNullableStruct m2 -> SolveTypIsNonNullableValueType csenv ndeep m2 trace ty
748-
| TyparConstraint.IsUnmanaged m2 -> SolveTypIsUnmanaged csenv ndeep m2 trace ty
749-
| TyparConstraint.IsReferenceType m2 -> SolveTypIsReferenceType csenv ndeep m2 trace ty
750-
| TyparConstraint.RequiresDefaultConstructor m2 -> SolveTypRequiresDefaultConstructor csenv ndeep m2 trace ty
746+
| TyparConstraint.IsNonNullableStruct m2 -> SolveTypIsNonNullableValueType csenv ndeep m2 trace ty
747+
| TyparConstraint.IsUnmanaged m2 -> SolveTypIsUnmanaged csenv ndeep m2 trace ty
748+
| TyparConstraint.IsReferenceType m2 -> SolveTypIsReferenceType csenv ndeep m2 trace ty
749+
| TyparConstraint.RequiresDefaultConstructor m2 -> SolveTypRequiresDefaultConstructor csenv ndeep m2 trace ty
751750
| TyparConstraint.SimpleChoice(tys, m2) -> SolveTypChoice csenv ndeep m2 trace ty tys
752751
| TyparConstraint.CoercesTo(ty2, m2) -> SolveTypSubsumesTypKeepAbbrevs csenv ndeep m2 trace None ty2 ty
753-
| TyparConstraint.MayResolveMember(traitInfo, m2) ->
754-
SolveMemberConstraint csenv false false ndeep m2 trace traitInfo ++ (fun _ -> CompleteD)
752+
| TyparConstraint.MayResolveMember(traitInfo, m2) ->
753+
SolveMemberConstraint csenv false ndeep m2 trace traitInfo ++ (fun _ -> CompleteD)
755754
)))
756755

757756

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

765765
match cxsln with
766766
| Some (traitInfo, traitSln) when traitInfo.Solution.IsNone ->
767767
// If this is an overload resolution at this point it's safe to assume the candidate member being evaluated solves this member constraint.
768768
TransactMemberConstraintSolution traitInfo trace traitSln
769769
| _ -> ()
770770

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

13021300
// If there's nothing left to learn then raise the errors
1303-
(if (permitWeakResolution && isNil support) || isNil frees then errors
1304-
// Otherwise re-record the trait waiting for canonicalization
1305-
else AddMemberConstraint csenv ndeep m2 trace traitInfo support frees) ++ (fun () ->
1306-
match errors with
1307-
| ErrorResult (_, UnresolvedOverloading _) when not ignoreUnresolvedOverload && (not (nm = "op_Explicit" || nm = "op_Implicit")) -> ErrorD LocallyAbortOperationThatFailsToResolveOverload
1308-
| _ -> ResultD TTraitUnsolved)
1301+
(if (permitWeakResolution && isNil support) || isNil frees then errors
1302+
// Otherwise re-record the trait waiting for canonicalization
1303+
else AddMemberConstraint csenv ndeep m2 trace traitInfo support frees) ++ (fun () -> ResultD TTraitUnsolved)
13091304
)
13101305
++
13111306
(fun res -> RecordMemberConstraintSolution csenv.SolverState m trace traitInfo res))
@@ -1447,7 +1442,7 @@ and SolveRelevantMemberConstraintsForTypar (csenv:ConstraintSolverEnv) ndeep per
14471442
cxs
14481443
|> AtLeastOneD (fun (traitInfo, m2) ->
14491444
let csenv = { csenv with m = m2 }
1450-
SolveMemberConstraint csenv true permitWeakResolution (ndeep+1) m2 trace traitInfo)
1445+
SolveMemberConstraint csenv permitWeakResolution (ndeep+1) m2 trace traitInfo)
14511446

14521447
and CanonicalizeRelevantMemberConstraints (csenv:ConstraintSolverEnv) ndeep trace tps =
14531448
SolveRelevantMemberConstraints csenv ndeep true trace tps
@@ -1962,22 +1957,18 @@ and CanMemberSigsMatchUpToCheck
19621957
// to allow us to report the outer types involved in the constraint
19631958
and private SolveTypSubsumesTypWithReport (csenv:ConstraintSolverEnv) ndeep m trace cxsln ty1 ty2 =
19641959
TryD (fun () -> SolveTypSubsumesTypKeepAbbrevs csenv ndeep m trace cxsln ty1 ty2)
1965-
(function
1966-
| LocallyAbortOperationThatFailsToResolveOverload -> CompleteD
1967-
| res ->
1968-
match csenv.eContextInfo with
1969-
| ContextInfo.RuntimeTypeTest isOperator ->
1970-
// test if we can cast other way around
1960+
(fun res ->
1961+
match csenv.eContextInfo with
1962+
| ContextInfo.RuntimeTypeTest isOperator ->
1963+
// test if we can cast other way around
19711964
match CollectThenUndo (fun newTrace -> SolveTypSubsumesTypKeepAbbrevs csenv ndeep m (OptionalTrace.WithTrace newTrace) cxsln ty2 ty1) with
19721965
| OkResult _ -> ErrorD (ErrorsFromAddingSubsumptionConstraint(csenv.g, csenv.DisplayEnv, ty1, ty2, res, ContextInfo.DowncastUsedInsteadOfUpcast isOperator, m))
19731966
| _ -> ErrorD (ErrorsFromAddingSubsumptionConstraint(csenv.g, csenv.DisplayEnv, ty1, ty2, res, ContextInfo.NoContext, m))
19741967
| _ -> ErrorD (ErrorsFromAddingSubsumptionConstraint(csenv.g, csenv.DisplayEnv, ty1, ty2, res, csenv.eContextInfo, m)))
19751968

19761969
and private SolveTypEqualsTypWithReport (csenv:ConstraintSolverEnv) ndeep m trace cxsln ty1 ty2 =
19771970
TryD (fun () -> SolveTypEqualsTypKeepAbbrevsWithCxsln csenv ndeep m trace cxsln ty1 ty2)
1978-
(function
1979-
| LocallyAbortOperationThatFailsToResolveOverload -> CompleteD
1980-
| res -> ErrorD (ErrorFromAddingTypeEquation(csenv.g, csenv.DisplayEnv, ty1, ty2, res, m)))
1971+
(fun res -> ErrorD (ErrorFromAddingTypeEquation(csenv.g, csenv.DisplayEnv, ty1, ty2, res, m)))
19811972

19821973
and ArgsMustSubsumeOrConvert
19831974
(csenv:ConstraintSolverEnv)
@@ -2543,7 +2534,7 @@ let AddCxTypeMustSubsumeType contextInfo denv css m trace ty1 ty2 =
25432534
|> RaiseOperationResult
25442535

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

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

26032594
let csenv = MakeConstraintSolverEnv ContextInfo.NoContext css m (DisplayEnv.Empty g)
2604-
SolveMemberConstraint csenv true true 0 m NoTrace traitInfo ++ (fun _res ->
2595+
SolveMemberConstraint csenv true 0 m NoTrace traitInfo ++ (fun _res ->
26052596
let sln =
26062597
match traitInfo.Solution with
26072598
| None -> Choice4Of4()
@@ -2725,5 +2716,4 @@ let IsApplicableMethApprox g amap m (minfo:MethInfo) availObjTy =
27252716
|> CommitOperationResult
27262717
| _ -> true
27272718
else
2728-
true
2729-
2719+
true

‎tests/fsharpqa/Source/Conformance/DeclarationElements/MemberDefinitions/OverloadingMembers/OverloadsAndSRTPs01.fs‎

Lines changed: 38 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,38 @@
1+
// #Conformance #DeclarationElements #MemberDefinitions #Overloading
2+
// Exotic case from F#+ https://github.com/gusty/FSharpPlus
3+
4+
module Applicatives =
5+
open System
6+
7+
type Ap = Ap with
8+
static member inline Invoke (x:'T) : '``Applicative<'T>`` =
9+
let inline call (mthd : ^M, output : ^R) = ((^M or ^R) : (static member Return: _*_ -> _) output, mthd)
10+
call (Ap, Unchecked.defaultof<'``Applicative<'T>``>) x
11+
static member inline InvokeOnInstance (x:'T) = (^``Applicative<'T>`` : (static member Return: ^T -> ^``Applicative<'T>``) x)
12+
static member inline Return (r:'R , _:obj) = Ap.InvokeOnInstance :_ -> 'R
13+
static member Return (_:seq<'a> , Ap ) = fun x -> Seq.singleton x : seq<'a>
14+
static member Return (_:Tuple<'a>, Ap ) = fun x -> Tuple x : Tuple<'a>
15+
static member Return (_:'r -> 'a , Ap ) = fun k _ -> k : 'a -> 'r -> _
16+
17+
let inline result (x:'T) = Ap.Invoke x
18+
19+
let inline (<*>) (f:'``Applicative<'T->'U>``) (x:'``Applicative<'T>``) : '``Applicative<'U>`` =
20+
(( ^``Applicative<'T->'U>`` or ^``Applicative<'T>`` or ^``Applicative<'U>``) : (static member (<*>): _*_ -> _) f, x)
21+
22+
let inline (+) (a:'Num) (b:'Num) :'Num = a + b
23+
24+
type ZipList<'s> = ZipList of 's seq with
25+
static member Return (x:'a) = ZipList (Seq.initInfinite (fun _ -> x))
26+
static member (<*>) (ZipList (f:seq<'a->'b>), ZipList x) = ZipList (Seq.zip f x |> Seq.map (fun (f, x) -> f x)) :ZipList<'b>
27+
28+
type Ii = Ii
29+
type Idiomatic = Idiomatic with
30+
static member inline ($) (Idiomatic, si) = fun sfi x -> (Idiomatic $ x) (sfi <*> si)
31+
static member ($) (Idiomatic, Ii) = id
32+
let inline idiomatic a b = (Idiomatic $ b) a
33+
let inline iI x = (idiomatic << result) x
34+
35+
let res1n2n3 = iI (+) (result 0M ) (ZipList [1M;2M;3M]) Ii
36+
let res2n3n4 = iI (+) (result LanguagePrimitives.GenericOne) (ZipList [1 ;2 ;3 ]) Ii
37+
38+
exit 0

‎tests/fsharpqa/Source/Conformance/DeclarationElements/MemberDefinitions/OverloadingMembers/RecursiveOverload01.fs‎

Lines changed: 26 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,26 @@
1+
// #Conformance #DeclarationElements #MemberDefinitions #Overloading
2+
// Originally from https://gist.github.com/gusty/b6fac370bff36a665d75
3+
type FoldArgs<'t> = FoldArgs of ('t -> 't -> 't)
4+
5+
let inline foldArgs f (x:'t) (y:'t) :'rest = (FoldArgs f $ Unchecked.defaultof<'rest>) x y
6+
7+
type FoldArgs<'t> with
8+
static member inline ($) (FoldArgs f, _:'t-> 'rest) = fun (a:'t) -> f a >> foldArgs f
9+
static member ($) (FoldArgs f, _:'t ) = f
10+
11+
let test1() =
12+
let x:int = foldArgs (+) 2 3
13+
let y:int = foldArgs (+) 2 3 4
14+
let z:int = foldArgs (+) 2 3 4 5
15+
let d:decimal = foldArgs (+) 2M 3M 4M
16+
let e:string = foldArgs (+) "h" "e" "l" "l" "o"
17+
let f:float = foldArgs (+) 2. 3. 4.
18+
19+
let mult3Numbers a b c = a * b * c
20+
let res2 = mult3Numbers 3 (foldArgs (+) 3 4) (foldArgs (+) 2 2 3 3)
21+
()
22+
23+
// Run the test
24+
test1()
25+
26+
exit 0

‎tests/fsharpqa/Source/Conformance/DeclarationElements/MemberDefinitions/OverloadingMembers/SlowOverloadResolution.fs‎

Lines changed: 2 additions & 2 deletions
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,6 @@
11
// #Conformance #DeclarationElements #MemberDefinitions #Overloading
22
// https://github.com/Microsoft/visualfsharp/issues/351 - slow overlaod resolution
3-
//<Expects id="FS0003" status="error">This value is not a function and cannot be applied</Expects>
3+
//<Expects id="FS0001" status="error">No overloads match</Expects>
44
type Switcher = Switcher
55

66
let inline checker< ^s, ^r when (^s or ^r) : (static member pass : ^r -> unit)> (s : ^s) (r : ^r) = ()
@@ -22,4 +22,4 @@ let main argv =
2222
let res : unit = format () "text" 5 "more text" ()
2323
printfn "%A" res
2424
System.Console.ReadKey()
25-
0 // return an integer exit code
25+
0 // return an integer exit code

‎tests/fsharpqa/Source/Conformance/DeclarationElements/MemberDefinitions/OverloadingMembers/env.lst‎

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -27,6 +27,8 @@ NOMONO,NoMT SOURCE=ConsumeOverloadGenericMethods.fs SCFLAGS="-r:lib.dll" PRECMD=
2727
SOURCE=InferenceForLambdaArgs.fs # InferenceForLambdaArgs.fs
2828

2929
SOURCE=SlowOverloadResolution.fs # SlowOverloadResolution.fs
30+
SOURCE=RecursiveOverload01.fs # RecursiveOverload01.fs
31+
SOURCE=OverloadsAndSRTPs01.fs # OverloadsAndSRTPs01.fs
3032

3133
SOURCE=E_OverloadCurriedFunc.fs # E_OverloadCurriedFunc.fs
3234
SOURCE=NoWarningWhenOverloadingInSubClass01.fs SCFLAGS="--warnaserror" # NoWarningWhenOverloadingInSubClass01.fs

0 commit comments

Comments
 (0)