Movatterモバイル変換

[0]ホーム
URL:

Skip to content

Navigation Menu

Sign in
Appearance settings

Search code, repositories, users, issues, pull requests...

Provide feedback

We read every piece of feedback, and take your input very seriously.

Saved searches

Use saved searches to filter your results more quickly

 Sign up
Appearance settings

Commit925d41c

Browse files
committed
tryDestTyparTy
1 parent663d07f commit925d41c

File tree

3 files changed

+149
-126
lines changed

3 files changed

+149
-126
lines changed

‎src/fsharp/ConstraintSolver.fs‎

Lines changed: 146 additions & 125 deletions
Original file line numberDiff line numberDiff line change
@@ -717,8 +717,13 @@ and solveTypMeetsTyparConstraints (csenv:ConstraintSolverEnv) ndeep m2 trace ty
717717
// Solve constraints on 'tp' w.r.t. 'ty'
718718
cs|> IterateD(function
719719
| TyparConstraint.DefaultsTo(priority,dty,m)->
720-
ifnot(isTyparTy g ty)|| typeEquiv g ty dtythen CompleteDelse
721-
AddConstraint csenv ndeep m2 trace(destTyparTy g ty)(TyparConstraint.DefaultsTo(priority,dty,m))
720+
if typeEquiv g ty dtythen
721+
CompleteD
722+
else
723+
match tryDestTyparTy g tywith
724+
| None-> CompleteD
725+
| Some destTypar->
726+
AddConstraint csenv ndeep m2 trace destTypar(TyparConstraint.DefaultsTo(priority,dty,m))
722727

723728
| TyparConstraint.SupportsNull m2-> SolveTypSupportsNull csenv ndeep m2 trace ty
724729
| TyparConstraint.IsEnum(underlying, m2)-> SolveTypIsEnum csenv ndeep m2 trace ty underlying
@@ -1606,7 +1611,7 @@ and AddConstraint (csenv:ConstraintSolverEnv) ndeep m2 trace tp newConstraint =
16061611
// NOTE: QUADRATIC
16071612
let receliminateRedundant cxs acc=
16081613
match cxswith
1609-
|[]->acc
1614+
|[]-> acc
16101615
| cx:: rest->
16111616
eliminateRedundant rest(if List.exists(fun cx2-> implies cx2 cx) accthen accelse(cx::acc))
16121617

@@ -1624,11 +1629,11 @@ and SolveTypSupportsNull (csenv:ConstraintSolverEnv) ndeep m2 trace ty =
16241629
letg= csenv.g
16251630
letm= csenv.m
16261631
letdenv= csenv.DisplayEnv
1627-
if isTyparTy g tythen
1628-
AddConstraint csenv ndeep m2 trace(destTyparTy g ty)(TyparConstraint.SupportsNull(m))
1629-
elif
1630-
TypeSatisfiesNullConstraint g m tythen CompleteD
1631-
else
1632+
match tryDestTyparTy g tywith
1633+
| Some destTypar->
1634+
AddConstraint csenv ndeep m2 trace destTypar(TyparConstraint.SupportsNull m)
1635+
| None->
1636+
if TypeSatisfiesNullConstraint g m tythen CompleteDelse
16321637
match tywith
16331638
| NullableTy g_->
16341639
ErrorD(ConstraintSolverError(FSComp.SR.csNullableTypeDoesNotHaveNull(NicePrint.minimalStringOfType denv ty),m,m2))
@@ -1640,118 +1645,127 @@ and SolveTypeSupportsComparison (csenv:ConstraintSolverEnv) ndeep m2 trace ty =
16401645
letm= csenv.m
16411646
letamap= csenv.amap
16421647
letdenv= csenv.DisplayEnv
1643-
if isTyparTy g tythen
1644-
AddConstraint csenv ndeep m2 trace(destTyparTy g ty)(TyparConstraint.SupportsComparison(m))
1645-
// Check it isn't ruled out by the user
1646-
elif isAppTy g ty&& HasFSharpAttribute g g.attrib_NoComparisonAttribute(tcrefOfAppTy g ty).Attribsthen
1647-
ErrorD(ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportComparison1(NicePrint.minimalStringOfType denv ty),m,m2))
1648-
else
1649-
match tywith
1650-
| SpecialComparableHeadType g tinst->
1651-
tinst|> IterateD(SolveTypeSupportsComparison(csenv:ConstraintSolverEnv) ndeep m2 trace)
1652-
|_->
1653-
// Check the basic requirement - IComparable or IStructuralComparable or assumed
1654-
if ExistsSameHeadTypeInHierarchy g amap m2 ty g.mk_IComparable_ty||
1655-
ExistsSameHeadTypeInHierarchy g amap m2 ty g.mk_IStructuralComparable_tythen
1656-
1657-
// The type is comparable because it implements IComparable
1658-
if isAppTy g tythen
1659-
lettcref,tinst= destAppTy g ty
1660-
// Check the (possibly inferred) structural dependencies
1661-
(tinst, tcref.TyparsNoRange)||> Iterate2D(fun ty tp->
1662-
if tp.ComparisonConditionalOnthen
1663-
SolveTypeSupportsComparison(csenv:ConstraintSolverEnv) ndeep m2 trace ty
1664-
else
1665-
CompleteD)
1666-
else
1667-
CompleteD
1648+
match tryDestTyparTy g tywith
1649+
| Some destTypar->
1650+
AddConstraint csenv ndeep m2 trace destTypar(TyparConstraint.SupportsComparison m)
1651+
| None->
1652+
// Check it isn't ruled out by the user
1653+
if isAppTy g ty&& HasFSharpAttribute g g.attrib_NoComparisonAttribute(tcrefOfAppTy g ty).Attribsthen
1654+
ErrorD(ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportComparison1(NicePrint.minimalStringOfType denv ty),m,m2))
1655+
else
1656+
match tywith
1657+
| SpecialComparableHeadType g tinst->
1658+
tinst|> IterateD(SolveTypeSupportsComparison(csenv:ConstraintSolverEnv) ndeep m2 trace)
1659+
|_->
1660+
// Check the basic requirement - IComparable or IStructuralComparable or assumed
1661+
if ExistsSameHeadTypeInHierarchy g amap m2 ty g.mk_IComparable_ty||
1662+
ExistsSameHeadTypeInHierarchy g amap m2 ty g.mk_IStructuralComparable_tythen
1663+
1664+
// The type is comparable because it implements IComparable
1665+
if isAppTy g tythen
1666+
lettcref,tinst= destAppTy g ty
1667+
// Check the (possibly inferred) structural dependencies
1668+
(tinst, tcref.TyparsNoRange)||> Iterate2D(fun ty tp->
1669+
if tp.ComparisonConditionalOnthen
1670+
SolveTypeSupportsComparison(csenv:ConstraintSolverEnv) ndeep m2 trace ty
1671+
else
1672+
CompleteD)
1673+
else
1674+
CompleteD
16681675

