Skip to content

F
fsharp

dotNET Platform / fsharp
10 个月 前同步成功

通知 0
Star 1
Fork 0
F
fsharp

体验新版 GitCode，发现更多精彩内容 >>

未验证 提交 ebd32a78 编写于 作者: D Don Syme 提交者： GitHub
浏览文件
操作

Format src/Compiler/Facilities (#13245) 

* adjust settings

* adjust code

* adjust code

* adjust code

* apply formatting
上级 e6b9dc6f
展开全部 隐藏空白更改
内联 并排
Showing with 1875 addition and 1457 deletion
.fantomasignore
浏览文件 @ ebd32a78
......@@ -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/DiagnosticOptions.fs
浏览文件 @ ebd32a78
......@@ -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
浏览文件 @ ebd32a78
......@@ -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/LanguageFeatures.fs
浏览文件 @ ebd32a78
......@@ -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:
......@@ -51,68 +51,71 @@ 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.6m
static let languageVersion47 = 4.7m
static let languageVersion50 = 5.0m
static let languageVersion60 = 6.0m
static let previewVersion = 9999m // 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 = 9999m // 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.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.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
| "?" -> 0m
| "PREVIEW" -> previewVersion
......@@ -121,15 +124,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
| _ -> 0m
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
......@@ -145,8 +149,7 @@ type LanguageVersion (versionText) =
v <> 0.0m && v <= 5.0m
/// Has preview been explicitly specified
member _.IsPreviewEnabled =
specified = previewVersion
member _.IsPreviewEnabled = specified = previewVersion
/// Does the languageVersion support this version string
member _.ContainsVersion version =
......@@ -159,8 +162,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
......@@ -175,39 +177,39 @@ 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.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.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.ReallyLongLists -> FSComp.SR.featureReallyLongList ()
| LanguageFeature.ErrorOnDeprecatedRequireQualifiedAccess -> FSComp.SR.featureErrorOnDeprecatedRequireQualifiedAccess ()
/// Get a version string associated with the given feature.
member _.GetFeatureVersionString feature =
......@@ -216,7 +218,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
浏览文件 @ ebd32a78
......@@ -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
浏览文件 @ ebd32a78
......@@ -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
浏览文件 @ ebd32a78
......@@ -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 "%02x" 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=31bf3856ad364e35" ]
resolve
[
"EventViewer, Version=6.3.0.0, Culture=neutral, PublicKeyToken=31bf3856ad364e35"
]
// Resolve from GAC:
resolve [ "EventViewer" ]
resolve [ "EventViewer" ]
resolve [ "Microsoft.SharePoint.Client, Version=15.0.0.0, Culture=neutral, PublicKeyToken=71e9bce111e9429c" ]
resolve [ "Microsoft.SharePoint.Client, Version=16.0.0.0, Culture=neutral, PublicKeyToken=71e9bce111e9429c" ]
#endif
resolve
[
"Microsoft.SharePoint.Client, Version=15.0.0.0, Culture=neutral, PublicKeyToken=71e9bce111e9429c"
]
resolve
[
"Microsoft.SharePoint.Client, Version=16.0.0.0, Culture=neutral, PublicKeyToken=71e9bce111e9429c"
]
#endif
src/Compiler/Facilities/TextLayoutRender.fs
浏览文件 @ ebd32a78
......@@ -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-parsing.fsi
浏览文件 @ ebd32a78
......@@ -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.
先完成此消息的编辑！
想要评论请 注册 或