Skip to content
体验新版
项目
组织
正在加载...
登录
切换导航
打开侧边栏
dotNET Platform
fsharp
提交
7377b02e
F
fsharp
项目概览
dotNET Platform
/
fsharp
12 个月 前同步成功
通知
0
Star
1
Fork
0
代码
文件
提交
分支
Tags
贡献者
分支图
Diff
Issue
0
列表
看板
标记
里程碑
合并请求
0
DevOps
流水线
流水线任务
计划
Wiki
0
Wiki
分析
仓库
DevOps
项目成员
Pages
F
fsharp
项目概览
项目概览
详情
发布
仓库
仓库
文件
提交
分支
标签
贡献者
分支图
比较
Issue
0
Issue
0
列表
看板
标记
里程碑
合并请求
0
合并请求
0
Pages
DevOps
DevOps
流水线
流水线任务
计划
分析
分析
仓库分析
DevOps
Wiki
0
Wiki
成员
成员
收起侧边栏
关闭侧边栏
动态
分支图
创建新Issue
流水线任务
提交
Issue看板
体验新版 GitCode,发现更多精彩内容 >>
未验证
提交
7377b02e
编写于
2月 13, 2018
作者:
D
Don Syme
提交者:
GitHub
2月 13, 2018
浏览文件
操作
浏览文件
下载
电子邮件补丁
差异文件
Revert #4173 (i.e. reapply #1650 and #3366)" (#4347)
This reverts commit
f9893b6a
.
上级
a1c55cf7
变更
5
隐藏空白更改
内联
并排
Showing
5 changed file
with
36 addition
and
92 deletion
+36
-92
src/fsharp/ConstraintSolver.fs
src/fsharp/ConstraintSolver.fs
+34
-24
tests/fsharpqa/Source/Conformance/DeclarationElements/MemberDefinitions/OverloadingMembers/OverloadsAndSRTPs01.fs
...mberDefinitions/OverloadingMembers/OverloadsAndSRTPs01.fs
+0
-38
tests/fsharpqa/Source/Conformance/DeclarationElements/MemberDefinitions/OverloadingMembers/RecursiveOverload01.fs
...mberDefinitions/OverloadingMembers/RecursiveOverload01.fs
+0
-26
tests/fsharpqa/Source/Conformance/DeclarationElements/MemberDefinitions/OverloadingMembers/SlowOverloadResolution.fs
...rDefinitions/OverloadingMembers/SlowOverloadResolution.fs
+2
-2
tests/fsharpqa/Source/Conformance/DeclarationElements/MemberDefinitions/OverloadingMembers/env.lst
...tionElements/MemberDefinitions/OverloadingMembers/env.lst
+0
-2
未找到文件。
src/fsharp/ConstraintSolver.fs
浏览文件 @
7377b02e
...
...
@@ -372,6 +372,7 @@ let ShowAccessDomain ad =
// Solve
exception
NonRigidTypar
of
DisplayEnv
*
string
option
*
range
*
TType
*
TType
*
range
exception
LocallyAbortOperationThatFailsToResolveOverload
exception
LocallyAbortOperationThatLosesAbbrevs
let
localAbortD
=
ErrorD
LocallyAbortOperationThatLosesAbbrevs
...
...
@@ -740,19 +741,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
ndeep
m2
trace
traitInfo
++
(
fun
_
->
CompleteD
)
|
TyparConstraint
.
MayResolveMember
(
traitInfo
,
m2
)
->
SolveMemberConstraint
csenv
false
false
ndeep
m2
trace
traitInfo
++
(
fun
_
->
CompleteD
)
)))
...
...
@@ -762,7 +763,6 @@ 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
->
...
...
@@ -770,6 +770,8 @@ and SolveTypEqualsTyp (csenv:ConstraintSolverEnv) ndeep m2 (trace: OptionalTrace
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
...
...
@@ -943,7 +945,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
)
permitWeakResolution
ndeep
m2
trace
(
TTrait
(
tys
,
nm
,
memFlags
,
argtys
,
rty
,
sln
))
:
OperationResult
<
bool
>
=
and
SolveMemberConstraint
(
csenv
:
ConstraintSolverEnv
)
ignoreUnresolvedOverload
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
...
...
@@ -1300,9 +1302,12 @@ and SolveMemberConstraint (csenv:ConstraintSolverEnv) permitWeakResolution ndeep
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
()
->
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
()
->
match
errors
with
|
ErrorResult
(_,
UnresolvedOverloading
_)
when
not
ignoreUnresolvedOverload
&&
(
not
(
nm
=
"op_Explicit"
||
nm
=
"op_Implicit"
))
->
ErrorD
LocallyAbortOperationThatFailsToResolveOverload
|
_
->
ResultD
TTraitUnsolved
)
)
++
(
fun
res
->
RecordMemberConstraintSolution
csenv
.
SolverState
m
trace
traitInfo
res
))
...
...
@@ -1444,7 +1449,7 @@ and SolveRelevantMemberConstraintsForTypar (csenv:ConstraintSolverEnv) ndeep per
cxs
|>
AtLeastOneD
(
fun
(
traitInfo
,
m2
)
->
let
csenv
=
{
csenv
with
m
=
m2
}
SolveMemberConstraint
csenv
permitWeakResolution
(
ndeep
+
1
)
m2
trace
traitInfo
)
SolveMemberConstraint
csenv
true
permitWeakResolution
(
ndeep
+
1
)
m2
trace
traitInfo
)
and
CanonicalizeRelevantMemberConstraints
(
csenv
:
ConstraintSolverEnv
)
ndeep
trace
tps
=
SolveRelevantMemberConstraints
csenv
ndeep
true
trace
tps
...
...
@@ -1959,10 +1964,12 @@ 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
)
(
fun
res
->
match
csenv
.
eContextInfo
with
|
ContextInfo
.
RuntimeTypeTest
isOperator
->
// test if we can cast other way around
(
function
|
LocallyAbortOperationThatFailsToResolveOverload
->
CompleteD
|
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
))
...
...
@@ -1970,7 +1977,9 @@ and private SolveTypSubsumesTypWithReport (csenv:ConstraintSolverEnv) ndeep m tr
and
private
SolveTypEqualsTypWithReport
(
csenv
:
ConstraintSolverEnv
)
ndeep
m
trace
cxsln
ty1
ty2
=
TryD
(
fun
()
->
SolveTypEqualsTypKeepAbbrevsWithCxsln
csenv
ndeep
m
trace
cxsln
ty1
ty2
)
(
fun
res
->
ErrorD
(
ErrorFromAddingTypeEquation
(
csenv
.
g
,
csenv
.
DisplayEnv
,
ty1
,
ty2
,
res
,
m
)))
(
function
|
LocallyAbortOperationThatFailsToResolveOverload
->
CompleteD
|
res
->
ErrorD
(
ErrorFromAddingTypeEquation
(
csenv
.
g
,
csenv
.
DisplayEnv
,
ty1
,
ty2
,
res
,
m
)))
and
ArgsMustSubsumeOrConvert
(
csenv
:
ConstraintSolverEnv
)
...
...
@@ -2536,7 +2545,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
)
false
0
m
trace
traitInfo
++
(
fun
_
->
CompleteD
))
TryD
(
fun
()
->
SolveMemberConstraint
(
MakeConstraintSolverEnv
ContextInfo
.
NoContext
css
m
denv
)
true
false
0
m
trace
traitInfo
++
(
fun
_
->
CompleteD
))
(
fun
res
->
ErrorD
(
ErrorFromAddingConstraint
(
denv
,
res
,
m
)))
|>
RaiseOperationResult
...
...
@@ -2594,7 +2603,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
0
m
NoTrace
traitInfo
++
(
fun
_
res
->
SolveMemberConstraint
csenv
true
true
0
m
NoTrace
traitInfo
++
(
fun
_
res
->
let
sln
=
match
traitInfo
.
Solution
with
|
None
->
Choice4Of4
()
...
...
@@ -2719,4 +2728,5 @@ let IsApplicableMethApprox g amap m (minfo:MethInfo) availObjTy =
|>
CommitOperationResult
|
_
->
true
else
true
\ No newline at end of file
true
tests/fsharpqa/Source/Conformance/DeclarationElements/MemberDefinitions/OverloadingMembers/OverloadsAndSRTPs01.fs
已删除
100644 → 0
浏览文件 @
a1c55cf7
// #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
0
M
)
(
ZipList
[
1
M
;
2
M
;
3
M
])
Ii
let
res2n3n4
=
iI
(+)
(
result
LanguagePrimitives
.
GenericOne
)
(
ZipList
[
1
;
2
;
3
])
Ii
exit
0
\ No newline at end of file
tests/fsharpqa/Source/Conformance/DeclarationElements/MemberDefinitions/OverloadingMembers/RecursiveOverload01.fs
已删除
100644 → 0
浏览文件 @
a1c55cf7
// #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
(+)
2
M
3
M
4
M
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
\ No newline at end of file
tests/fsharpqa/Source/Conformance/DeclarationElements/MemberDefinitions/OverloadingMembers/SlowOverloadResolution.fs
浏览文件 @
7377b02e
// #Conformance #DeclarationElements #MemberDefinitions #Overloading
// https://github.com/Microsoft/visualfsharp/issues/351 - slow overlaod resolution
//<Expects id="FS000
1" status="error">No overloads match
</Expects>
//<Expects id="FS000
3" status="error">This value is not a function and cannot be applied
</Expects>
type
Switcher
=
Switcher
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 =
let
res
:
unit
=
format
()
"text"
5
"more text"
()
printfn
"%A"
res
System
.
Console
.
ReadKey
()
0
// return an integer exit code
\ No newline at end of file
0
// return an integer exit code
tests/fsharpqa/Source/Conformance/DeclarationElements/MemberDefinitions/OverloadingMembers/env.lst
浏览文件 @
7377b02e
...
...
@@ -27,8 +27,6 @@ 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
...
...
编辑
预览
Markdown
is supported
0%
请重试
或
添加新附件
.
添加附件
取消
You are about to add
0
people
to the discussion. Proceed with caution.
先完成此消息的编辑!
取消
想要评论请
注册
或
登录