1669-
// Give a good error for structural types excluded from the comparison relation because of their fields
1670-
elif(isAppTy g ty&&
1671-
lettcref= tcrefOfAppTy g ty
1672-
AugmentWithHashCompare.TyconIsCandidateForAugmentationWithCompare g tcref.Deref&&
1673-
Option.isNone tcref.GeneratedCompareToWithComparerValues)then
1676+
// Give a good error for structural types excluded from the comparison relation because of their fields
1677+
elif(isAppTy g ty&&
1678+
lettcref= tcrefOfAppTy g ty
1679+
AugmentWithHashCompare.TyconIsCandidateForAugmentationWithCompare g tcref.Deref&&
1680+
Option.isNone tcref.GeneratedCompareToWithComparerValues)then
16741681

1675-
ErrorD(ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportComparison3(NicePrint.minimalStringOfType denv ty),m,m2))
1682+
ErrorD(ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportComparison3(NicePrint.minimalStringOfType denv ty),m,m2))
16761683

1677-
else
1678-
ErrorD(ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportComparison2(NicePrint.minimalStringOfType denv ty),m,m2))
1684+
else
1685+
ErrorD(ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportComparison2(NicePrint.minimalStringOfType denv ty),m,m2))
16791686

16801687
andSolveTypSupportsEquality(csenv:ConstraintSolverEnv)ndeep m2 trace ty=
16811688
letg= csenv.g
16821689
letm= csenv.m
16831690
letdenv= csenv.DisplayEnv
1684-
if isTyparTy g tythen
1685-
AddConstraint csenv ndeep m2 trace(destTyparTy g ty)(TyparConstraint.SupportsEquality(m))
1686-
elif isAppTy g ty&& HasFSharpAttribute g g.attrib_NoEqualityAttribute(tcrefOfAppTy g ty).Attribsthen
1687-
ErrorD(ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportEquality1(NicePrint.minimalStringOfType denv ty),m,m2))
1688-
else
1689-
match tywith
1690-
| SpecialEquatableHeadType g tinst->
1691-
tinst|> IterateD(SolveTypSupportsEquality(csenv:ConstraintSolverEnv) ndeep m2 trace)
1692-
| SpecialNotEquatableHeadType g_->
1693-
ErrorD(ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportEquality2(NicePrint.minimalStringOfType denv ty),m,m2))
1694-
|_->
1695-
// The type is equatable because it has Object.Equals(...)
1696-
if isAppTy g tythen
1697-
lettcref,tinst= destAppTy g ty
1698-
1699-
// Give a good error for structural types excluded from the equality relation because of their fields
1700-
if(AugmentWithHashCompare.TyconIsCandidateForAugmentationWithEquals g tcref.Deref&&
1701-
Option.isNone tcref.GeneratedHashAndEqualsWithComparerValues)then
1702-
1703-
ErrorD(ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportEquality3(NicePrint.minimalStringOfType denv ty),m,m2))
1704-
1691+
match tryDestTyparTy g tywith
1692+
| Some destTypar->
1693+
AddConstraint csenv ndeep m2 trace destTypar(TyparConstraint.SupportsEquality m)
1694+
| None->
1695+
if isAppTy g ty&& HasFSharpAttribute g g.attrib_NoEqualityAttribute(tcrefOfAppTy g ty).Attribsthen
1696+
ErrorD(ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportEquality1(NicePrint.minimalStringOfType denv ty),m,m2))
1697+
else
1698+
match tywith
1699+
| SpecialEquatableHeadType g tinst->
1700+
tinst|> IterateD(SolveTypSupportsEquality(csenv:ConstraintSolverEnv) ndeep m2 trace)
1701+
| SpecialNotEquatableHeadType g_->
1702+
ErrorD(ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportEquality2(NicePrint.minimalStringOfType denv ty),m,m2))
1703+
|_->
1704+
// The type is equatable because it has Object.Equals(...)
1705+
if isAppTy g tythen
1706+
lettcref,tinst= destAppTy g ty
1707+
1708+
// Give a good error for structural types excluded from the equality relation because of their fields
1709+
if(AugmentWithHashCompare.TyconIsCandidateForAugmentationWithEquals g tcref.Deref&&
1710+
Option.isNone tcref.GeneratedHashAndEqualsWithComparerValues)then
1711+
1712+
ErrorD(ConstraintSolverError(FSComp.SR.csTypeDoesNotSupportEquality3(NicePrint.minimalStringOfType denv ty),m,m2))
1713+
1714+
else
1715+
// Check the (possibly inferred) structural dependencies
1716+
(tinst, tcref.TyparsNoRange)||> Iterate2D(fun ty tp->
1717+
if tp.EqualityConditionalOnthen
1718+
SolveTypSupportsEquality(csenv:ConstraintSolverEnv) ndeep m2 trace ty
1719+
else
1720+
CompleteD)
17051721
else
1706-
// Check the (possibly inferred) structural dependencies
1707-
(tinst, tcref.TyparsNoRange)||> Iterate2D(fun ty tp->
1708-
if tp.EqualityConditionalOnthen
1709-
SolveTypSupportsEquality(csenv:ConstraintSolverEnv) ndeep m2 trace ty
1710-
else
1711-
CompleteD)
1712-
else
1713-
CompleteD
1722+
CompleteD
17141723

