Skip to content
体验新版
项目
组织
正在加载...
登录
切换导航
打开侧边栏
dotNET Platform
fsharp
提交
cbe19c3a
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,发现更多精彩内容 >>
提交
cbe19c3a
编写于
7月 12, 2022
作者:
D
Don Syme
浏览文件
操作
浏览文件
下载
差异文件
merge part of main
上级
52394f75
ebd32a78
变更
14
展开全部
隐藏空白更改
内联
并排
Showing
14 changed file
with
1876 addition
and
1458 deletion
+1876
-1458
.fantomasignore
.fantomasignore
+0
-1
src/Compiler/Facilities/BuildGraph.fs
src/Compiler/Facilities/BuildGraph.fs
+147
-109
src/Compiler/Facilities/CompilerLocation.fs
src/Compiler/Facilities/CompilerLocation.fs
+215
-138
src/Compiler/Facilities/DiagnosticOptions.fs
src/Compiler/Facilities/DiagnosticOptions.fs
+15
-15
src/Compiler/Facilities/DiagnosticResolutionHints.fs
src/Compiler/Facilities/DiagnosticResolutionHints.fs
+40
-29
src/Compiler/Facilities/DiagnosticsLogger.fs
src/Compiler/Facilities/DiagnosticsLogger.fs
+349
-272
src/Compiler/Facilities/LanguageFeatures.fs
src/Compiler/Facilities/LanguageFeatures.fs
+95
-93
src/Compiler/Facilities/Logger.fs
src/Compiler/Facilities/Logger.fs
+15
-15
src/Compiler/Facilities/ReferenceResolver.fs
src/Compiler/Facilities/ReferenceResolver.fs
+25
-27
src/Compiler/Facilities/SimulatedMSBuildReferenceResolver.fs
src/Compiler/Facilities/SimulatedMSBuildReferenceResolver.fs
+188
-94
src/Compiler/Facilities/TextLayoutRender.fs
src/Compiler/Facilities/TextLayoutRender.fs
+97
-63
src/Compiler/Facilities/prim-lexing.fs
src/Compiler/Facilities/prim-lexing.fs
+324
-302
src/Compiler/Facilities/prim-parsing.fs
src/Compiler/Facilities/prim-parsing.fs
+363
-299
src/Compiler/Facilities/prim-parsing.fsi
src/Compiler/Facilities/prim-parsing.fsi
+3
-1
未找到文件。
.fantomasignore
浏览文件 @
cbe19c3a
...
...
@@ -16,7 +16,6 @@ artifacts/
src/Compiler/Checking/**/*.fs
src/Compiler/CodeGen/**/*.fs
src/Compiler/DependencyManager/**/*.fs
src/Compiler/Facilities/**/*.fs
src/Compiler/Interactive/**/*.fs
src/Compiler/Legacy/**/*.fs
src/Compiler/Optimize/**/*.fs
...
...
src/Compiler/Facilities/BuildGraph.fs
浏览文件 @
cbe19c3a
此差异已折叠。
点击以展开。
src/Compiler/Facilities/CompilerLocation.fs
浏览文件 @
cbe19c3a
此差异已折叠。
点击以展开。
src/Compiler/Facilities/DiagnosticOptions.fs
浏览文件 @
cbe19c3a
...
...
@@ -6,28 +6,28 @@
namespace
FSharp
.
Compiler
.
Diagnostics
[<
RequireQualifiedAccess
>]
type
FSharpDiagnosticSeverity
=
type
FSharpDiagnosticSeverity
=
|
Hidden
|
Info
|
Warning
|
Warning
|
Error
type
FSharpDiagnosticOptions
=
{
WarnLevel
:
int
GlobalWarnAsError
:
bool
WarnOff
:
int
list
WarnOn
:
int
list
WarnAsError
:
int
list
WarnAsWarn
:
int
list
WarnLevel
:
int
GlobalWarnAsError
:
bool
WarnOff
:
int
list
WarnOn
:
int
list
WarnAsError
:
int
list
WarnAsWarn
:
int
list
}
static
member
Default
=
{
WarnLevel
=
3
GlobalWarnAsError
=
false
WarnOff
=
[]
WarnOn
=
[]
WarnAsError
=
[]
WarnAsWarn
=
[]
WarnLevel
=
3
GlobalWarnAsError
=
false
WarnOff
=
[]
WarnOn
=
[]
WarnAsError
=
[]
WarnAsWarn
=
[]
}
src/Compiler/Facilities/DiagnosticResolutionHints.fs
浏览文件 @
cbe19c3a
...
...
@@ -20,58 +20,65 @@ let minStringLengthForSuggestion = 3
/// The threshold is set to about a quarter of the number of characters.
let
IsInEditDistanceProximity
idText
suggestion
=
let
editDistance
=
EditDistance
.
CalculateEditDistance
(
idText
,
suggestion
)
let
threshold
=
match
idText
.
Length
with
|
x
when
x
<
5
->
1
|
x
when
x
<
7
->
2
|
x
->
x
/
4
+
1
editDistance
<=
threshold
/// Demangles a suggestion
let
DemangleOperator
(
nm
:
string
)
=
if
nm
.
StartsWithOrdinal
(
"( "
)
&&
nm
.
EndsWithOrdinal
(
" )"
)
then
nm
[
2
..
nm
.
Length
-
3
]
else
nm
[
2
..
nm
.
Length
-
3
]
else
nm
type
SuggestionBufferEnumerator
(
tail
:
int
,
data
:
KeyValuePair
<
float
,
string
>
[]
)
=
type
SuggestionBufferEnumerator
(
tail
:
int
,
data
:
KeyValuePair
<
float
,
string
>
[])
=
let
mutable
current
=
data
.
Length
interface
IEnumerator
<
string
>
with
member
_.
Current
with
get
()
=
let
kvpr
=
&
data
[
current
]
kvpr
.
Value
member
_.
Current
=
let
kvpr
=
&
data
[
current
]
kvpr
.
Value
interface
IEnumerator
with
member
_.
Current
with
get
()
=
box
data
[
current
].
Value
member
_.
Current
=
box
data
[
current
].
Value
member
_.
MoveNext
()
=
current
<-
current
-
1
current
>
tail
||
(
current
=
tail
&&
data
[
current
]
<>
Unchecked
.
defaultof
<_>)
member
_.
Reset
()
=
current
<-
data
.
Length
member
_.
Reset
()
=
current
<-
data
.
Length
interface
System
.
IDisposable
with
member
_.
Dispose
()
=
()
member
_.
Dispose
()
=
()
type
SuggestionBuffer
(
idText
:
string
)
=
let
data
=
Array
.
zeroCreate
<
KeyValuePair
<
float
,
string
>>
(
maxSuggestions
)
type
SuggestionBuffer
(
idText
:
string
)
=
let
data
=
Array
.
zeroCreate
<
KeyValuePair
<
float
,
string
>>
(
maxSuggestions
)
let
mutable
tail
=
maxSuggestions
-
1
let
uppercaseText
=
idText
.
ToUpperInvariant
()
let
dotIdText
=
"."
+
idText
let
mutable
disableSuggestions
=
idText
.
Length
<
minStringLengthForSuggestion
let
insert
(
k
,
v
)
=
let
insert
(
k
,
v
)
=
let
mutable
pos
=
tail
while
pos
<
maxSuggestions
&&
(
let
kv
=
&
data
[
pos
]
in
kv
.
Key
<
k
)
do
pos
<-
pos
+
1
if
pos
>
0
then
if
pos
>=
maxSuggestions
||
(
let
kv
=
&
data
[
pos
]
in
k
<>
kv
.
Key
||
v
<>
kv
.
Value
)
then
if
tail
<
pos
-
1
then
for
i
=
tail
to
pos
-
2
do
for
i
=
tail
to
pos
-
2
do
data
[
i
]
<-
data
[
i
+
1
]
data
[
pos
-
1
]
<-
KeyValuePair
(
k
,
v
)
data
[
pos
-
1
]
<-
KeyValuePair
(
k
,
v
)
if
tail
>
0
then
tail
<-
tail
-
1
member
_.
Add
(
suggestion
:
string
)
=
member
_.
Add
(
suggestion
:
string
)
=
if
not
disableSuggestions
then
if
suggestion
=
idText
then
// some other parse error happened
disableSuggestions
<-
true
...
...
@@ -80,29 +87,33 @@ type SuggestionBuffer(idText: string) =
// value as well as to formally squelch the associated compiler
// error/warning (FS1182), we remove such names from the suggestions,
// both to prevent accidental usages as well as to encourage good taste
if
suggestion
.
Length
>=
minStringLengthForSuggestion
&&
not
(
suggestion
.
StartsWithOrdinal
"_"
)
then
let
suggestion
:
string
=
DemangleOperator
suggestion
if
suggestion
.
Length
>=
minStringLengthForSuggestion
&&
not
(
suggestion
.
StartsWithOrdinal
"_"
)
then
let
suggestion
:
string
=
DemangleOperator
suggestion
let
suggestedText
=
suggestion
.
ToUpperInvariant
()
let
similarity
=
EditDistance
.
JaroWinklerDistance
uppercaseText
suggestedText
if
similarity
>=
highConfidenceThreshold
||
suggestion
.
EndsWithOrdinal
dotIdText
||
(
similarity
>=
minThresholdForSuggestions
&&
IsInEditDistanceProximity
uppercaseText
suggestedText
)
then
insert
(
similarity
,
suggestion
)
member
_.
Disabled
with
get
()
=
disableSuggestions
member
_.
IsEmpty
with
get
()
=
disableSuggestions
||
(
tail
=
maxSuggestions
-
1
)
if
similarity
>=
highConfidenceThreshold
||
suggestion
.
EndsWithOrdinal
dotIdText
||
(
similarity
>=
minThresholdForSuggestions
&&
IsInEditDistanceProximity
uppercaseText
suggestedText
)
then
insert
(
similarity
,
suggestion
)
member
_.
Disabled
=
disableSuggestions
member
_.
IsEmpty
=
disableSuggestions
||
(
tail
=
maxSuggestions
-
1
)
interface
IEnumerable
<
string
>
with
member
this
.
GetEnumerator
()
=
member
this
.
GetEnumerator
()
=
if
this
.
IsEmpty
then
Seq
.
empty
.
GetEnumerator
()
else
new
SuggestionBufferEnumerator
(
tail
,
data
)
:>
IEnumerator
<
string
>
interface
IEnumerable
with
member
this
.
GetEnumerator
()
=
member
this
.
GetEnumerator
()
=
if
this
.
IsEmpty
then
Seq
.
empty
.
GetEnumerator
()
:>
IEnumerator
else
...
...
src/Compiler/Facilities/DiagnosticsLogger.fs
浏览文件 @
cbe19c3a
此差异已折叠。
点击以展开。
src/Compiler/Facilities/LanguageFeatures.fs
浏览文件 @
cbe19c3a
...
...
@@ -6,7 +6,7 @@ module internal FSharp.Compiler.Features
//------------------------------------------------------------------------------------------------------------------
// Language version command line switch
//------------------------------------------------------------------------------------------------------------------
// Add your features to this List - in code use languageVersion.SupportsFeature(LanguageFeatures.yourFeature)
// Add your features to this List - in code use languageVersion.SupportsFeature(LanguageFeatures.yourFeature)
// a return value of false means your feature is not supported by the user's language selection
// All new language features added from now on must be protected by this.
// Note:
...
...
@@ -52,69 +52,72 @@ type LanguageFeature =
|
ErrorOnDeprecatedRequireQualifiedAccess
/// LanguageVersion management
type
LanguageVersion
(
versionText
)
=
type
LanguageVersion
(
versionText
)
=
// When we increment language versions here preview is higher than current RTM version
static
let
languageVersion46
=
4
.
6
m
static
let
languageVersion47
=
4
.
7
m
static
let
languageVersion50
=
5
.
0
m
static
let
languageVersion60
=
6
.
0
m
static
let
previewVersion
=
9999
m
// Language version when preview specified
static
let
defaultVersion
=
languageVersion60
// Language version when default specified
static
let
latestVersion
=
defaultVersion
// Language version when latest specified
static
let
latestMajorVersion
=
languageVersion60
// Language version when latestmajor specified
static
let
previewVersion
=
9999
m
// Language version when preview specified
static
let
defaultVersion
=
languageVersion60
// Language version when default specified
static
let
latestVersion
=
defaultVersion
// Language version when latest specified
static
let
latestMajorVersion
=
languageVersion60
// Language version when latestmajor specified
static
let
validOptions
=
[|
"preview"
;
"default"
;
"latest"
;
"latestmajor"
|]
static
let
languageVersions
=
set
[|
languageVersion46
;
languageVersion47
;
languageVersion50
;
languageVersion60
|]
static
let
languageVersions
=
set
[|
languageVersion46
;
languageVersion47
;
languageVersion50
;
languageVersion60
|]
static
let
features
=
dict
[
// F# 4.7
LanguageFeature
.
SingleUnderscorePattern
,
languageVersion47
LanguageFeature
.
WildCardInForLoop
,
languageVersion47
LanguageFeature
.
RelaxWhitespace
,
languageVersion47
LanguageFeature
.
ImplicitYield
,
languageVersion47
// F# 5.0
LanguageFeature
.
FixedIndexSlice3d4d
,
languageVersion50
LanguageFeature
.
DotlessFloat32Literal
,
languageVersion50
LanguageFeature
.
AndBang
,
languageVersion50
LanguageFeature
.
NullableOptionalInterop
,
languageVersion50
LanguageFeature
.
DefaultInterfaceMemberConsumption
,
languageVersion50
LanguageFeature
.
OpenTypeDeclaration
,
languageVersion50
LanguageFeature
.
PackageManagement
,
languageVersion50
LanguageFeature
.
WitnessPassing
,
languageVersion50
LanguageFeature
.
InterfacesWithMultipleGenericInstantiation
,
languageVersion50
LanguageFeature
.
NameOf
,
languageVersion50
LanguageFeature
.
StringInterpolation
,
languageVersion50
// F# 6.0
LanguageFeature
.
AdditionalTypeDirectedConversions
,
languageVersion60
LanguageFeature
.
RelaxWhitespace2
,
languageVersion60
LanguageFeature
.
OverloadsForCustomOperations
,
languageVersion60
LanguageFeature
.
ExpandedMeasurables
,
languageVersion60
LanguageFeature
.
ResumableStateMachines
,
languageVersion60
LanguageFeature
.
StructActivePattern
,
languageVersion60
LanguageFeature
.
PrintfBinaryFormat
,
languageVersion60
LanguageFeature
.
IndexerNotationWithoutDot
,
languageVersion60
LanguageFeature
.
RefCellNotationInformationals
,
languageVersion60
LanguageFeature
.
UseBindingValueDiscard
,
languageVersion60
LanguageFeature
.
NonVariablePatternsToRightOfAsPatterns
,
languageVersion60
LanguageFeature
.
AttributesToRightOfModuleKeyword
,
languageVersion60
LanguageFeature
.
DelegateTypeNameResolutionFix
,
languageVersion60
// F# preview
LanguageFeature
.
FromEndSlicing
,
previewVersion
LanguageFeature
.
ExtensionConstraintSolutions
,
previewVersion
LanguageFeature
.
MLCompatRevisions
,
previewVersion
LanguageFeature
.
BetterExceptionPrinting
,
previewVersion
LanguageFeature
.
ReallyLongLists
,
previewVersion
LanguageFeature
.
ErrorOnDeprecatedRequireQualifiedAccess
,
previewVersion
]
dict
[
// F# 4.7
LanguageFeature
.
SingleUnderscorePattern
,
languageVersion47
LanguageFeature
.
WildCardInForLoop
,
languageVersion47
LanguageFeature
.
RelaxWhitespace
,
languageVersion47
LanguageFeature
.
ImplicitYield
,
languageVersion47
// F# 5.0
LanguageFeature
.
FixedIndexSlice3d4d
,
languageVersion50
LanguageFeature
.
DotlessFloat32Literal
,
languageVersion50
LanguageFeature
.
AndBang
,
languageVersion50
LanguageFeature
.
NullableOptionalInterop
,
languageVersion50
LanguageFeature
.
DefaultInterfaceMemberConsumption
,
languageVersion50
LanguageFeature
.
OpenTypeDeclaration
,
languageVersion50
LanguageFeature
.
PackageManagement
,
languageVersion50
LanguageFeature
.
WitnessPassing
,
languageVersion50
LanguageFeature
.
InterfacesWithMultipleGenericInstantiation
,
languageVersion50
LanguageFeature
.
NameOf
,
languageVersion50
LanguageFeature
.
StringInterpolation
,
languageVersion50
// F# 6.0
LanguageFeature
.
AdditionalTypeDirectedConversions
,
languageVersion60
LanguageFeature
.
RelaxWhitespace2
,
languageVersion60
LanguageFeature
.
OverloadsForCustomOperations
,
languageVersion60
LanguageFeature
.
ExpandedMeasurables
,
languageVersion60
LanguageFeature
.
ResumableStateMachines
,
languageVersion60
LanguageFeature
.
StructActivePattern
,
languageVersion60
LanguageFeature
.
PrintfBinaryFormat
,
languageVersion60
LanguageFeature
.
IndexerNotationWithoutDot
,
languageVersion60
LanguageFeature
.
RefCellNotationInformationals
,
languageVersion60
LanguageFeature
.
UseBindingValueDiscard
,
languageVersion60
LanguageFeature
.
NonVariablePatternsToRightOfAsPatterns
,
languageVersion60
LanguageFeature
.
AttributesToRightOfModuleKeyword
,
languageVersion60
LanguageFeature
.
DelegateTypeNameResolutionFix
,
languageVersion60
// F# preview
LanguageFeature
.
FromEndSlicing
,
previewVersion
LanguageFeature
.
ExtensionConstraintSolutions
,
previewVersion
LanguageFeature
.
MLCompatRevisions
,
previewVersion
LanguageFeature
.
BetterExceptionPrinting
,
previewVersion
LanguageFeature
.
ReallyLongLists
,
previewVersion
LanguageFeature
.
ErrorOnDeprecatedRequireQualifiedAccess
,
previewVersion
]
static
let
defaultLanguageVersion
=
LanguageVersion
(
"default"
)
static
let
getVersionFromString
(
version
:
string
)
=
static
let
getVersionFromString
(
version
:
string
)
=
match
version
.
ToUpperInvariant
()
with
|
"?"
->
0
m
|
"PREVIEW"
->
previewVersion
...
...
@@ -123,15 +126,16 @@ type LanguageVersion (versionText) =
|
"LATESTMAJOR"
->
latestMajorVersion
|
"4.6"
->
languageVersion46
|
"4.7"
->
languageVersion47
|
"5.0"
|
"5"
->
languageVersion50
|
"6.0"
|
"6"
->
languageVersion60
|
"5.0"
|
"5"
->
languageVersion50
|
"6.0"
|
"6"
->
languageVersion60
|
_
->
0
m
let
specified
=
getVersionFromString
versionText
let
versionToString
v
=
if
v
=
previewVersion
then
"'PREVIEW'"
else
string
v
if
v
=
previewVersion
then
"'PREVIEW'"
else
string
v
let
specifiedString
=
versionToString
specified
...
...
@@ -147,8 +151,7 @@ type LanguageVersion (versionText) =
v
<>
0
.
0
m
&&
v
<=
5
.
0
m
/// Has preview been explicitly specified
member
_.
IsPreviewEnabled
=
specified
=
previewVersion
member
_.
IsPreviewEnabled
=
specified
=
previewVersion
/// Does the languageVersion support this version string
member
_.
ContainsVersion
version
=
...
...
@@ -161,8 +164,7 @@ type LanguageVersion (versionText) =
/// Get a list of valid versions for help text
member
_.
ValidVersions
=
[|
for
v
in
languageVersions
|>
Seq
.
sort
->
sprintf
"%M%s"
v
(
if
v
=
defaultVersion
then
" (Default)"
else
""
)
for
v
in
languageVersions
|>
Seq
.
sort
->
sprintf
"%M%s"
v
(
if
v
=
defaultVersion
then
" (Default)"
else
""
)
|]
/// Get the text used to specify the version
...
...
@@ -177,40 +179,40 @@ type LanguageVersion (versionText) =
/// Get a string name for the given feature.
member
_.
GetFeatureString
feature
=
match
feature
with
|
LanguageFeature
.
SingleUnderscorePattern
->
FSComp
.
SR
.
featureSingleUnderscorePattern
()
|
LanguageFeature
.
WildCardInForLoop
->
FSComp
.
SR
.
featureWildCardInForLoop
()
|
LanguageFeature
.
RelaxWhitespace
->
FSComp
.
SR
.
featureRelaxWhitespace
()
|
LanguageFeature
.
RelaxWhitespace2
->
FSComp
.
SR
.
featureRelaxWhitespace2
()
|
LanguageFeature
.
NameOf
->
FSComp
.
SR
.
featureNameOf
()
|
LanguageFeature
.
ImplicitYield
->
FSComp
.
SR
.
featureImplicitYield
()
|
LanguageFeature
.
OpenTypeDeclaration
->
FSComp
.
SR
.
featureOpenTypeDeclaration
()
|
LanguageFeature
.
DotlessFloat32Literal
->
FSComp
.
SR
.
featureDotlessFloat32Literal
()
|
LanguageFeature
.
PackageManagement
->
FSComp
.
SR
.
featurePackageManagement
()
|
LanguageFeature
.
FromEndSlicing
->
FSComp
.
SR
.
featureFromEndSlicing
()
|
LanguageFeature
.
FixedIndexSlice3d4d
->
FSComp
.
SR
.
featureFixedIndexSlice3d4d
()
|
LanguageFeature
.
AndBang
->
FSComp
.
SR
.
featureAndBang
()
|
LanguageFeature
.
ResumableStateMachines
->
FSComp
.
SR
.
featureResumableStateMachines
()
|
LanguageFeature
.
NullableOptionalInterop
->
FSComp
.
SR
.
featureNullableOptionalInterop
()
|
LanguageFeature
.
DefaultInterfaceMemberConsumption
->
FSComp
.
SR
.
featureDefaultInterfaceMemberConsumption
()
|
LanguageFeature
.
WitnessPassing
->
FSComp
.
SR
.
featureWitnessPassing
()
|
LanguageFeature
.
AdditionalTypeDirectedConversions
->
FSComp
.
SR
.
featureAdditionalImplicitConversions
()
|
LanguageFeature
.
InterfacesWithMultipleGenericInstantiation
->
FSComp
.
SR
.
featureInterfacesWithMultipleGenericInstantiation
()
|
LanguageFeature
.
StringInterpolation
->
FSComp
.
SR
.
featureStringInterpolation
()
|
LanguageFeature
.
OverloadsForCustomOperations
->
FSComp
.
SR
.
featureOverloadsForCustomOperations
()
|
LanguageFeature
.
ExpandedMeasurables
->
FSComp
.
SR
.
featureExpandedMeasurables
()
|
LanguageFeature
.
SingleUnderscorePattern
->
FSComp
.
SR
.
featureSingleUnderscorePattern
()
|
LanguageFeature
.
WildCardInForLoop
->
FSComp
.
SR
.
featureWildCardInForLoop
()
|
LanguageFeature
.
RelaxWhitespace
->
FSComp
.
SR
.
featureRelaxWhitespace
()
|
LanguageFeature
.
RelaxWhitespace2
->
FSComp
.
SR
.
featureRelaxWhitespace2
()
|
LanguageFeature
.
NameOf
->
FSComp
.
SR
.
featureNameOf
()
|
LanguageFeature
.
ImplicitYield
->
FSComp
.
SR
.
featureImplicitYield
()
|
LanguageFeature
.
OpenTypeDeclaration
->
FSComp
.
SR
.
featureOpenTypeDeclaration
()
|
LanguageFeature
.
DotlessFloat32Literal
->
FSComp
.
SR
.
featureDotlessFloat32Literal
()
|
LanguageFeature
.
PackageManagement
->
FSComp
.
SR
.
featurePackageManagement
()
|
LanguageFeature
.
FromEndSlicing
->
FSComp
.
SR
.
featureFromEndSlicing
()
|
LanguageFeature
.
FixedIndexSlice3d4d
->
FSComp
.
SR
.
featureFixedIndexSlice3d4d
()
|
LanguageFeature
.
AndBang
->
FSComp
.
SR
.
featureAndBang
()
|
LanguageFeature
.
ResumableStateMachines
->
FSComp
.
SR
.
featureResumableStateMachines
()
|
LanguageFeature
.
NullableOptionalInterop
->
FSComp
.
SR
.
featureNullableOptionalInterop
()
|
LanguageFeature
.
DefaultInterfaceMemberConsumption
->
FSComp
.
SR
.
featureDefaultInterfaceMemberConsumption
()
|
LanguageFeature
.
WitnessPassing
->
FSComp
.
SR
.
featureWitnessPassing
()
|
LanguageFeature
.
AdditionalTypeDirectedConversions
->
FSComp
.
SR
.
featureAdditionalImplicitConversions
()
|
LanguageFeature
.
InterfacesWithMultipleGenericInstantiation
->
FSComp
.
SR
.
featureInterfacesWithMultipleGenericInstantiation
()
|
LanguageFeature
.
StringInterpolation
->
FSComp
.
SR
.
featureStringInterpolation
()
|
LanguageFeature
.
OverloadsForCustomOperations
->
FSComp
.
SR
.
featureOverloadsForCustomOperations
()
|
LanguageFeature
.
ExpandedMeasurables
->
FSComp
.
SR
.
featureExpandedMeasurables
()
|
LanguageFeature
.
StructActivePattern
->
FSComp
.
SR
.
featureStructActivePattern
()
|
LanguageFeature
.
PrintfBinaryFormat
->
FSComp
.
SR
.
featurePrintfBinaryFormat
()
|
LanguageFeature
.
IndexerNotationWithoutDot
->
FSComp
.
SR
.
featureIndexerNotationWithoutDot
()
|
LanguageFeature
.
RefCellNotationInformationals
->
FSComp
.
SR
.
featureRefCellNotationInformationals
()
|
LanguageFeature
.
UseBindingValueDiscard
->
FSComp
.
SR
.
featureDiscardUseValue
()
|
LanguageFeature
.
NonVariablePatternsToRightOfAsPatterns
->
FSComp
.
SR
.
featureNonVariablePatternsToRightOfAsPatterns
()
|
LanguageFeature
.
AttributesToRightOfModuleKeyword
->
FSComp
.
SR
.
featureAttributesToRightOfModuleKeyword
()
|
LanguageFeature
.
MLCompatRevisions
->
FSComp
.
SR
.
featureMLCompatRevisions
()
|
LanguageFeature
.
BetterExceptionPrinting
->
FSComp
.
SR
.
featureBetterExceptionPrinting
()
|
LanguageFeature
.
DelegateTypeNameResolutionFix
->
FSComp
.
SR
.
featureDelegateTypeNameResolutionFix
()
|
LanguageFeature
.
ExtensionConstraintSolutions
->
FSComp
.
SR
.
featureExtensionConstraintSolutions
()
|
LanguageFeature
.
StructActivePattern
->
FSComp
.
SR
.
featureStructActivePattern
()
|
LanguageFeature
.
PrintfBinaryFormat
->
FSComp
.
SR
.
featurePrintfBinaryFormat
()
|
LanguageFeature
.
IndexerNotationWithoutDot
->
FSComp
.
SR
.
featureIndexerNotationWithoutDot
()
|
LanguageFeature
.
RefCellNotationInformationals
->
FSComp
.
SR
.
featureRefCellNotationInformationals
()
|
LanguageFeature
.
UseBindingValueDiscard
->
FSComp
.
SR
.
featureDiscardUseValue
()
|
LanguageFeature
.
NonVariablePatternsToRightOfAsPatterns
->
FSComp
.
SR
.
featureNonVariablePatternsToRightOfAsPatterns
()
|
LanguageFeature
.
AttributesToRightOfModuleKeyword
->
FSComp
.
SR
.
featureAttributesToRightOfModuleKeyword
()
|
LanguageFeature
.
MLCompatRevisions
->
FSComp
.
SR
.
featureMLCompatRevisions
()
|
LanguageFeature
.
BetterExceptionPrinting
->
FSComp
.
SR
.
featureBetterExceptionPrinting
()
|
LanguageFeature
.
DelegateTypeNameResolutionFix
->
FSComp
.
SR
.
featureDelegateTypeNameResolutionFix
()
|
LanguageFeature
.
ReallyLongLists
->
FSComp
.
SR
.
featureReallyLongList
()
|
LanguageFeature
.
ErrorOnDeprecatedRequireQualifiedAccess
->
FSComp
.
SR
.
featureErrorOnDeprecatedRequireQualifiedAccess
()
|
LanguageFeature
.
ReallyLongLists
->
FSComp
.
SR
.
featureReallyLongList
()
|
LanguageFeature
.
ErrorOnDeprecatedRequireQualifiedAccess
->
FSComp
.
SR
.
featureErrorOnDeprecatedRequireQualifiedAccess
()
/// Get a version string associated with the given feature.
member
_.
GetFeatureVersionString
feature
=
...
...
@@ -219,7 +221,7 @@ type LanguageVersion (versionText) =
|
_
->
invalidArg
"feature"
"Internal error: Unable to find feature."
override
x
.
Equals
(
yobj
:
obj
)
=
match
yobj
with
match
yobj
with
|
:?
LanguageVersion
as
y
->
x
.
SpecifiedVersion
=
y
.
SpecifiedVersion
|
_
->
false
...
...
src/Compiler/Facilities/Logger.fs
浏览文件 @
cbe19c3a
...
...
@@ -13,9 +13,9 @@ type LogCompilerFunctionId =
|
CompileOps_TypeCheckOneInputAndFinishEventually
=
5
|
IncrementalBuild_CreateItemKeyStoreAndSemanticClassification
=
6
|
IncrementalBuild_TypeCheck
=
7
/// This is for ETW tracing across FSharp.Compiler.
[<
Sealed
;
EventSource
(
Name
=
"FSharpCompiler"
)>]
[<
Sealed
;
EventSource
(
Name
=
"FSharpCompiler"
)>]
type
FSharpCompilerEventSource
()
=
inherit
EventSource
()
...
...
@@ -24,9 +24,7 @@ type FSharpCompilerEventSource() =
[<
Event
(
1
)>]
member
this
.
Log
(
functionId
:
LogCompilerFunctionId
)
=
if
this
.
IsEnabled
()
then
this
.
WriteEvent
(
1
,
int
functionId
)
if
this
.
IsEnabled
()
then
this
.
WriteEvent
(
1
,
int
functionId
)
[<
Event
(
2
)>]
member
this
.
LogMessage
(
message
:
string
,
functionId
:
LogCompilerFunctionId
)
=
...
...
@@ -35,13 +33,11 @@ type FSharpCompilerEventSource() =
[<
Event
(
3
)>]
member
this
.
BlockStart
(
functionId
:
LogCompilerFunctionId
)
=
if
this
.
IsEnabled
()
then
this
.
WriteEvent
(
3
,
int
functionId
)
if
this
.
IsEnabled
()
then
this
.
WriteEvent
(
3
,
int
functionId
)
[<
Event
(
4
)>]
member
this
.
BlockStop
(
functionId
:
LogCompilerFunctionId
)
=
if
this
.
IsEnabled
()
then
this
.
WriteEvent
(
4
,
int
functionId
)
if
this
.
IsEnabled
()
then
this
.
WriteEvent
(
4
,
int
functionId
)
[<
Event
(
5
)>]
member
this
.
BlockMessageStart
(
message
:
string
,
functionId
:
LogCompilerFunctionId
)
=
...
...
@@ -56,16 +52,16 @@ type FSharpCompilerEventSource() =
[<
RequireQualifiedAccess
>]
module
Logger
=
let
Log
functionId
=
let
Log
functionId
=
FSharpCompilerEventSource
.
Instance
.
Log
(
functionId
)
let
LogMessage
message
functionId
=
let
LogMessage
message
functionId
=
FSharpCompilerEventSource
.
Instance
.
LogMessage
(
message
,
functionId
)
let
LogBlockStart
functionId
=
let
LogBlockStart
functionId
=
FSharpCompilerEventSource
.
Instance
.
BlockStart
(
functionId
)
let
LogBlockStop
functionId
=
let
LogBlockStop
functionId
=
FSharpCompilerEventSource
.
Instance
.
BlockStop
(
functionId
)
let
LogBlockMessageStart
message
functionId
=
...
...
@@ -76,12 +72,16 @@ module Logger =
let
LogBlock
functionId
=
FSharpCompilerEventSource
.
Instance
.
BlockStart
(
functionId
)
{
new
IDisposable
with
member
_.
Dispose
()
=
FSharpCompilerEventSource
.
Instance
.
BlockStop
(
functionId
)
}
FSharpCompilerEventSource
.
Instance
.
BlockStop
(
functionId
)
}
let
LogBlockMessage
message
functionId
=
FSharpCompilerEventSource
.
Instance
.
BlockMessageStart
(
message
,
functionId
)
{
new
IDisposable
with
member
_.
Dispose
()
=
FSharpCompilerEventSource
.
Instance
.
BlockMessageStop
(
message
,
functionId
)
}
FSharpCompilerEventSource
.
Instance
.
BlockMessageStop
(
message
,
functionId
)
}
src/Compiler/Facilities/ReferenceResolver.fs
浏览文件 @
cbe19c3a
...
...
@@ -5,26 +5,27 @@ namespace FSharp.Compiler.CodeAnalysis
exception
internal
LegacyResolutionFailure
[<
RequireQualifiedAccess
>]
type
LegacyResolutionEnvironment
=
type
LegacyResolutionEnvironment
=
/// Indicates a script or source being edited or compiled. Uses reference assemblies (not implementation assemblies).
|
EditingOrCompilation
of
isEditing
:
bool
/// Indicates a script or source being dynamically compiled and executed. Uses implementation assemblies.
|
CompilationAndEvaluation
|
CompilationAndEvaluation
type
LegacyResolvedFile
=
{
type
LegacyResolvedFile
=
{
/// Item specification.
itemSpec
:
string
itemSpec
:
string
/// Prepare textual information about where the assembly was resolved from, used for tooltip output
prepareToolTip
:
string
*
string
->
string
/// Round-tripped baggage
baggage
:
string
/// Round-tripped baggage
baggage
:
string
}
override
this
.
ToString
()
=
sprintf
"LegacyResolvedFile(%s)"
this
.
itemSpec
override
this
.
ToString
()
=
sprintf
"LegacyResolvedFile(%s)"
this
.
itemSpec
[<
AllowNullLiteral
>]
type
internal
ILegacyReferenceResolver
=
...
...
@@ -34,30 +35,27 @@ type internal ILegacyReferenceResolver =
/// Note: If an explicit "mscorlib" is given, then --noframework is being used, and the whole ReferenceResolver logic is essentially
/// unused. However in the future an option may be added to allow an explicit specification of
/// a .NET Framework version to use for scripts.
abstract
HighestInstalledNetFrameworkVersion
:
unit
->
string
abstract
HighestInstalledNetFrameworkVersion
:
unit
->
string
/// Get the Reference Assemblies directory for the .NET Framework (on Windows)
/// This is added to the default resolution path for
/// This is added to the default resolution path for
/// design-time compilations.
abstract
DotNetFrameworkReferenceAssembliesRootDirectory
:
string
abstract
DotNetFrameworkReferenceAssembliesRootDirectory
:
string
/// Perform assembly resolution on the given references under the given conditions
abstract
Resolve
:
abstract
Resolve
:
resolutionEnvironment
:
LegacyResolutionEnvironment
*
// The actual reference paths or assembly name text, plus baggage
references
:(
string
(* baggage *)
*
string
)[]
*
// e.g. v4.5.1
targetFrameworkVersion
:
string
*
targetFrameworkDirectories
:
string
list
*
targetProcessorArchitecture
:
string
*
fsharpCoreDir
:
string
*
explicitIncludeDirs
:
string
list
*
implicitIncludeDir
:
string
*
logMessage
:(
string
->
unit
)
*
logDiagnostic
:(
bool
->
string
->
string
->
unit
)
->
LegacyResolvedFile
[]
references
:
(
string
*
string
)[]
*
targetFrameworkVersion
:
string
*
targetFrameworkDirectories
:
string
list
*
targetProcessorArchitecture
:
string
*
fsharpCoreDir
:
string
*
explicitIncludeDirs
:
string
list
*
implicitIncludeDir
:
string
*
logMessage
:
(
string
->
unit
)
*
logDiagnostic
:
(
bool
->
string
->
string
->
unit
)
->
LegacyResolvedFile
[]
[<
AllowNullLiteral
>]
type
LegacyReferenceResolver
(
impl
:
ILegacyReferenceResolver
)
=
type
LegacyReferenceResolver
(
impl
:
ILegacyReferenceResolver
)
=
member
internal
_.
Impl
=
impl
src/Compiler/Facilities/SimulatedMSBuildReferenceResolver.fs
浏览文件 @
cbe19c3a
...
...
@@ -48,7 +48,8 @@ let private Net472 = "v4.7.2"
[<
Literal
>]
let
private
Net48
=
"v4.8"
let
SupportedDesktopFrameworkVersions
=
[
Net48
;
Net472
;
Net471
;
Net47
;
Net462
;
Net461
;
Net46
;
Net452
;
Net451
;
Net45
]
let
SupportedDesktopFrameworkVersions
=
[
Net48
;
Net472
;
Net471
;
Net47
;
Net462
;
Net461
;
Net46
;
Net452
;
Net451
;
Net45
]
let
private
SimulatedMSBuildResolver
=
...
...
@@ -57,7 +58,7 @@ let private SimulatedMSBuildResolver =
let
GetPathToDotNetFrameworkImlpementationAssemblies
v
=
let
v
=
match
v
with
|
Net45
->
Some
TargetDotNetFrameworkVersion
.
Version45
|
Net45
->
Some
TargetDotNetFrameworkVersion
.
Version45
|
Net451
->
Some
TargetDotNetFrameworkVersion
.
Version451
|
Net452
->
Some
TargetDotNetFrameworkVersion
.
Version452
|
Net46
->
Some
TargetDotNetFrameworkVersion
.
Version46
...
...
@@ -67,30 +68,38 @@ let private SimulatedMSBuildResolver =
|
Net471
->
Some
TargetDotNetFrameworkVersion
.
Version471
|
Net472
->
Some
TargetDotNetFrameworkVersion
.
Version472
|
Net48
->
Some
TargetDotNetFrameworkVersion
.
Version48
|
_
->
assert
false
;
None
|
_
->
assert
false
None
match
v
with
|
Some
v
->
match
ToolLocationHelper
.
GetPathToDotNetFramework
v
with
|
null
->
[]
|
x
->
[
x
]
|
x
->
[
x
]
|
_
->
[]
let
GetPathToDotNetFrameworkReferenceAssemblies
version
=
#
if
NETSTANDARD
ignore
version
let
r
:
string
list
=
[]
let
r
:
string
list
=
[]
r
#
else
match
Microsoft
.
Build
.
Utilities
.
ToolLocationHelper
.
GetPathToStandardLibraries
(
".NETFramework"
,
version
,
""
)
with
|
null
|
""
->
[]
|
x
->
[
x
]
match
Microsoft
.
Build
.
Utilities
.
ToolLocationHelper
.
GetPathToStandardLibraries
(
".NETFramework"
,
version
,
""
)
with
|
null
|
""
->
[]
|
x
->
[
x
]
#
endif
{
new
ILegacyReferenceResolver
with
member
x
.
HighestInstalledNetFrameworkVersion
()
=
let
root
=
x
.
DotNetFrameworkReferenceAssembliesRootDirectory
let
fwOpt
=
SupportedDesktopFrameworkVersions
|>
Seq
.
tryFind
(
fun
fw
->
FileSystem
.
DirectoryExistsShim
(
Path
.
Combine
(
root
,
fw
)
))
let
fwOpt
=
SupportedDesktopFrameworkVersions
|>
Seq
.
tryFind
(
fun
fw
->
FileSystem
.
DirectoryExistsShim
(
Path
.
Combine
(
root
,
fw
)))
match
fwOpt
with
|
Some
fw
->
fw
|
None
->
"v4.5"
...
...
@@ -99,135 +108,193 @@ let private SimulatedMSBuildResolver =
if
Environment
.
OSVersion
.
Platform
=
PlatformID
.
Win32NT
then
let
PF
=
match
Environment
.
GetEnvironmentVariable
(
"ProgramFiles(x86)"
)
with
|
null
->
Environment
.
GetEnvironmentVariable
(
"ProgramFiles"
)
// if PFx86 is null, then we are 32-bit and just get PF
|
null
->
Environment
.
GetEnvironmentVariable
(
"ProgramFiles"
)
// if PFx86 is null, then we are 32-bit and just get PF
|
s
->
s
PF
+
@
"
\
Reference Assemblies
\
Microsoft
\
Framework
\
.NETFramework"
else
""
member
_.
Resolve
(
resolutionEnvironment
,
references
,
targetFrameworkVersion
,
targetFrameworkDirectories
,
targetProcessorArchitecture
,
fsharpCoreDir
,
explicitIncludeDirs
,
implicitIncludeDir
,
logMessage
,
logWarningOrError
)
=
member
_.
Resolve
(
resolutionEnvironment
,
references
,
targetFrameworkVersion
,
targetFrameworkDirectories
,
targetProcessorArchitecture
,
fsharpCoreDir
,
explicitIncludeDirs
,
implicitIncludeDir
,
logMessage
,
logWarningOrError
)
=
#
if
!
FX_NO_WIN_REGISTRY
let
registrySearchPaths
()
=
[
let
registryKey
=
@
"Software
\
Microsoft
\
.NetFramework"
use
key
=
Registry
.
LocalMachine
.
OpenSubKey
registryKey
match
key
with
|
null
->
()
|
_
->
for
subKeyName
in
key
.
GetSubKeyNames
()
do
use
subKey
=
key
.
OpenSubKey
subKeyName
use
subSubKey
=
subKey
.
OpenSubKey
(
"AssemblyFoldersEx"
)
match
subSubKey
with
let
registrySearchPaths
()
=
[
let
registryKey
=
@
"Software
\
Microsoft
\
.NetFramework"
use
key
=
Registry
.
LocalMachine
.
OpenSubKey
registryKey
match
key
with
|
null
->
()
|
_
->
for
subSubSubKeyName
in
subSubKey
.
GetSubKeyNames
()
do
use
subSubSubKey
=
subSubKey
.
OpenSubKey
subSubSubKeyName
match
subSubSubKey
.
GetValue
null
with
|
:?
string
as
s
->
yield
s
|
_
->
()
use
subSubKey
=
key
.
OpenSubKey
(
"AssemblyFolders"
)
match
subSubKey
with
|
null
->
()
|
_
->
for
subSubSubKeyName
in
subSubKey
.
GetSubKeyNames
()
do
let
subSubSubKey
=
subSubKey
.
OpenSubKey
subSubSubKeyName
match
subSubSubKey
.
GetValue
null
with
|
:?
string
as
s
->
yield
s
|
_
->
()
]
for
subKeyName
in
key
.
GetSubKeyNames
()
do
use
subKey
=
key
.
OpenSubKey
subKeyName
use
subSubKey
=
subKey
.
OpenSubKey
(
"AssemblyFoldersEx"
)
match
subSubKey
with
|
null
->
()
|
_
->
for
subSubSubKeyName
in
subSubKey
.
GetSubKeyNames
()
do
use
subSubSubKey
=
subSubKey
.
OpenSubKey
subSubSubKeyName
match
subSubSubKey
.
GetValue
null
with
|
:?
string
as
s
->
yield
s
|
_
->
()
use
subSubKey
=
key
.
OpenSubKey
(
"AssemblyFolders"
)
match
subSubKey
with
|
null
->
()
|
_
->
for
subSubSubKeyName
in
subSubKey
.
GetSubKeyNames
()
do
let
subSubSubKey
=
subSubKey
.
OpenSubKey
subSubSubKeyName
match
subSubSubKey
.
GetValue
null
with
|
:?
string
as
s
->
yield
s
|
_
->
()
]
#
endif
let
results
=
ResizeArray
()
let
searchPaths
=
[
yield
!
targetFrameworkDirectories
yield
!
explicitIncludeDirs
yield
fsharpCoreDir
yield
implicitIncludeDir
[
yield
!
targetFrameworkDirectories
yield
!
explicitIncludeDirs
yield
fsharpCoreDir
yield
implicitIncludeDir
#
if
!
FX_NO_WIN_REGISTRY
if
System
.
Environment
.
OSVersion
.
Platform
=
System
.
PlatformID
.
Win32NT
then
yield
!
registrySearchPaths
()
if
System
.
Environment
.
OSVersion
.
Platform
=
System
.
PlatformID
.
Win32NT
then
yield
!
registrySearchPaths
()
#
endif
yield
!
GetPathToDotNetFrameworkReferenceAssemblies
targetFrameworkVersion
yield
!
GetPathToDotNetFrameworkImlpementationAssemblies
targetFrameworkVersion
]
yield
!
GetPathToDotNetFrameworkReferenceAssemblies
targetFrameworkVersion
yield
!
GetPathToDotNetFrameworkImlpementationAssemblies
targetFrameworkVersion
]
for
r
,
baggage
in
references
do
//printfn "resolving %s" r
let
mutable
found
=
false
let
success
path
=
if
not
found
then
//printfn "resolved %s --> %s" r path
found
<-
true
results
.
Add
{
itemSpec
=
path
;
prepareToolTip
=
snd
;
baggage
=
baggage
}
results
.
Add
{
itemSpec
=
path
prepareToolTip
=
snd
baggage
=
baggage
}
try
if
not
found
&&
FileSystem
.
IsPathRootedShim
r
then
if
FileSystem
.
FileExistsShim
r
then
success
r
with
e
->
logWarningOrError
false
"SR001"
(
e
.
ToString
()
)
if
FileSystem
.
FileExistsShim
r
then
success
r
with
e
->
logWarningOrError
false
"SR001"
(
e
.
ToString
()
)
// For this one we need to get the version search exactly right, without doing a load
try
if
not
found
&&
r
.
StartsWithOrdinal
(
"FSharp.Core, Version="
)
&&
Environment
.
OSVersion
.
Platform
=
PlatformID
.
Win32NT
then
if
not
found
&&
r
.
StartsWithOrdinal
(
"FSharp.Core, Version="
)
&&
Environment
.
OSVersion
.
Platform
=
PlatformID
.
Win32NT
then
let
n
=
AssemblyName
r
let
fscoreDir0
=
let
PF
=
match
Environment
.
GetEnvironmentVariable
(
"ProgramFiles(x86)"
)
with
|
null
->
Environment
.
GetEnvironmentVariable
(
"ProgramFiles"
)
|
s
->
s
PF
+
@
"
\
Reference Assemblies
\
Microsoft
\
FSharp
\
.NETFramework
\
v4.0
\"
+ n.Version.ToString()
PF
+
@
"
\
Reference Assemblies
\
Microsoft
\
FSharp
\
.NETFramework
\
v4.0
\"
+ n.Version.ToString()
let trialPath = Path.Combine(fscoreDir0, n.Name + "
.
dll
")
if FileSystem.FileExistsShim trialPath then
success trialPath
with e -> logWarningOrError false "
SR001
" (e.ToString())
with e ->
logWarningOrError false "
SR001
" (e.ToString())
let isFileName =
r.EndsWith("
dll
", StringComparison.OrdinalIgnoreCase) ||
r.EndsWith("
exe
", StringComparison.OrdinalIgnoreCase)
let qual = if isFileName then r else try AssemblyName(r).Name + "
.
dll
" with _ -> r + "
.
dll
"
r.EndsWith("
dll
", StringComparison.OrdinalIgnoreCase)
|| r.EndsWith("
exe
", StringComparison.OrdinalIgnoreCase)
let qual =
if isFileName then
r
else
try
AssemblyName(r).Name + "
.
dll
"
with _ ->
r + "
.
dll
"
for searchPath in searchPaths do
try
if not found then
let trialPath = Path.Combine(searchPath, qual)
if FileSystem.FileExistsShim trialPath then
success trialPath
with e -> logWarningOrError false "
SR001
" (e.ToString())
try
if not found then
let trialPath = Path.Combine(searchPath, qual)
if FileSystem.FileExistsShim trialPath then
success trialPath
with e ->
logWarningOrError false "
SR001
" (e.ToString())
try
// Search the GAC on Windows
if not found && not isFileName && Environment.OSVersion.Platform = PlatformID.Win32NT then
if not found
&& not isFileName
&& Environment.OSVersion.Platform = PlatformID.Win32NT then
let n = AssemblyName r
let netFx = System.Runtime.InteropServices.RuntimeEnvironment.GetRuntimeDirectory()
let gac = Path.Combine(Path.GetDirectoryName(Path.GetDirectoryName(netFx.TrimEnd('
\\
'))), "
assembly
")
match n.Version, n.GetPublicKeyToken() with
| null, _ | _, null ->
let gac =
Path.Combine(Path.GetDirectoryName(Path.GetDirectoryName(netFx.TrimEnd('
\\
'))), "
assembly
")
match n.Version, n.GetPublicKeyToken() with
| null, _
| _, null ->
let options =
[ if FileSystem.DirectoryExistsShim gac then
for gacDir in FileSystem.EnumerateDirectoriesShim gac do
let assemblyDir = Path.Combine(gacDir, n.Name)
if FileSystem.DirectoryExistsShim assemblyDir then
for tdir in FileSystem.EnumerateDirectoriesShim assemblyDir do
let trialPath = Path.Combine(tdir, qual)
if FileSystem.FileExistsShim trialPath then
yield trialPath ]
[
if FileSystem.DirectoryExistsShim gac then
for gacDir in FileSystem.EnumerateDirectoriesShim gac do
let assemblyDir = Path.Combine(gacDir, n.Name)
if FileSystem.DirectoryExistsShim assemblyDir then
for tdir in FileSystem.EnumerateDirectoriesShim assemblyDir do
let trialPath = Path.Combine(tdir, qual)
if FileSystem.FileExistsShim trialPath then yield trialPath
]
//printfn "
sorting
GAC
paths
:
%
A
" options
options
|> List.sort // puts latest version last
|> List.tryLast
|> function None -> () | Some p -> success p
|> function
| None -> ()
| Some p -> success p
| v, tok ->
if FileSystem.DirectoryExistsShim gac then
for gacDir in Directory.EnumerateDirectories gac do
//printfn "
searching
GAC
directory
:
%
s
" gacDir
let assemblyDir = Path.Combine(gacDir, n.Name)
if FileSystem.DirectoryExistsShim assemblyDir then
//printfn "
searching
GAC
directory
:
%
s
" assemblyDir
let tokText = String.concat "" [| for b in tok -> sprintf "
%
02
x
" b |]
let verDir = Path.Combine(assemblyDir, "
v4
.
0_
"
+v.ToString()+"
__
"+
tokText)
let verDir = Path.Combine(assemblyDir, "
v4
.
0_
"
+ v.ToString() + "
__
" +
tokText)
//printfn "
searching
GAC
directory
:
%
s
" verDir
if FileSystem.DirectoryExistsShim verDir then
...
...
@@ -235,14 +302,15 @@ let private SimulatedMSBuildResolver =
//printfn "
searching
GAC
:
%
s
" trialPath
if FileSystem.FileExistsShim trialPath then
success trialPath
with e -> logWarningOrError false "
SR001
" (e.ToString())
with e ->
logWarningOrError false "
SR001
" (e.ToString())
results.ToArray() }
results.ToArray()
}
|> LegacyReferenceResolver
let internal getResolver () = SimulatedMSBuildResolver
#if INTERACTIVE
// Some manual testing
SimulatedMSBuildResolver.DotNetFrameworkReferenceAssembliesRootDirectory
...
...
@@ -252,40 +320,66 @@ let fscoreDir =
if System.Environment.OSVersion.Platform = System.PlatformID.Win32NT then // file references only valid on Windows
let PF =
match Environment.GetEnvironmentVariable("
ProgramFiles
(
x86
)
") with
| null -> Environment.GetEnvironmentVariable("
ProgramFiles
")
// if PFx86 is null, then we are 32-bit and just get PF
| null -> Environment.GetEnvironmentVariable("
ProgramFiles
") // if PFx86 is null, then we are 32-bit and just get PF
| s -> s
PF + @"
\
Reference
Assemblies
\
Microsoft
\
FSharp
\
.
NETFramework
\
v4
.
0
\
4
.
4
.
0
.
0
"
else
System.Runtime.InteropServices.RuntimeEnvironment.GetRuntimeDirectory()
let resolve s =
SimulatedMSBuildResolver.Resolve
(ResolutionEnvironment.EditingOrCompilation, [| for a in s -> (a, "") |], "
v4
.
5
.
1
",
[SimulatedMSBuildResolver.DotNetFrameworkReferenceAssembliesRootDirectory + @"
\
v4
.
5
.
1
" ], "", "",
fscoreDir, [], __SOURCE_DIRECTORY__, ignore, (fun _ _ -> ()), (fun _ _-> ()))
SimulatedMSBuildResolver.Resolve(
ResolutionEnvironment.EditingOrCompilation,
[| for a in s -> (a, "") |],
"
v4
.
5
.
1
",
[
SimulatedMSBuildResolver.DotNetFrameworkReferenceAssembliesRootDirectory
+ @"
\
v4
.
5
.
1
"
],
"",
"",
fscoreDir,
[],
__SOURCE_DIRECTORY__,
ignore,
(fun _ _ -> ()),
(fun _ _ -> ())
)
// Resolve partial name to something on search path
resolve ["
FSharp
.
Core
" ]
resolve [
"
FSharp
.
Core
" ]
// Resolve DLL name to something on search path
resolve ["
FSharp
.
Core
.
dll
" ]
resolve [
"
FSharp
.
Core
.
dll
" ]
// Resolve from reference assemblies
resolve ["
System
"; "
mscorlib
"; "
mscorlib
.
dll
" ]
resolve [
"
System
"; "
mscorlib
"; "
mscorlib
.
dll
" ]
// Resolve from Registry AssemblyFolders
resolve [
"
Microsoft
.
SqlServer
.
Dmf
.
dll
"; "
Microsoft
.
SqlServer
.
Dmf
"
]
resolve [
"
Microsoft
.
SqlServer
.
Dmf
.
dll
"; "
Microsoft
.
SqlServer
.
Dmf
"
]
// Resolve exact version of FSharp.Core
resolve [ "
FSharp
.
Core
,
Version
=
4
.
4
.
0
.
0
,
Culture
=
neutral
,
PublicKeyToken
=
b03f5f7f11d50a3a
" ]
resolve
[
"
FSharp
.
Core
,
Version
=
4
.
4
.
0
.
0
,
Culture
=
neutral
,
PublicKeyToken
=
b03f5f7f11d50a3a
"
]
// Resolve from GAC:
resolve [ "
EventViewer
,
Version
=
6
.
3
.
0
.
0
,
Culture
=
neutral
,
PublicKeyToken
=
31
bf3856ad364e35
" ]
resolve
[
"
EventViewer
,
Version
=
6
.
3
.
0
.
0
,
Culture
=
neutral
,
PublicKeyToken
=
31
bf3856ad364e35
"
]
// Resolve from GAC:
resolve [
"
EventViewer
" ]
resolve [ "
EventViewer
" ]
resolve [ "
Microsoft
.
SharePoint
.
Client
,
Version
=
15
.
0
.
0
.
0
,
Culture
=
neutral
,
PublicKeyToken
=
71e9
bce111e9429c
" ]
resolve [ "
Microsoft
.
SharePoint
.
Client
,
Version
=
16
.
0
.
0
.
0
,
Culture
=
neutral
,
PublicKeyToken
=
71e9
bce111e9429c
" ]
#endif
resolve
[
"
Microsoft
.
SharePoint
.
Client
,
Version
=
15
.
0
.
0
.
0
,
Culture
=
neutral
,
PublicKeyToken
=
71e9
bce111e9429c
"
]
resolve
[
"
Microsoft
.
SharePoint
.
Client
,
Version
=
16
.
0
.
0
.
0
,
Culture
=
neutral
,
PublicKeyToken
=
71e9
bce111e9429c
"
]
#endif
src/Compiler/Facilities/TextLayoutRender.fs
浏览文件 @
cbe19c3a
...
...
@@ -77,12 +77,12 @@ module RightL =
let
rightBracketBar
=
rightL
TaggedText
.
rightBracketBar
type
LayoutRenderer
<
'
a
,
'
b
>
=
abstract
Start
:
unit
->
'
b
abstract
AddText
:
'
b
->
TaggedText
->
'
b
abstract
AddBreak
:
'
b
->
int
->
'
b
abstract
AddTag
:
'
b
->
string
*
(
string
*
string
)
list
*
bool
->
'
b
abstract
Finish
:
'
b
->
'
a
abstract
Start
:
unit
->
'
b
abstract
AddText
:
'
b
->
TaggedText
->
'
b
abstract
AddBreak
:
'
b
->
int
->
'
b
abstract
AddTag
:
'
b
->
string
*
(
string
*
string
)
list
*
bool
->
'
b
abstract
Finish
:
'
b
->
'
a
type
NoState
=
NoState
type
NoResult
=
NoResult
...
...
@@ -91,82 +91,116 @@ module LayoutRender =
let
mkNav
r
t
=
NavigableTaggedText
(
t
,
r
)
:>
TaggedText
let
spaces
n
=
String
(
'
'
,
n
)
let
renderL
(
rr
:
LayoutRenderer
<_,
_>)
layout
=
let
rec
addL
z
pos
i
layout
k
=
match
layout
with
|
ObjLeaf
_
->
failwith
"ObjLeaf should never appear here"
let
rec
addL
z
pos
i
layout
k
=
match
layout
with
|
ObjLeaf
_
->
failwith
"ObjLeaf should never appear here"
(* pos is tab level *)
|
Leaf
(_,
text
,
_)
->
k
(
rr
.
AddText
z
text
,
i
+
text
.
Text
.
Length
)
|
Node
(
l
,
r
,
Broken
indent
)
->
addL
z
pos
i
l
<|
fun
(
z
,
_
i
)
->
let
z
,
i
=
rr
.
AddBreak
z
(
pos
+
indent
),
(
pos
+
indent
)
addL
z
(
pos
+
indent
)
i
r
k
|
Node
(
l
,
r
,
_)
->
let
jm
=
Layout
.
JuxtapositionMiddle
(
l
,
r
)
addL
z
pos
i
l
<|
fun
(
z
,
i
)
->
let
z
,
i
=
if
jm
then
z
,
i
else
rr
.
AddText
z
TaggedText
.
space
,
i
+
1
let
pos
=
i
addL
z
pos
i
r
k
|
Attr
(
tag
,
attrs
,
l
)
->
let
z
=
rr
.
AddTag
z
(
tag
,
attrs
,
true
)
addL
z
pos
i
l
<|
fun
(
z
,
i
)
->
let
z
=
rr
.
AddTag
z
(
tag
,
attrs
,
false
)
k
(
z
,
i
)
let
pos
=
0
let
z
,
i
=
rr
.
Start
()
,
0
|
Leaf
(_,
text
,
_)
->
k
(
rr
.
AddText
z
text
,
i
+
text
.
Text
.
Length
)
|
Node
(
l
,
r
,
Broken
indent
)
->
addL
z
pos
i
l
<|
fun
(
z
,
_
i
)
->
let
z
,
i
=
rr
.
AddBreak
z
(
pos
+
indent
),
(
pos
+
indent
)
addL
z
(
pos
+
indent
)
i
r
k
|
Node
(
l
,
r
,
_)
->
let
jm
=
Layout
.
JuxtapositionMiddle
(
l
,
r
)
addL
z
pos
i
l
<|
fun
(
z
,
i
)
->
let
z
,
i
=
if
jm
then
z
,
i
else
rr
.
AddText
z
TaggedText
.
space
,
i
+
1
let
pos
=
i
addL
z
pos
i
r
k
|
Attr
(
tag
,
attrs
,
l
)
->
let
z
=
rr
.
AddTag
z
(
tag
,
attrs
,
true
)
addL
z
pos
i
l
<|
fun
(
z
,
i
)
->
let
z
=
rr
.
AddTag
z
(
tag
,
attrs
,
false
)
k
(
z
,
i
)
let
pos
=
0
let
z
,
i
=
rr
.
Start
()
,
0
let
z
,
_
i
=
addL
z
pos
i
layout
id
rr
.
Finish
z
/// string render
/// string render
let
stringR
=
{
new
LayoutRenderer
<
string
,
string
list
>
with
member
_.
Start
()
=
[]
member
_.
AddText
rstrs
taggedText
=
taggedText
.
Text
::
rstrs
member
_.
AddBreak
rstrs
n
=
(
spaces
n
)
::
"
\n
"
::
rstrs
member
_.
AddTag
z
(_,
_,
_)
=
z
member
_.
Finish
rstrs
=
String
.
Join
(
""
,
Array
.
ofList
(
List
.
rev
rstrs
))
}
/// string render
{
new
LayoutRenderer
<
string
,
string
list
>
with
member
_.
Start
()
=
[]
member
_.
AddText
rstrs
taggedText
=
taggedText
.
Text
::
rstrs
member
_.
AddBreak
rstrs
n
=
(
spaces
n
)
::
"
\n
"
::
rstrs
member
_.
AddTag
z
(_,
_,
_)
=
z
member
_.
Finish
rstrs
=
String
.
Join
(
""
,
Array
.
ofList
(
List
.
rev
rstrs
))
}
/// string render
let
taggedTextListR
collector
=
{
new
LayoutRenderer
<
NoResult
,
NoState
>
with
member
_.
Start
()
=
NoState
member
_.
AddText
z
text
=
collector
text
;
z
member
_.
AddBreak
rstrs
n
=
collector
TaggedText
.
lineBreak
;
collector
(
TaggedText
.
tagSpace
(
spaces
n
));
rstrs
member
_.
AddTag
z
(_,
_,
_)
=
z
member
_.
Finish
rstrs
=
NoResult
}
{
new
LayoutRenderer
<
NoResult
,
NoState
>
with
member
_.
Start
()
=
NoState
member
_.
AddText
z
text
=
collector
text
z
member
_.
AddBreak
rstrs
n
=
collector
TaggedText
.
lineBreak
collector
(
TaggedText
.
tagSpace
(
spaces
n
))
rstrs
member
_.
AddTag
z
(_,
_,
_)
=
z
member
_.
Finish
rstrs
=
NoResult
}
/// channel LayoutRenderer
let
channelR
(
chan
:
TextWriter
)
=
{
new
LayoutRenderer
<
NoResult
,
NoState
>
with
member
r
.
Start
()
=
NoState
member
r
.
AddText
z
s
=
chan
.
Write
s
.
Text
;
z
member
r
.
AddBreak
z
n
=
chan
.
WriteLine
()
;
chan
.
Write
(
spaces
n
);
z
member
r
.
AddTag
z
(
tag
,
attrs
,
start
)
=
z
member
r
.
Finish
z
=
NoResult
}
let
channelR
(
chan
:
TextWriter
)
=
{
new
LayoutRenderer
<
NoResult
,
NoState
>
with
member
r
.
Start
()
=
NoState
member
r
.
AddText
z
s
=
chan
.
Write
s
.
Text
z
member
r
.
AddBreak
z
n
=
chan
.
WriteLine
()
chan
.
Write
(
spaces
n
)
z
member
r
.
AddTag
z
(
tag
,
attrs
,
start
)
=
z
member
r
.
Finish
z
=
NoResult
}
/// buffer render
let
bufferR
os
=
{
new
LayoutRenderer
<
NoResult
,
NoState
>
with
member
r
.
Start
()
=
NoState
member
r
.
AddText
z
s
=
bprintf
os
"%s"
s
.
Text
;
z
member
r
.
AddBreak
z
n
=
bprintf
os
"
\n
"
;
bprintf
os
"%s"
(
spaces
n
);
z
member
r
.
AddTag
z
(
tag
,
attrs
,
start
)
=
z
member
r
.
Finish
z
=
NoResult
}
{
new
LayoutRenderer
<
NoResult
,
NoState
>
with
member
r
.
Start
()
=
NoState
member
r
.
AddText
z
s
=
bprintf
os
"%s"
s
.
Text
z
member
r
.
AddBreak
z
n
=
bprintf
os
"
\n
"
bprintf
os
"%s"
(
spaces
n
)
z
member
r
.
AddTag
z
(
tag
,
attrs
,
start
)
=
z
member
r
.
Finish
z
=
NoResult
}
let
showL
layout
=
renderL
stringR
layout
let
outL
(
chan
:
TextWriter
)
layout
=
renderL
(
channelR
chan
)
layout
|>
ignore
let
outL
(
chan
:
TextWriter
)
layout
=
renderL
(
channelR
chan
)
layout
|>
ignore
let
bufferL
os
layout
=
renderL
(
bufferR
os
)
layout
|>
ignore
let
emitL
f
layout
=
renderL
(
taggedTextListR
f
)
layout
|>
ignore
let
emitL
f
layout
=
renderL
(
taggedTextListR
f
)
layout
|>
ignore
let
toArray
layout
=
let
toArray
layout
=
let
output
=
ResizeArray
()
renderL
(
taggedTextListR
(
fun
tt
->
output
.
Add
(
tt
)))
layout
|>
ignore
output
.
ToArray
()
src/Compiler/Facilities/prim-lexing.fs
浏览文件 @
cbe19c3a
此差异已折叠。
点击以展开。
src/Compiler/Facilities/prim-parsing.fs
浏览文件 @
cbe19c3a
此差异已折叠。
点击以展开。
src/Compiler/Facilities/prim-parsing.fsi
浏览文件 @
cbe19c3a
...
...
@@ -123,9 +123,11 @@ exception internal Accept of obj
/// Indicates a parse error has occurred and parse recovery is in progress.
exception
internal
RecoverableParseError
#
if
DEBUG
module
internal
Flags
=
#
if
DEBUG
val
mutable
debug
:
bool
#
else
val
debug
:
bool
#
endif
/// Helpers used by generated parsers.
...
...
编辑
预览
Markdown
is supported
0%
请重试
或
添加新附件
.
添加附件
取消
You are about to add
0
people
to the discussion. Proceed with caution.
先完成此消息的编辑!
取消
想要评论请
注册
或
登录