17151724
andSolveTypIsEnum(csenv:ConstraintSolverEnv)ndeep m2 trace ty underlying=
17161725
trackErrors{
17171726
letg= csenv.g
17181727
letm= csenv.m
17191728
letdenv= csenv.DisplayEnv
1720-
if isTyparTy g tythen
1721-
return! AddConstraint csenv ndeep m2 trace(destTyparTy g ty)(TyparConstraint.IsEnum(underlying,m))
1722-
elif isEnumTy g tythen
1723-
do! SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace underlying(underlyingTypeOfEnumTy g ty)
1724-
return! CompleteD
1725-
else
1726-
return! ErrorD(ConstraintSolverError(FSComp.SR.csTypeIsNotEnumType(NicePrint.minimalStringOfType denv ty),m,m2))
1729+
match tryDestTyparTy g tywith
1730+
| Some destTypar->
1731+
return! AddConstraint csenv ndeep m2 trace destTypar(TyparConstraint.IsEnum(underlying,m))
1732+
| None->
1733+
if isEnumTy g tythen
1734+
do! SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace underlying(underlyingTypeOfEnumTy g ty)
1735+
return! CompleteD
1736+
else
1737+
return! ErrorD(ConstraintSolverError(FSComp.SR.csTypeIsNotEnumType(NicePrint.minimalStringOfType denv ty),m,m2))
17271738
}
17281739

17291740
andSolveTypIsDelegate(csenv:ConstraintSolverEnv)ndeep m2 trace ty aty bty=
17301741
trackErrors{
17311742
letg= csenv.g
17321743
letm= csenv.m
17331744
letdenv= csenv.DisplayEnv
1734-
if isTyparTy g tythen
1735-
return! AddConstraint csenv ndeep m2 trace(destTyparTy g ty)(TyparConstraint.IsDelegate(aty,bty,m))
1736-
elif isDelegateTy g tythen
1737-
match TryDestStandardDelegateTyp csenv.InfoReader m AccessibleFromSomewhere tywith
1738-
| Some(tupledArgTy,rty)->
1739-
do! SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace aty tupledArgTy
1740-
do! SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace bty rty
1741-
| None->
1742-
return! ErrorD(ConstraintSolverError(FSComp.SR.csTypeHasNonStandardDelegateType(NicePrint.minimalStringOfType denv ty),m,m2))
1743-
else
1744-
return! ErrorD(ConstraintSolverError(FSComp.SR.csTypeIsNotDelegateType(NicePrint.minimalStringOfType denv ty),m,m2))
1745+
match tryDestTyparTy g tywith
1746+
| Some destTypar->
1747+
return! AddConstraint csenv ndeep m2 trace destTypar(TyparConstraint.IsDelegate(aty,bty,m))
1748+
| None->
1749+
if isDelegateTy g tythen
1750+
match TryDestStandardDelegateTyp csenv.InfoReader m AccessibleFromSomewhere tywith
1751+
| Some(tupledArgTy,rty)->
1752+
do! SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace aty tupledArgTy
1753+
do! SolveTypEqualsTypKeepAbbrevs csenv ndeep m2 trace bty rty
1754+
| None->
1755+
return! ErrorD(ConstraintSolverError(FSComp.SR.csTypeHasNonStandardDelegateType(NicePrint.minimalStringOfType denv ty),m,m2))
1756+
else
1757+
return! ErrorD(ConstraintSolverError(FSComp.SR.csTypeIsNotDelegateType(NicePrint.minimalStringOfType denv ty),m,m2))
17451758
}
17461759

17471760
andSolveTypIsNonNullableValueType(csenv:ConstraintSolverEnv)ndeep m2 trace ty=
17481761
trackErrors{
17491762
letg= csenv.g
17501763
letm= csenv.m
17511764
letdenv= csenv.DisplayEnv
1752-
if isTyparTy g tythen
1753-
return! AddConstraint csenv ndeep m2 trace(destTyparTy g ty)(TyparConstraint.IsNonNullableStruct(m))
1754-
else
1765+
match tryDestTyparTy g tywith
1766+
| Some destTypar->
1767+
return! AddConstraint csenv ndeep m2 trace destTypar(TyparConstraint.IsNonNullableStruct m)
1768+
| None->
17551769
letunderlyingTy= stripTyEqnsAndMeasureEqns g ty
17561770
if isStructTy g underlyingTythen
17571771
if tyconRefEq g g.system_Nullable_tcref(tcrefOfAppTy g underlyingTy)then
@@ -1764,9 +1778,10 @@ and SolveTypIsUnmanaged (csenv:ConstraintSolverEnv) ndeep m2 trace ty =
17641778
letg= csenv.g
17651779
letm= csenv.m
17661780
letdenv= csenv.DisplayEnv
1767-
if isTyparTy g tythen
1768-
AddConstraint csenv ndeep m2 trace(destTyparTy g ty)(TyparConstraint.IsUnmanaged(m))
1769-
else
1781+
match tryDestTyparTy g tywith
1782+
| Some destTypar->
1783+
AddConstraint csenv ndeep m2 trace destTypar(TyparConstraint.IsUnmanaged m)
1784+
| None->
17701785
if isUnmanagedTy g tythen
17711786
CompleteD
17721787
else
@@ -1777,49 +1792,56 @@ and SolveTypChoice (csenv:ConstraintSolverEnv) ndeep m2 trace ty tys =
17771792
letg= csenv.g
17781793
letm= csenv.m
17791794
letdenv= csenv.DisplayEnv
1780-
if isTyparTy g tythen AddConstraint csenv ndeep m2 trace(destTyparTy g ty)(TyparConstraint.SimpleChoice(tys,m))else
1781-
if List.exists(typeEquivAux Erasure.EraseMeasures g ty) tysthen CompleteD
1782-
else ErrorD(ConstraintSolverError(FSComp.SR.csTypeNotCompatibleBecauseOfPrintf((NicePrint.minimalStringOfType denv ty),(String.concat","(List.map(NicePrint.prettyStringOfTy denv) tys))),m,m2))
1795+
match tryDestTyparTy g tywith
1796+
| Some destTypar->
1797+
AddConstraint csenv ndeep m2 trace destTypar(TyparConstraint.SimpleChoice(tys,m))
1798+
| None->
1799+
if List.exists(typeEquivAux Erasure.EraseMeasures g ty) tysthen CompleteD
1800+
else ErrorD(ConstraintSolverError(FSComp.SR.csTypeNotCompatibleBecauseOfPrintf((NicePrint.minimalStringOfType denv ty),(String.concat","(List.map(NicePrint.prettyStringOfTy denv) tys))),m,m2))
17831801

17841802

17851803
andSolveTypIsReferenceType(csenv:ConstraintSolverEnv)ndeep m2 trace ty=
17861804
letg= csenv.g
17871805
letm= csenv.m
17881806
letdenv= csenv.DisplayEnv
1789-
if isTyparTy g tythen AddConstraint csenv ndeep m2 trace(destTyparTy g ty)(TyparConstraint.IsReferenceType(m))
1790-
elif isRefTy g tythen CompleteD
1791-
else ErrorD(ConstraintSolverError(FSComp.SR.csGenericConstructRequiresReferenceSemantics(NicePrint.minimalStringOfType denv ty),m,m))
1807+
match tryDestTyparTy g tywith
1808+
| Some destTypar->
1809+
AddConstraint csenv ndeep m2 trace destTypar(TyparConstraint.IsReferenceType m)
1810+
| None->
1811+
if isRefTy g tythen CompleteD
1812+
else ErrorD(ConstraintSolverError(FSComp.SR.csGenericConstructRequiresReferenceSemantics(NicePrint.minimalStringOfType denv ty),m,m))
17921813

17931814
andSolveTypRequiresDefaultConstructor(csenv:ConstraintSolverEnv)ndeep m2 trace typ=
17941815
letg= csenv.g
17951816
letamap= csenv.amap
17961817
letm= csenv.m
17971818
letdenv= csenv.DisplayEnv
17981819
letty= stripTyEqnsAndMeasureEqns g typ
1799-
if isTyparTy g tythen
1800-
AddConstraint csenv ndeep m2 trace(destTyparTy g ty)(TyparConstraint.RequiresDefaultConstructor(m))
1801-
elif isStructTy g ty&& TypeHasDefaultValue g m tythen
1802-
CompleteD
1803-
elif
1804-
GetIntrinsicConstructorInfosOfType csenv.InfoReader m ty
1805-
|> List.exists(fun x-> IsMethInfoAccessible amap m AccessibleFromEverywhere x&& x.IsNullary)
1806-
then
1807-
if(isAppTy g ty&& HasFSharpAttribute g g.attrib_AbstractClassAttribute(tcrefOfAppTy g ty).Attribs)then
1808-
ErrorD(ConstraintSolverError(FSComp.SR.csGenericConstructRequiresNonAbstract(NicePrint.minimalStringOfType denv typ),m,m2))
1809-
else
1810-
CompleteD
1811-
elif isAppTy g ty&&
1812-
(
1813-
lettcref= tcrefOfAppTy g ty
1814-
tcref.PreEstablishedHasDefaultConstructor||
1815-
// F# 3.1 feature: records with CLIMutable attribute should satisfy 'default constructor' constraint
1816-
(tcref.IsRecordTycon&& HasFSharpAttribute g g.attrib_CLIMutableAttribute tcref.Attribs)
1817-
)
1818-
then
1819-
CompleteD
1820-
else
1821-
ErrorD(ConstraintSolverError(FSComp.SR.csGenericConstructRequiresPublicDefaultConstructor(NicePrint.minimalStringOfType denv typ),m,m2))
1822-
1820+
match tryDestTyparTy g tywith
1821+
| Some destTypar->
1822+
AddConstraint csenv ndeep m2 trace destTypar(TyparConstraint.RequiresDefaultConstructor m)
1823+
| None->
1824+
if isStructTy g ty&& TypeHasDefaultValue g m tythen
1825+
CompleteD
1826+
elif
1827+
GetIntrinsicConstructorInfosOfType csenv.InfoReader m ty
1828+
|> List.exists(fun x-> IsMethInfoAccessible amap m AccessibleFromEverywhere x&& x.IsNullary)
1829+
then
1830+
if(isAppTy g ty&& HasFSharpAttribute g g.attrib_AbstractClassAttribute(tcrefOfAppTy g ty).Attribs)then
1831+
ErrorD(ConstraintSolverError(FSComp.SR.csGenericConstructRequiresNonAbstract(NicePrint.minimalStringOfType denv typ),m,m2))
1832+
else
1833+
CompleteD
1834+
elif isAppTy g ty&&
1835+
(
1836+
lettcref= tcrefOfAppTy g ty
1837+
tcref.PreEstablishedHasDefaultConstructor||
1838+
// F# 3.1 feature: records with CLIMutable attribute should satisfy 'default constructor' constraint
1839+
(tcref.IsRecordTycon&& HasFSharpAttribute g g.attrib_CLIMutableAttribute tcref.Attribs)
1840+
)
1841+
then
1842+
CompleteD
1843+
else
1844+
ErrorD(ConstraintSolverError(FSComp.SR.csGenericConstructRequiresPublicDefaultConstructor(NicePrint.minimalStringOfType denv typ),m,m2))
18231845

18241846
// Parameterized compatibility relation between member signatures. The real work
18251847
// is done by "equateTypes" and "subsumeTypes" and "subsumeArg"
@@ -1863,7 +1885,6 @@ and CanMemberSigsMatchUpToCheck
18631885
ErrorD(Error(FSComp.SR.csMemberIsNotStatic(minfo.LogicalName),m))
18641886
else
18651887
ErrorD(Error(FSComp.SR.csMemberIsNotInstance(minfo.LogicalName),m))
1866-
18671888
else
18681889
Iterate2D subsumeTypes calledObjArgTys callerObjArgTys++(fun()->
18691890
(calledMeth.ArgSets|> IterateD(fun argSet->

0 commit comments

Comments
 (0)
[8]ページ先頭
©2009-2025 Movatter.jp