Skip to content

F
fsharp

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

通知 0
Star 1
Fork 0
F
fsharp

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

提交 9635bd0d 编写于 作者: D Don Syme
浏览文件
操作

Integrate FCS API: Changes to src\fsharp

上级 1b8fb965
展开全部 隐藏空白更改
内联 并排
Showing with 1551 addition and 431 deletion
src/fsharp/CompileOps.fs
浏览文件 @ 9635bd0d
此差异已折叠。
src/fsharp/CompileOps.fsi
浏览文件 @ 9635bd0d
......@@ -139,10 +139,44 @@ exception InternalCommandLineOption of string * range
exception HashLoadedSourceHasIssues of (*warnings*) exn list * (*errors*) exn list * range
exception HashLoadedScriptConsideredSource of range
//----------------------------------------------------------------------------
/// Represents a reference to an F# assembly. May be backed by a real assembly on disk (read by Abstract IL), or a cross-project
/// reference in FSharp.Compiler.Service.
type IRawFSharpAssemblyData =
/// The raw list AutoOpenAttribute attributes in the assembly
abstract GetAutoOpenAttributes : ILGlobals -> string list
/// The raw list InternalsVisibleToAttribute attributes in the assembly
abstract GetInternalsVisibleToAttributes : ILGlobals -> string list
/// The raw IL module definition in the assembly, if any. This is not present for cross-project references
/// in the language service
abstract TryGetRawILModule : unit -> ILModuleDef option
abstract HasAnyFSharpSignatureDataAttribute : bool
abstract HasMatchingFSharpSignatureDataAttribute : ILGlobals -> bool
/// The raw F# signature data in the assembly, if any
abstract GetRawFSharpSignatureData : range * ilShortAssemName: string * fileName: string -> (string * byte[]) list
/// The raw F# optimization data in the assembly, if any
abstract GetRawFSharpOptimizationData : range * ilShortAssemName: string * fileName: string -> (string * (unit -> byte[])) list
/// The table of type forwarders in the assembly
abstract GetRawTypeForwarders : unit -> ILExportedTypesAndForwarders
/// The identity of the module
abstract ILScopeRef : ILScopeRef
abstract ILAssemblyRefs : ILAssemblyRef list
abstract ShortAssemblyName : string
type IProjectReference =
/// The name of the assembly file generated by the project
abstract FileName : string
/// Evaluate raw contents of the assembly file generated by the project
abstract EvaluateRawContents : unit -> IRawFSharpAssemblyData option
/// Get the logical timestamp that would be the timestamp of the assembly file generated by the project
abstract GetLogicalTimeStamp : unit -> System.DateTime option
type AssemblyReference =
| AssemblyReference of range * string
| AssemblyReference of range * string * IProjectReference option
member Range : range
member Text : string
member ProjectReference : IProjectReference option
type AssemblyResolution =
{/// The original reference to the assembly.
......@@ -217,6 +251,7 @@ type TcConfigBuilder =
mutable loadedSources: (range * string) list
mutable referencedDLLs: AssemblyReference list
mutable projectReferences : IProjectReference list
mutable knownUnresolvedReferences : UnresolvedAssemblyReference list
optimizeForMemory: bool
mutable subsystemVersion : int * int
......@@ -481,6 +516,9 @@ type TcConfig =
/// but for F# Interactive it may be based on an underlying mutable TcConfigBuilder.
[<Sealed>]
type TcConfigProvider =
member Get : unit -> TcConfig
/// Get a TcConfigProvider which will return only the exact TcConfig.
static member Constant : TcConfig -> TcConfigProvider
......@@ -496,7 +534,7 @@ type TcConfigProvider =
[<RequireQualifiedAccess>]
type ImportedBinary =
{ FileName: string
RawMetadata: ILModuleDef
RawMetadata: IRawFSharpAssemblyData
#if EXTENSIONTYPING
ProviderGeneratedAssembly: System.Reflection.Assembly option
IsProviderGenerated: bool
......@@ -652,6 +690,8 @@ type TcState =
/// Get the typing environment implied by the set of implemetation files checked so far
member TcEnvFromImpls : TcEnv
/// The inferred contents of the assembly, containing the signatures of all implemented files.
member PartialAssemblySignature : ModuleOrNamespaceType
member NextStateAfterIncrementalFragment : TcEnv -> TcState
......@@ -720,7 +760,7 @@ type LoadClosure =
RootWarnings : PhasedError list }
// Used from service.fs, when editing a script file
static member ComputeClosureOfSourceText : filename : string * source : string * implicitDefines:CodeContext * lexResourceManager : Lexhelp.LexResourceManager -> LoadClosure
static member ComputeClosureOfSourceText : filename: string * source: string * implicitDefines:CodeContext * useMonoResolution: bool * useFsiAuxLib: bool * lexResourceManager: Lexhelp.LexResourceManager * applyCompilerOptions: (TcConfigBuilder -> unit) -> LoadClosure
/// Used from fsi.fs and fsc.fs, for #load and command line. The resulting references are then added to a TcConfig.
static member ComputeClosureOfSourceFiles : tcConfig:TcConfig * (string * range) list * implicitDefines:CodeContext * useDefaultScriptingReferences : bool * lexResourceManager : Lexhelp.LexResourceManager -> LoadClosure
src/fsharp/ErrorLogger.fs
浏览文件 @ 9635bd0d
......@@ -38,8 +38,9 @@ let rec findOriginalException err =
/// Thrown when we stop processing the F# Interactive entry or #load.
exception StopProcessing
exception StopProcessingExn of exn option
let (|StopProcessing|_|) exn = match exn with StopProcessingExn _ -> Some () | _ -> None
let StopProcessing<'T> = StopProcessingExn None
(* common error kinds *)
exception NumberedError of (int * string) * range with // int is e.g. 191 in FS0191
......@@ -73,6 +74,13 @@ let inline protectAssemblyExploration dflt f =
| UnresolvedPathReferenceNoRange _ -> dflt
| _ -> reraise()
let inline protectAssemblyExplorationF dflt f =
try
f()
with
| UnresolvedPathReferenceNoRange (asmName, path) -> dflt(asmName,path)
| _ -> reraise()
let inline protectAssemblyExplorationNoReraise dflt1 dflt2 f =
try
f()
......@@ -381,7 +389,7 @@ let report f =
let deprecatedWithError s m = errorR(Deprecated(s,m))
// Note: global state, but only for compiling FSHarp.Core.dll
// Note: global state, but only for compiling FSharp.Core.dll
let mutable reportLibraryOnlyFeatures = true
let libraryOnlyError m = if reportLibraryOnlyFeatures then errorR(LibraryUseOnly(m))
let libraryOnlyWarning m = if reportLibraryOnlyFeatures then warning(LibraryUseOnly(m))
......
src/fsharp/ExtensionTyping.fs
浏览文件 @ 9635bd0d
......@@ -405,7 +405,7 @@ module internal ExtensionTyping =
let namedArgs =
a.NamedArguments
|> Seq.toList
|> List.map (fun arg -> arg.MemberName, match arg.TypedValue with Arg null -> None | Arg obj -> Some obj | _ -> None)
|> List.map (fun arg -> arg.MemberInfo.Name, match arg.TypedValue with Arg null -> None | Arg obj -> Some obj | _ -> None)
ctorArgs, namedArgs)
member __.GetHasTypeProviderEditorHideMethodsAttribute provider =
......@@ -569,6 +569,8 @@ module internal ExtensionTyping =
member __.IsFamilyAndAssembly = x.IsFamilyAndAssembly
override __.Equals y = assert false; match y with :? ProvidedFieldInfo as y -> x.Equals y.Handle | _ -> false
override __.GetHashCode() = assert false; x.GetHashCode()
static member TaintedEquals (pt1:Tainted<ProvidedFieldInfo>, pt2:Tainted<ProvidedFieldInfo>) =
Tainted.EqTainted (pt1.PApplyNoFailure(fun st -> st.Handle)) (pt2.PApplyNoFailure(fun st -> st.Handle))
......
src/fsharp/ExtensionTyping.fsi
浏览文件 @ 9635bd0d
......@@ -210,6 +210,7 @@ module internal ExtensionTyping =
member IsFamilyAndAssembly : bool
member IsFamilyOrAssembly : bool
member IsPrivate : bool
static member TaintedEquals : Tainted<ProvidedFieldInfo> * Tainted<ProvidedFieldInfo> -> bool
and [<AllowNullLiteral; Class; Sealed>]
ProvidedPropertyInfo =
......
src/fsharp/FSharp.Compiler-proto/FSharp.Compiler-proto.fsproj
浏览文件 @ 9635bd0d
......@@ -11,7 +11,11 @@
<ProjectGuid>{33E0FB8C-93DC-4AD7-9DCD-9FBDA6C2F061}</ProjectGuid>
<OutputType>Library</OutputType>
<AssemblyName>FSharp.Compiler-proto</AssemblyName>
<DefineConstants>BUILDING_PROTO;BUILDING_WITH_LKG;COMPILER;INCLUDE_METADATA_READER;INCLUDE_METADATA_WRITER;$(DefineConstants)</DefineConstants>
<DefineConstants>BUILDING_PROTO;$(DefineConstants)</DefineConstants>
<DefineConstants>BUILDING_WITH_LKG;$(DefineConstants)</DefineConstants>
<DefineConstants>COMPILER;$(DefineConstants)</DefineConstants>
<DefineConstants>INCLUDE_METADATA_READER;$(DefineConstants)</DefineConstants>
<DefineConstants>INCLUDE_METADATA_WRITER;$(DefineConstants)</DefineConstants>
<NoWarn>$(NoWarn);35;44;62;9;60;86;47;1203</NoWarn>
<BuildWith>LKG</BuildWith>
<AllowCrossTargeting>true</AllowCrossTargeting>
......@@ -412,12 +416,6 @@
<Compile Include="..\CompileOptions.fs">
<Link>CompileOptions.fs</Link>
</Compile>
<Compile Include="..\vs\IncrementalBuild.fsi">
<Link>IncrementalBuild.fsi</Link>
</Compile>
<Compile Include="..\vs\IncrementalBuild.fs">
<Link>IncrementalBuild.fs</Link>
</Compile>
<Compile Include="..\fsc.fsi">
<Link>fsc.fsi</Link>
</Compile>
......
src/fsharp/FSharp.Compiler/FSharp.Compiler.fsproj
浏览文件 @ 9635bd0d
......@@ -10,7 +10,10 @@
<Platform Condition=" '$(Platform)' == '' ">AnyCPU</Platform>
<OutputType>Library</OutputType>
<AssemblyName>FSharp.Compiler</AssemblyName>
<DefineConstants>EXTENSIONTYPING;COMPILER;INCLUDE_METADATA_READER;INCLUDE_METADATA_WRITER;EXTENSIBLE_DUMPER;$(DefineConstants)</DefineConstants>
<DefineConstants>EXTENSIONTYPING;$(DefineConstants)</DefineConstants>
<DefineConstants>COMPILER;$(DefineConstants)</DefineConstants>
<DefineConstants>INCLUDE_METADATA_READER;$(DefineConstants)</DefineConstants>
<DefineConstants>INCLUDE_METADATA_WRITER;$(DefineConstants)</DefineConstants>
<NoWarn>$(NoWarn);62;9</NoWarn>
<ProjectGuid>{2E4D67B4-522D-4CF7-97E4-BA940F0B18F3}</ProjectGuid>
<AllowCrossTargeting>true</AllowCrossTargeting>
......@@ -438,66 +441,12 @@
<Compile Include="..\CompileOptions.fs">
<Link>Driver\CompileOptions.fs</Link>
</Compile>
<Compile Include="..\vs\IncrementalBuild.fsi">
<Link>Driver\IncrementalBuild.fsi</Link>
</Compile>
<Compile Include="..\vs\IncrementalBuild.fs">
<Link>Driver\IncrementalBuild.fs</Link>
</Compile>
<Compile Include="..\fsc.fsi">
<Link>Driver\fsc.fsi</Link>
</Compile>
<Compile Include="..\fsc.fs">
<Link>Driver\fsc.fs</Link>
</Compile>
<Compile Include="..\vs\Reactor.fsi">
<Link>Service\Reactor.fsi</Link>
</Compile>
<Compile Include="..\vs\Reactor.fs">
<Link>Service\Reactor.fs</Link>
</Compile>
<Compile Include="..\vs\ServiceLexing.fsi">
<Link>Service\ServiceLexing.fsi</Link>
</Compile>
<Compile Include="..\vs\ServiceLexing.fs">
<Link>Service\ServiceLexing.fs</Link>
</Compile>
<Compile Include="..\vs\ServiceConstants.fs">
<Link>Service\ServiceConstants.fs</Link>
</Compile>
<Compile Include="..\vs\ServiceParseTreeWalk.fs">
<Link>Service\ServiceParseTreeWalk.fs</Link>
</Compile>
<Compile Include="..\vs\ServiceNavigation.fsi">
<Link>Service\ServiceNavigation.fsi</Link>
</Compile>
<Compile Include="..\vs\ServiceNavigation.fs">
<Link>Service\ServiceNavigation.fs</Link>
</Compile>
<Compile Include="..\vs\ServiceParamInfoLocations.fsi">
<Link>Service\ServiceParamInfoLocations.fsi</Link>
</Compile>
<Compile Include="..\vs\ServiceParamInfoLocations.fs">
<Link>Service\ServiceParamInfoLocations.fs</Link>
</Compile>
<Compile Include="..\vs\ServiceUntypedParse.fsi">
<Link>Service\ServiceUntypedParse.fsi</Link>
</Compile>
<Compile Include="..\vs\ServiceUntypedParse.fs">
<Link>Service\ServiceUntypedParse.fs</Link>
</Compile>
<Compile Include="..\vs\ServiceDeclarations.fsi">
<Link>Service\ServiceDeclarations.fsi</Link>
</Compile>
<Compile Include="..\vs\ServiceDeclarations.fs">
<Link>Service\ServiceDeclarations.fs</Link>
</Compile>
<Compile Include="..\vs\service.fsi">
<Link>Service\service.fsi</Link>
</Compile>
<Compile Include="..\vs\service.fs">
<Link>Service\service.fs</Link>
</Compile>
<Compile Include="InternalsVisibleTo.fs">
<Link>InternalsVisibleTo.fs</Link>
</Compile>
......
src/fsharp/FSharp.Core/seq.fs
浏览文件 @ 9635bd0d
......@@ -802,6 +802,7 @@ namespace Microsoft.FSharp.Core.CompilerServices
abstract CheckClose: bool
abstract LastGenerated : 'T
//[<System.Diagnostics.DebuggerNonUserCode; System.Diagnostics.DebuggerStepThroughAttribute>]
member x.MoveNextImpl() =
let active =
if redirect then redirectTo
......@@ -836,6 +837,8 @@ namespace Microsoft.FSharp.Core.CompilerServices
member x.Dispose() = if redirect then redirectTo.Close() else x.Close()
interface IEnumerator with
member x.Current = box (if redirect then redirectTo.LastGenerated else x.LastGenerated)
//[<System.Diagnostics.DebuggerNonUserCode; System.Diagnostics.DebuggerStepThroughAttribute>]
member x.MoveNext() = x.MoveNextImpl()
member x.Reset() = raise <| new System.NotSupportedException();
......
src/fsharp/FSharp.LanguageService.Compiler/FSharp.LanguageService.Compiler.fsproj
浏览文件 @ 9635bd0d
......@@ -11,15 +11,10 @@
<OutputType>Library</OutputType>
<AssemblyName>FSharp.LanguageService.Compiler</AssemblyName>
<DefineConstants>EXTENSIONTYPING;$(DefineConstants)</DefineConstants>
<DefineConstants>COMPILED_AS_LANGUAGE_SERVICE_DLL;$(DefineConstants)</DefineConstants>
<DefineConstants>INTERNALIZED_POWER_PACK;$(DefineConstants)</DefineConstants>
<DefineConstants>COMPILER;$(DefineConstants)</DefineConstants>
<DefineConstants>COMPILED_AS_LANGUAGE_SERVICE_DLL;$(DefineConstants)</DefineConstants>
<DefineConstants>INCLUDE_METADATA_READER;$(DefineConstants)</DefineConstants>
<DefineConstants>EXTENSIBLE_DUMPER;$(DefineConstants)</DefineConstants>
<DefineConstants>NO_COMPILER_BACKEND;$(DefineConstants)</DefineConstants>
<DefineConstants>NO_PDB_READER;$(DefineConstants)</DefineConstants>
<DefineConstants>NO_PDB_WRITER;$(DefineConstants)</DefineConstants>
<DefineConstants>NO_INLINE_IL_PARSER;$(DefineConstants)</DefineConstants>
<DefineConstants>INCLUDE_METADATA_WRITER;$(DefineConstants)</DefineConstants>
<NoWarn>$(NoWarn);62;9;75</NoWarn>
<ProjectGuid>{a437a6ec-5323-47c2-8f86-e2cac54ff152}</ProjectGuid>
<AllowCrossTargeting>true</AllowCrossTargeting>
......@@ -184,6 +179,18 @@
<Compile Include="..\..\absil\ilprint.fs">
<Link>AbsIL\ilprint.fs</Link>
</Compile>
<Compile Include="..\..\absil\ilmorph.fsi">
<Link>AbsIL/ilmorph.fsi</Link>
</Compile>
<Compile Include="..\..\absil\ilmorph.fs">
<Link>AbsIL/ilmorph.fs</Link>
</Compile>
<Compile Include="..\..\absil\ilsupp.fsi">
<Link>AbsIL/ilsupp.fsi</Link>
</Compile>
<Compile Include="..\..\absil\ilsupp.fs">
<Link>AbsIL/ilsupp.fs</Link>
</Compile>
<Compile Include="ilpars.fs">
<Link>AbsIL\ilpars.fs</Link>
</Compile>
......@@ -202,6 +209,15 @@
<Compile Include="..\..\absil\ilread.fs">
<Link>AbsIL\ilread.fs</Link>
</Compile>
<Compile Include="..\..\absil\ilwrite.fsi">
<Link>AbsIL/ilwrite.fsi</Link>
</Compile>
<Compile Include="..\..\absil\ilwrite.fs">
<Link>AbsIL/ilwrite.fs</Link>
</Compile>
<Compile Include="..\..\absil\ilreflect.fs">
<Link>AbsIL/ilreflect.fs</Link>
</Compile>
<Compile Include="..\..\utils\CompilerLocationUtils.fs">
<Link>CompilerLocation\CompilerLocationUtils.fs</Link>
</Compile>
......@@ -211,6 +227,18 @@
<Compile Include="..\..\ilx\ilxsettings.fs">
<Link>ILXErase\ilxsettings.fs</Link>
</Compile>
<Compile Include="..\..\ilx\EraseClosures.fsi">
<Link>ILXErase/EraseClosures.fsi</Link>
</Compile>
<Compile Include="..\..\ilx\EraseClosures.fs">
<Link>ILXErase/EraseClosures.fs</Link>
</Compile>
<Compile Include="..\..\ilx\EraseUnions.fsi">
<Link>ILXErase/EraseUnions.fsi</Link>
</Compile>
<Compile Include="..\..\ilx\EraseUnions.fs">
<Link>ILXErase/EraseUnions.fs</Link>
</Compile>
<FsLex Include="..\pplex.fsl">
<OtherFlags>--lexlib Internal.Utilities.Text.Lexing</OtherFlags>
<Link>ParserAndUntypedAST\pplex.fsl</Link>
......@@ -375,6 +403,30 @@
<Compile Include="..\Optimizer.fs">
<Link>Optimize\Optimizer.fs</Link>
</Compile>
<Compile Include="..\DetupleArgs.fsi">
<Link>Optimize/DetupleArgs.fsi</Link>
</Compile>
<Compile Include="..\DetupleArgs.fs">
<Link>Optimize/DetupleArgs.fs</Link>
</Compile>
<Compile Include="..\InnerLambdasToTopLevelFuncs.fsi">
<Link>Optimize/InnerLambdasToTopLevelFuncs.fsi</Link>
</Compile>
<Compile Include="..\InnerLambdasToTopLevelFuncs.fs">
<Link>Optimize/InnerLambdasToTopLevelFuncs.fs</Link>
</Compile>
<Compile Include="..\LowerCallsAndSeqs.fs">
<Link>Optimize/LowerCallsAndSeqs.fs</Link>
</Compile>
<Compile Include="..\autobox.fs">
<Link>Optimize\autobox.fs</Link>
</Compile>
<Compile Include="..\IlxGen.fsi">
<Link>CodeGen/IlxGen.fsi</Link>
</Compile>
<Compile Include="..\IlxGen.fs">
<Link>CodeGen/IlxGen.fs</Link>
</Compile>
<Compile Include="..\CompileOps.fsi">
<Link>Driver\CompileOps.fsi</Link>
</Compile>
......@@ -387,65 +439,71 @@
<Compile Include="..\CompileOptions.fs">
<Link>Driver\CompileOptions.fs</Link>
</Compile>
<Compile Include="..\vs\IncrementalBuild.fsi">
<Link>Driver\IncrementalBuild.fsi</Link>
</Compile>
<Compile Include="..\vs\IncrementalBuild.fs">
<Link>Driver\IncrementalBuild.fs</Link>
</Compile>
<Compile Include="..\fsc.fsi">
<Link>Driver\fsc.fsi</Link>
</Compile>
<Compile Include="..\fsc.fs">
<Link>Driver\fsc.fs</Link>
</Compile>
<Compile Include="..\vs\IncrementalBuild.fsi">
<Link>Service/IncrementalBuild.fsi</Link>
</Compile>
<Compile Include="..\vs\IncrementalBuild.fs">
<Link>Service/IncrementalBuild.fs</Link>
</Compile>
<Compile Include="..\vs\Reactor.fsi">
<Link>Service\Reactor.fsi</Link>
<Link>Service/Reactor.fsi</Link>
</Compile>
<Compile Include="..\vs\Reactor.fs">
<Link>Service\Reactor.fs</Link>
<Link>Service/Reactor.fs</Link>
</Compile>
<Compile Include="..\vs\ServiceConstants.fs">
<Link>Service/ServiceConstants.fs</Link>
</Compile>
<Compile Include="..\vs\ServiceDeclarations.fsi">
<Link>Service/ServiceDeclarations.fsi</Link>
</Compile>
<Compile Include="..\vs\ServiceDeclarations.fs">
<Link>Service/ServiceDeclarations.fs</Link>
</Compile>
<Compile Include="..\vs\Symbols.fsi">
<Link>Service/Symbols.fsi</Link>
</Compile>
<Compile Include="..\vs\Symbols.fs">
<Link>Service/Symbols.fs</Link>
</Compile>
<Compile Include="..\vs\ServiceLexing.fsi">
<Link>Service\ServiceLexing.fsi</Link>
<Link>Service/ServiceLexing.fsi</Link>
</Compile>
<Compile Include="..\vs\ServiceLexing.fs">
<Link>Service\ServiceLexing.fs</Link>
</Compile>
<Compile Include="..\vs\ServiceConstants.fs">
<Link>Service\ServiceConstants.fs</Link>
<Link>Service/ServiceLexing.fs</Link>
</Compile>
<Compile Include="..\vs\ServiceParseTreeWalk.fs">
<Link>Service\ServiceParseTreeWalk.fs</Link>
<Link>Service/ServiceParseTreeWalk.fs</Link>
</Compile>
<Compile Include="..\vs\ServiceNavigation.fsi">
<Link>Service\ServiceNavigation.fsi</Link>
<Link>Service/ServiceNavigation.fsi</Link>
</Compile>
<Compile Include="..\vs\ServiceNavigation.fs">
<Link>Service\ServiceNavigation.fs</Link>
<Link>Service/ServiceNavigation.fs</Link>
</Compile>
<Compile Include="..\vs\ServiceParamInfoLocations.fsi">
<Link>Service\ServiceParamInfoLocations.fsi</Link>
<Link>Service/ServiceParamInfoLocations.fsi</Link>
</Compile>
<Compile Include="..\vs\ServiceParamInfoLocations.fs">
<Link>Service\ServiceParamInfoLocations.fs</Link>
<Link>Service/ServiceParamInfoLocations.fs</Link>
</Compile>
<Compile Include="..\vs\ServiceUntypedParse.fsi">
<Link>Service\ServiceUntypedParse.fsi</Link>
<Link>Service/ServiceUntypedParse.fsi</Link>
</Compile>
<Compile Include="..\vs\ServiceUntypedParse.fs">
<Link>Service\ServiceUntypedParse.fs</Link>
</Compile>
<Compile Include="..\vs\ServiceDeclarations.fsi">
<Link>Service\ServiceDeclarations.fsi</Link>
</Compile>
<Compile Include="..\vs\ServiceDeclarations.fs">
<Link>Service\ServiceDeclarations.fs</Link>
<Link>Service/ServiceUntypedParse.fs</Link>
</Compile>
<Compile Include="..\vs\service.fsi">
<Link>Service\service.fsi</Link>
<Link>Service/service.fsi</Link>
</Compile>
<Compile Include="..\vs\service.fs">
<Link>Service\service.fs</Link>
<Link>Service/service.fs</Link>
</Compile>
</ItemGroup>
<ItemGroup>
......
src/fsharp/InternalCollections.fs
浏览文件 @ 9635bd0d
......@@ -15,11 +15,12 @@ type internal ValueStrength<'T when 'T : not struct> =
| Weak of WeakReference<'T>
#endif
type internal AgedLookup<'TKey,'TValue when 'TValue : not struct>(keepStrongly:int, areSame, ?onStrongDiscard : ('TValue -> unit), ?keepMax: int) =
type internal AgedLookup<'TKey,'TValue when 'TValue : not struct>(keepStrongly:int, areSame, ?requiredToKeep, ?onStrongDiscard, ?keepMax: int) =
/// The list of items stored. Youngest is at the end of the list.
/// The choice of order is somewhat arbitrary. If the other way then adding
/// items would be O(1) and removing O(N).
let mutable refs:('TKey*ValueStrength<'TValue>) list = []
let mutable keepStrongly = keepStrongly
// Only set a strong discard function if keepMax is explicitly set to keepStrongly, i.e. there are no weak entries in this lookup.
do assert (onStrongDiscard.IsNone || Some keepStrongly = keepMax)
......@@ -30,7 +31,8 @@ type internal AgedLookup<'TKey,'TValue when 'TValue : not struct>(keepStrongly:i
// references. Some operations are O(N) and we don't want to let things get out of
// hand.
let keepMax = defaultArg keepMax 75
let keepMax = max keepStrongly keepMax
let mutable keepMax = max keepStrongly keepMax
let requiredToKeep = defaultArg requiredToKeep (fun _ -> false)
/// Look up a the given key, return None if not found.
let TryPeekKeyValueImpl(data,key) =
......@@ -62,9 +64,9 @@ type internal AgedLookup<'TKey,'TValue when 'TValue : not struct>(keepStrongly:i
let TryGetKeyValueImpl(data,key) =
match TryPeekKeyValueImpl(data,key) with
| Some(_, value) as result ->
// If the result existed, move it to the top of the list.
result,Promote (data,key,value)
| Some(key', value) as result ->
// If the result existed, move it to the end of the list (more likely to keep it)
result,Promote (data,key',value)
| None -> None,data
/// Remove weak entries from the list that have been collected
......@@ -89,12 +91,12 @@ type internal AgedLookup<'TKey,'TValue when 'TValue : not struct>(keepStrongly:i
let weakThreshhold = max 0 (actualLength - keepStrongly) // Weaken everything less than this threshold
let newdata = newdata|> List.mapi( fun n kv -> n,kv ) // Place the index.
let newdata,discard2 = newdata |> List.partition (fun (n:int,_) -> n >= tossThreshold)
let newdata,discard2 = newdata |> List.partition (fun (n:int,v) -> n >= tossThreshold || requiredToKeep (snd v))
let newdata =
newdata
|> List.map( fun (n:int,(k,v)) ->
let handle =
if n<weakThreshhold then
if n<weakThreshhold && not (requiredToKeep v) then
assert onStrongDiscard.IsNone; // it disappeared, we can't dispose
#if FX_NO_GENERIC_WEAKREFERENCE
Weak(WeakReference(v))
......@@ -104,7 +106,7 @@ type internal AgedLookup<'TKey,'TValue when 'TValue : not struct>(keepStrongly:i
else
Strong(v)
k,handle )
refs<- newdata
refs <- newdata
discard1 |> List.iter (snd >> strongDiscard)
discard2 |> List.iter (snd >> snd >> strongDiscard)
......@@ -136,20 +138,21 @@ type internal AgedLookup<'TKey,'TValue when 'TValue : not struct>(keepStrongly:i
let newdata,discard = RemoveImpl (data,key)
AssignWithStrength(newdata,discard)
member al.MostRecent : ('TKey*'TValue) option=
let data = FilterAndHold()
if not data.IsEmpty then
// Non-optimal reverse list to get most recent. Consider an array of option for the data structure.
Some(data |> List.rev |> List.head)
else None
member al.Clear() =
let discards = FilterAndHold()
AssignWithStrength([], discards)
member al.Resize(newKeepStrongly, ?newKeepMax) =
let newKeepMax = defaultArg newKeepMax 75
keepStrongly <- newKeepStrongly
keepMax <- max newKeepStrongly newKeepMax
do assert (onStrongDiscard.IsNone || keepStrongly = keepMax)
let keep = FilterAndHold()
AssignWithStrength(keep, [])
type internal MruCache<'TKey,'TValue when 'TValue : not struct>(keepStrongly,compute, areSame, ?isStillValid : 'TKey*'TValue->bool, ?areSameForSubsumption, ?logComputedNewValue, ?logUsedCachedValue, ?onStrongDiscard, ?keepMax) =
type internal MruCache<'TKey,'TValue when 'TValue : not struct>(keepStrongly, areSame, ?isStillValid : 'TKey*'TValue->bool, ?areSameForSubsumption, ?requiredToKeep, ?onStrongDiscard, ?keepMax) =
/// Default behavior of areSameForSubsumption function is areSame
let areSameForSubsumption = defaultArg areSameForSubsumption areSame
......@@ -157,42 +160,26 @@ type internal MruCache<'TKey,'TValue when 'TValue : not struct>(keepStrongly,com
/// The list of items in the cache. Youngest is at the end of the list.
/// The choice of order is somewhat arbitrary. If the other way then adding
/// items would be O(1) and removing O(N).
let cache = AgedLookup<'TKey,'TValue>(keepStrongly=keepStrongly,areSame=areSameForSubsumption,?onStrongDiscard=onStrongDiscard,?keepMax=keepMax)
let cache = AgedLookup<'TKey,'TValue>(keepStrongly=keepStrongly,areSame=areSameForSubsumption,?onStrongDiscard=onStrongDiscard,?keepMax=keepMax,?requiredToKeep=requiredToKeep)
/// Whether or not this result value is still valid.
let isStillValid = defaultArg isStillValid (fun _ -> true)
/// Log a message when a new value is computed.
let logComputedNewValue = defaultArg logComputedNewValue ignore
/// Log a message when an existing value was retrieved from cache.
let logUsedCachedValue = defaultArg logUsedCachedValue ignore
member bc.GetAvailable(key) =
member bc.TryGetAny(key) =
match cache.TryPeekKeyValue(key) with
| Some(key', value)->
if areSame(key',key) then Some(value)
else None
| None -> None
member bc.Get(key) =
let Compute() =
let value = compute key
cache.Put(key, value)
logComputedNewValue(key)
value
member bc.TryGet(key) =
match cache.TryGetKeyValue(key) with
| Some(key', value) ->
if areSame(key', key) && isStillValid(key,value) then
logUsedCachedValue(key)
value
else Compute()
| None -> Compute()
if areSame(key', key) && isStillValid(key,value) then Some value
else None
| None -> None
member bc.MostRecent =
cache.MostRecent
member bc.SetAlternate(key:'TKey,value:'TValue) =
member bc.Set(key:'TKey,value:'TValue) =
cache.Put(key,value)
member bc.Remove(key) =
......@@ -201,6 +188,9 @@ type internal MruCache<'TKey,'TValue when 'TValue : not struct>(keepStrongly,com
member bc.Clear() =
cache.Clear()
member bc.Resize(newKeepStrongly, ?newKeepMax) =
cache.Resize(newKeepStrongly, ?newKeepMax=newKeepMax)
/// List helpers
[<Sealed>]
type internal List =
......
src/fsharp/InternalCollections.fsi
浏览文件 @ 9635bd0d
......@@ -8,6 +8,7 @@ namespace Internal.Utilities.Collections
type internal AgedLookup<'TKey,'TValue when 'TValue : not struct> =
new : keepStrongly:int
* areSame:('TKey * 'TKey -> bool)
* ?requiredToKeep:('TValue -> bool)
* ?onStrongDiscard : ('TValue -> unit) // this may only be set if keepTotal=keepStrongly, i.e. not weak entries
* ?keepMax: int
-> AgedLookup<'TKey,'TValue>
......@@ -27,6 +28,8 @@ namespace Internal.Utilities.Collections
member Remove : key:'TKey -> unit
/// Remove all elements.
member Clear : unit -> unit
/// Resize
member Resize : keepStrongly: int * ?keepMax : int -> unit
/// Simple priority caching for a small number of key\value associations.
/// This cache may age-out results that have been Set by the caller.
......@@ -34,27 +37,25 @@ namespace Internal.Utilities.Collections
/// that aren't what was originally passed to the Set function.
type internal MruCache<'TKey,'TValue when 'TValue : not struct> =
new : keepStrongly:int
* compute:('TKey -> 'TValue)
* areSame:('TKey * 'TKey -> bool)
* ?isStillValid:('TKey * 'TValue -> bool)
* ?areSameForSubsumption:('TKey * 'TKey -> bool)
* ?logComputedNewValue:('TKey -> unit)
* ?logUsedCachedValue:('TKey -> unit)
* ?requiredToKeep:('TValue -> bool)
* ?onDiscard:('TValue -> unit)
* ?keepMax:int
-> MruCache<'TKey,'TValue>
/// Clear out the cache.
member Clear : unit -> unit
/// Get the value for the given key. Compute if necessary.
member Get : key:'TKey -> 'TValue
/// Get the value for the given key or None if not already available
member GetAvailable : key:'TKey -> 'TValue option
member TryGetAny : key:'TKey -> 'TValue option
/// Get the value for the given key or None if not already available
member TryGet : key:'TKey -> 'TValue option
/// Remove the given value from the mru cache.
member Remove : key:'TKey -> unit
/// Set the value for the given key. This value does not have to agree with computed value.
member SetAlternate : key:'TKey * value:'TValue -> unit
/// Get the most recent item if there is one.
member MostRecent : ('TKey * 'TValue) option
/// Set the given key.
member Set : key:'TKey * value:'TValue -> unit
/// Resize
member Resize : keepStrongly: int * ?keepMax : int -> unit
[<Sealed>]
type internal List =
......
src/fsharp/LexFilter.fs
浏览文件 @ 9635bd0d
......@@ -983,6 +983,45 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer,
setLexbufState(tokenLexbufState)
prevWasAtomicEnd <- isAtomicExprEndToken(tok)
tok
let rec suffixExists p l = match l with [] -> false | _::t -> p t || suffixExists p t
let tokenBalancesHeadContext token stack =
match token,stack with
| END, (CtxtWithAsAugment(_) :: _)
| (ELSE | ELIF), (CtxtIf _ :: _)
| DONE , (CtxtDo _ :: _)
// WITH balances except in the following contexts.... Phew - an overused keyword!
| WITH , ( ((CtxtMatch _ | CtxtException _ | CtxtMemberHead _ | CtxtInterfaceHead _ | CtxtTry _ | CtxtTypeDefns _ | CtxtMemberBody _) :: _)
// This is the nasty record/object-expression case
| (CtxtSeqBlock _ :: CtxtParen(LBRACE,_) :: _) )
| FINALLY , (CtxtTry _ :: _) ->
true
// for x in ienum ...
// let x = ... in
| IN , ((CtxtFor _ | CtxtLetDecl _) :: _) ->
true
// 'query { join x in ys ... }'
// 'query { ...
// join x in ys ... }'
// 'query { for ... do
// join x in ys ... }'
| IN , stack when detectJoinInCtxt stack ->
true
// NOTE: ;; does not terminate a 'namespace' body.
| SEMICOLON_SEMICOLON, (CtxtSeqBlock _ :: CtxtNamespaceBody _ :: _) ->
true
| SEMICOLON_SEMICOLON, (CtxtSeqBlock _ :: CtxtModuleBody (_,true) :: _) ->
true
| t2 , (CtxtParen(t1,_) :: _) ->
parenTokensBalance t1 t2
| _ ->
false
//----------------------------------------------------------------------------
// Parse and transform the stream of tokens coming from popNextTokenTup, pushing
......@@ -1109,46 +1148,6 @@ type LexFilterImpl (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer,
| _ ->
None
let tokenBalancesHeadContext token stack =
match token,stack with
| END, (CtxtWithAsAugment(_) :: _)
| (ELSE | ELIF), (CtxtIf _ :: _)
| DONE , (CtxtDo _ :: _)
// WITH balances except in the following contexts.... Phew - an overused keyword!
| WITH , ( ((CtxtMatch _ | CtxtException _ | CtxtMemberHead _ | CtxtInterfaceHead _ | CtxtTry _ | CtxtTypeDefns _ | CtxtMemberBody _) :: _)
// This is the nasty record/object-expression case
| (CtxtSeqBlock _ :: CtxtParen(LBRACE,_) :: _) )
| FINALLY , (CtxtTry _ :: _) ->
true
// for x in ienum ...
// let x = ... in
| IN , ((CtxtFor _ | CtxtLetDecl _) :: _) ->
true
// 'query { join x in ys ... }'
// 'query { ...
// join x in ys ... }'
// 'query { for ... do
// join x in ys ... }'
| IN , stack when detectJoinInCtxt stack ->
true
// NOTE: ;; does not terminate a 'namespace' body.
| SEMICOLON_SEMICOLON, (CtxtSeqBlock _ :: CtxtNamespaceBody _ :: _) ->
true
| SEMICOLON_SEMICOLON, (CtxtSeqBlock _ :: CtxtModuleBody (_,true) :: _) ->
true
| t2 , (CtxtParen(t1,_) :: _) ->
parenTokensBalance t1 t2
| _ ->
false
let rec suffixExists p l = match l with [] -> false | _::t -> p t || suffixExists p t
// Balancing rule. Every 'in' terminates all surrounding blocks up to a CtxtLetDecl, and will be swallowed by
// terminating the corresponding CtxtLetDecl in the rule below.
// Balancing rule. Every 'done' terminates all surrounding blocks up to a CtxtDo, and will be swallowed by
......@@ -2279,3 +2278,4 @@ type LexFilter (lightSyntaxStatus:LightSyntaxStatus, compilingFsLib, lexer, lexb
| _ -> token
loop()
let token lexargs skip = Lexer.token lexargs skip
src/fsharp/NameResolution.fs
浏览文件 @ 9635bd0d
......@@ -115,6 +115,14 @@ let ActivePatternElemsOfModuleOrNamespace (modref:ModuleOrNamespaceRef) : NameMa
// Name Resolution Items
//-------------------------------------------------------------------------
/// Detect a use of a nominal type, including type abbreviations.
///
/// When reporting symbols, we care about abbreviations, e.g. 'int' and 'int32' count as two separate symbols
let (|AbbrevOrAppTy|_|) (typ: TType) =
match stripTyparEqns typ with
| TType_app (tcref,_) -> Some tcref
| _ -> None
[<NoEquality; NoComparison; RequireQualifiedAccess>]
/// Represents the item with which a named argument is associated.
type ArgumentContainer =
......@@ -173,7 +181,7 @@ type Item =
/// Represents the resolution of a name to a custom builder in the F# computation expression syntax
| CustomBuilder of string * ValRef
/// Represents the resolution of a name to a type variable
| TypeVar of string
| TypeVar of string * Typar
/// Represents the resolution of a name to a module or namespace
| ModuleOrNamespaces of Tast.ModuleOrNamespaceRef list
/// Represents the resolution of a name to an operator
......@@ -193,7 +201,7 @@ type Item =
let minfos = minfos |> List.sortBy (fun minfo -> minfo.NumArgs |> List.sum)
Item.CtorGroup (nm,minfos)
member d.DisplayName g =
member d.DisplayName =
match d with
| Item.Value v -> v.DisplayName
| Item.ActivePatternCase apref -> apref.Name
......@@ -206,10 +214,11 @@ type Item =
| Item.Property(nm,_) -> nm
| Item.MethodGroup(nm,_) -> nm
| Item.CtorGroup(nm,_) -> DemangleGenericTypeName nm
| Item.FakeInterfaceCtor typ
| Item.DelegateCtor typ -> DemangleGenericTypeName (tcrefOfAppTy g typ).LogicalName
| Item.FakeInterfaceCtor (AbbrevOrAppTy tcref)
| Item.DelegateCtor (AbbrevOrAppTy tcref) -> DemangleGenericTypeName tcref.DisplayName
| Item.Types(nm,_) -> DemangleGenericTypeName nm
| Item.TypeVar nm -> nm
| Item.UnqualifiedType(tcref :: _) -> tcref.DisplayName
| Item.TypeVar (nm,_) -> nm
| Item.ModuleOrNamespaces(modref :: _) -> modref.DemangledModuleOrNamespaceName
| Item.ArgName (id, _, _) -> id.idText
| Item.SetterArg (id, _) -> id.idText
......@@ -1088,12 +1097,283 @@ type ItemOccurence =
| UseInAttribute
/// Inside pattern matching
| Pattern
/// Abstract slot gets implemented
| Implemented
/// Result gets suppressed over this text range
| RelatedText
/// An abstract type for reporting the results of name resolution and type checking.
type ITypecheckResultsSink =
abstract NotifyEnvWithScope : range * NameResolutionEnv * AccessorDomain -> unit
abstract NotifyExprHasType : pos * TType * Tastops.DisplayEnv * NameResolutionEnv * AccessorDomain * range -> unit
abstract NotifyNameResolution : pos * Item * Item * ItemOccurence * Tastops.DisplayEnv * NameResolutionEnv * AccessorDomain * range -> unit
abstract NotifyFormatSpecifierLocation : range -> unit
abstract CurrentSource : string option
let (|ValRefOfProp|_|) (pi : PropInfo) = pi.ArbitraryValRef
let (|ValRefOfMeth|_|) (mi : MethInfo) = mi.ArbitraryValRef
let (|ValRefOfEvent|_|) (evt : EventInfo) = evt.ArbitraryValRef
let rec (|RecordFieldUse|_|) (item : Item) =
match item with
| Item.RecdField(RecdFieldInfo(_, RFRef(tcref, name))) -> Some (name, tcref)
| Item.SetterArg(_, RecordFieldUse(f)) -> Some(f)
| _ -> None
let rec (|ILFieldUse|_|) (item : Item) =
match item with
| Item.ILField(finfo) -> Some(finfo)
| Item.SetterArg(_, ILFieldUse(f)) -> Some(f)
| _ -> None
let rec (|PropertyUse|_|) (item : Item) =
match item with
| Item.Property(_, pinfo::_) -> Some(pinfo)
| Item.SetterArg(_, PropertyUse(pinfo)) -> Some(pinfo)
| _ -> None
let rec (|FSharpPropertyUse|_|) (item : Item) =
match item with
| Item.Property(_, [ValRefOfProp vref]) -> Some(vref)
| Item.SetterArg(_, FSharpPropertyUse(propDef)) -> Some(propDef)
| _ -> None
let (|MethodUse|_|) (item : Item) =
match item with
| Item.MethodGroup(_, [minfo]) -> Some(minfo)
| _ -> None
let (|FSharpMethodUse|_|) (item : Item) =
match item with
| Item.MethodGroup(_, [ValRefOfMeth vref]) -> Some(vref)
| Item.Value(vref) when vref.IsMember -> Some(vref)
| _ -> None
let (|EntityUse|_|) (item: Item) =
match item with
| Item.UnqualifiedType (tcref:: _) -> Some tcref
| Item.ExnCase(tcref) -> Some tcref
| Item.Types(_, [AbbrevOrAppTy tcref])
| Item.DelegateCtor(AbbrevOrAppTy tcref)
| Item.FakeInterfaceCtor(AbbrevOrAppTy tcref) -> Some tcref
| Item.CtorGroup(_, ctor::_) ->
match ctor.EnclosingType with
| AbbrevOrAppTy tcref -> Some tcref
| _ -> None
| _ -> None
let (|EventUse|_|) (item : Item) =
match item with
| Item.Event(einfo) -> Some einfo
| _ -> None
let (|FSharpEventUse|_|) (item : Item) =
match item with
| Item.Event(ValRefOfEvent vref) -> Some vref
| _ -> None
let (|UnionCaseUse|_|) (item : Item) =
match item with
| Item.UnionCase(UnionCaseInfo(_, u1),_) -> Some u1
| _ -> None
let (|ValUse|_|) (item:Item) =
match item with
| Item.Value vref
| FSharpPropertyUse vref
| FSharpMethodUse vref
| FSharpEventUse vref
| Item.CustomBuilder(_, vref) -> Some vref
| _ -> None
let (|ActivePatternCaseUse|_|) (item:Item) =
match item with
| Item.ActivePatternCase(APElemRef(_, vref, idx)) -> Some (vref.SigRange, vref.DefinitionRange, idx)
| Item.ActivePatternResult(ap, _, idx,_) -> Some (ap.Range, ap.Range, idx)
| _ -> None
let tyconRefDefnEq g (eref1:EntityRef) (eref2: EntityRef) =
tyconRefEq g eref1 eref2
// Signature items considered equal to implementation items
|| ((eref1.DefinitionRange = eref2.DefinitionRange || eref1.SigRange = eref2.SigRange) &&
(eref1.LogicalName = eref2.LogicalName))
let valRefDefnEq g (vref1:ValRef) (vref2: ValRef) =
valRefEq g vref1 vref2
// Signature items considered equal to implementation items
|| ((vref1.DefinitionRange = vref2.DefinitionRange || vref1.SigRange = vref2.SigRange)) &&
(vref1.LogicalName = vref2.LogicalName)
let unionCaseRefDefnEq g (uc1:UnionCaseRef) (uc2: UnionCaseRef) =
uc1.CaseName = uc2.CaseName && tyconRefDefnEq g uc1.TyconRef uc2.TyconRef
/// Given the Item 'orig' - returns function 'other : Item -> bool', that will yield true if other and orig represents the same item and false - otherwise
let ItemsAreEffectivelyEqual g orig other =
match orig, other with
| EntityUse ty1, EntityUse ty2 ->
tyconRefDefnEq g ty1 ty2
| Item.TypeVar (nm1,tp1), Item.TypeVar (nm2,tp2) ->
nm1 = nm2 &&
(typeEquiv g (mkTyparTy tp1) (mkTyparTy tp2) ||
match stripTyparEqns (mkTyparTy tp1), stripTyparEqns (mkTyparTy tp2) with
| TType_var tp1, TType_var tp2 ->
not tp1.IsCompilerGenerated && not tp1.IsFromError &&
not tp2.IsCompilerGenerated && not tp2.IsFromError &&
tp1.Range = tp2.Range
| AbbrevOrAppTy tcref1, AbbrevOrAppTy tcref2 ->
tyconRefDefnEq g tcref1 tcref2
| _ -> false)
| ValUse vref1, ValUse vref2 ->
valRefDefnEq g vref1 vref2
| ActivePatternCaseUse (range1, range1i, idx1), ActivePatternCaseUse (range2, range2i, idx2) ->
(idx1 = idx2) && (range1 = range2 || range1i = range2i)
| MethodUse minfo1, MethodUse minfo2 ->
MethInfo.MethInfosUseIdenticalDefinitions minfo1 minfo2 ||
// Allow for equality up to signature matching
match minfo1.ArbitraryValRef, minfo2.ArbitraryValRef with
| Some vref1, Some vref2 -> valRefDefnEq g vref1 vref2
| _ -> false
| PropertyUse(pinfo1), PropertyUse(pinfo2) ->
PropInfo.PropInfosUseIdenticalDefinitions pinfo1 pinfo2 ||
// Allow for equality up to signature matching
match pinfo1.ArbitraryValRef, pinfo2.ArbitraryValRef with
| Some vref1, Some vref2 -> valRefDefnEq g vref1 vref2
| _ -> false
| Item.ArgName (id1,_, _), Item.ArgName (id2,_, _) ->
(id1.idText = id2.idText && id1.idRange = id2.idRange)
| (Item.ArgName (id,_, _), ValUse vref) | (ValUse vref, Item.ArgName (id, _, _)) ->
(id.idText = vref.DisplayName &&
(id.idRange = vref.DefinitionRange || id.idRange = vref.SigRange))
| ILFieldUse f1, ILFieldUse f2 ->
ILFieldInfo.ILFieldInfosUseIdenticalDefinitions f1 f2
| UnionCaseUse u1, UnionCaseUse u2 ->
unionCaseRefDefnEq g u1 u2
| RecordFieldUse(name1, tcref1), RecordFieldUse(name2, tcref2) ->
name1 = name2 && tyconRefDefnEq g tcref1 tcref2
| EventUse evt1, EventUse evt2 ->
EventInfo.EventInfosUseIdenticalDefintions evt1 evt2 ||
// Allow for equality up to signature matching
match evt1.ArbitraryValRef, evt2.ArbitraryValRef with
| Some vref1, Some vref2 -> valRefDefnEq g vref1 vref2
| _ -> false
| Item.ModuleOrNamespaces modrefs1, Item.ModuleOrNamespaces modrefs2 ->
modrefs1 |> List.exists (fun modref1 -> modrefs2 |> List.exists (fun r -> tyconRefDefnEq g modref1 r || fullDisplayTextOfModRef modref1 = fullDisplayTextOfModRef r))
| _ -> false
[<System.Diagnostics.DebuggerDisplay("{DebugToString()}")>]
type CapturedNameResolution(p:pos, i:Item, io:ItemOccurence, de:DisplayEnv, nre:NameResolutionEnv, ad:AccessorDomain, m:range) =
member this.Pos = p
member this.Item = i
member this.ItemOccurence = io
member this.DisplayEnv = de
member this.NameResolutionEnv = nre
member this.AccessorDomain = ad
member this.Range = m
member this.DebugToString() =
sprintf "%A: %+A" (p.Line, p.Column) i
/// Represents container for all name resolutions that were met so far when typechecking some particular file
type TcResolutions
(capturedEnvs : ResizeArray<range * NameResolutionEnv * AccessorDomain>,
capturedExprTypes : ResizeArray<pos * TType * DisplayEnv * NameResolutionEnv * AccessorDomain * range>,
capturedNameResolutions : ResizeArray<CapturedNameResolution>,
capturedMethodGroupResolutions : ResizeArray<CapturedNameResolution>) =
static let empty = TcResolutions(ResizeArray(0),ResizeArray(0),ResizeArray(0),ResizeArray(0))
member this.CapturedEnvs = capturedEnvs
member this.CapturedExpressionTypings = capturedExprTypes
member this.CapturedNameResolutions = capturedNameResolutions
member this.CapturedMethodGroupResolutions = capturedMethodGroupResolutions
static member Empty = empty
/// Represents container for all name resolutions that were met so far when typechecking some particular file
type TcSymbolUses(g, capturedNameResolutions : ResizeArray<CapturedNameResolution>, formatSpecifierLocations: range[]) =
member this.GetUsesOfSymbol(item) =
[| for cnr in capturedNameResolutions do
if protectAssemblyExploration false (fun () -> ItemsAreEffectivelyEqual g item cnr.Item) then
yield cnr.ItemOccurence, cnr.DisplayEnv, cnr.Range |]
member this.GetAllUsesOfSymbols() =
[| for cnr in capturedNameResolutions do
yield (cnr.Item, cnr.ItemOccurence, cnr.DisplayEnv, cnr.Range) |]
member this.GetFormatSpecifierLocations() = formatSpecifierLocations
/// An accumulator for the results being emitted into the tcSink.
type TcResultsSinkImpl(g, ?source: string) =
let capturedEnvs = ResizeArray<_>()
let capturedExprTypings = ResizeArray<_>()
let capturedNameResolutions = ResizeArray<_>()
let capturedFormatSpecifierLocations = ResizeArray<_>()
let capturedNameResolutionIdentifiers =
new System.Collections.Generic.Dictionary<pos * string, unit>
( { new IEqualityComparer<_> with
member __.GetHashCode((p:pos,i)) = p.Line + 101 * p.Column + hash i
member __.Equals((p1,i1),(p2,i2)) = posEq p1 p2 && i1 = i2 } )
let capturedMethodGroupResolutions = ResizeArray<_>()
let allowedRange (m:range) = not m.IsSynthetic
member this.GetResolutions() =
TcResolutions(capturedEnvs, capturedExprTypings, capturedNameResolutions, capturedMethodGroupResolutions)
member this.GetSymbolUses() =
TcSymbolUses(g, capturedNameResolutions, capturedFormatSpecifierLocations.ToArray())
interface ITypecheckResultsSink with
member sink.NotifyEnvWithScope(m,nenv,ad) =
if allowedRange m then
capturedEnvs.Add((m,nenv,ad))
member sink.NotifyExprHasType(endPos,ty,denv,nenv,ad,m) =
if allowedRange m then
capturedExprTypings.Add((endPos,ty,denv,nenv,ad,m))
member sink.NotifyNameResolution(endPos,item,itemMethodGroup,occurenceType,denv,nenv,ad,m) =
// Desugaring some F# constructs (notably computation expressions with custom operators)
// results in duplication of textual variables. So we ensure we never record two name resolutions
// for the same identifier at the same location.
if allowedRange m then
let keyOpt =
match item with
| Item.Value vref -> Some (endPos, vref.DisplayName)
| Item.ArgName (id, _, _) -> Some (endPos, id.idText)
| _ -> None
let alreadyDone =
match keyOpt with
| Some key ->
let res = capturedNameResolutionIdentifiers.ContainsKey key
if not res then capturedNameResolutionIdentifiers.Add (key, ()) |> ignore
res
| _ -> false
if not alreadyDone then
capturedNameResolutions.Add(CapturedNameResolution(endPos,item,occurenceType,denv,nenv,ad,m))
capturedMethodGroupResolutions.Add(CapturedNameResolution(endPos,itemMethodGroup,occurenceType,denv,nenv,ad,m))
member sink.NotifyFormatSpecifierLocation(m) =
capturedFormatSpecifierLocations.Add(m)
member sink.CurrentSource = source
/// An abstract type for reporting the results of name resolution and type checking, and which allows
/// temporary suspension and/or redirection of reporting.
......@@ -1609,11 +1889,14 @@ let rec ResolveLongIdentInTypePrim (ncenv:NameResolver) nenv lookupKind (resInfo
| ResolveTypeNamesToTypeRefs ->
OneSuccess (resInfo,Item.Types (nm,nestedTypes),rest)
else
ResolveLongIdentInTypes ncenv nenv lookupKind resInfo (depth+1) m ad rest findFlag typeNameResInfo nestedTypes
ResolveLongIdentInNestedTypes ncenv nenv lookupKind resInfo (depth+1) id m ad rest findFlag typeNameResInfo nestedTypes
(OneResult contentsSearchAccessible +++ nestedSearchAccessible)
and ResolveLongIdentInTypes (ncenv:NameResolver) nenv lookupKind resInfo depth m ad lid findFlag typeNameResInfo typs =
typs |> CollectResults (ResolveLongIdentInTypePrim ncenv nenv lookupKind resInfo depth m ad lid findFlag typeNameResInfo >> AtMostOneResult m)
and ResolveLongIdentInNestedTypes (ncenv:NameResolver) nenv lookupKind resInfo depth id m ad lid findFlag typeNameResInfo typs =
typs |> CollectResults (fun typ ->
let resInfo = if isAppTy ncenv.g typ then resInfo.AddEntity(id.idRange,tcrefOfAppTy ncenv.g typ) else resInfo
ResolveLongIdentInTypePrim ncenv nenv lookupKind resInfo depth m ad lid findFlag typeNameResInfo typ
|> AtMostOneResult m)
/// Resolve a long identifier using type-qualified name resolution.
let ResolveLongIdentInType sink ncenv nenv lookupKind m ad lid findFlag typeNameResInfo typ =
......@@ -2025,6 +2308,8 @@ let rec ResolveTypeLongIdentInTyconRefPrim (ncenv:NameResolver) (typeNameResInfo
let ResolveTypeLongIdentInTyconRef sink (ncenv:NameResolver) nenv typeNameResInfo ad m tcref (lid: Ident list) =
let resInfo,tcref = ForceRaise (ResolveTypeLongIdentInTyconRefPrim ncenv typeNameResInfo ad ResolutionInfo.Empty PermitDirectReferenceToGeneratedType.No 0 m tcref lid)
ResolutionInfo.SendToSink(sink,ncenv,nenv,ItemOccurence.Use,ad,resInfo,ResultTyparChecker(fun () -> true));
let item = Item.Types(tcref.DisplayName,[FreshenTycon ncenv m tcref])
CallNameResolutionSink sink (rangeOfLid lid,nenv,item,item,ItemOccurence.UseInType,nenv.eDisplayEnv,ad)
tcref
......@@ -2219,8 +2504,12 @@ let ResolveFieldPrim (ncenv:NameResolver) nenv ad typ (mp,id:Ident) =
if nonNil rest then errorR(Error(FSComp.SR.nrInvalidFieldLabel(),(List.head rest).idRange));
[(resInfo,item)]
let ResolveField (_sink: TcResultsSink) ncenv nenv ad typ (mp,id) =
let ResolveField sink ncenv nenv ad typ (mp,id) =
let res = ResolveFieldPrim ncenv nenv ad typ (mp,id)
// Register the results of any field paths "Module.Type" in "Module.Type.field" as a name resolution. (Note, the path resolution
// info is only non-empty if there was a unique resolution of the field)
for (resInfo,_rfref) in res do
ResolutionInfo.SendToSink(sink,ncenv,nenv,ItemOccurence.UseInType, ad,resInfo,ResultTyparChecker(fun () -> true));
res |> List.map snd
/// Generate a new reference to a record field with a fresh type instantiation
......@@ -2320,8 +2609,16 @@ let ResolveLongIdentAsExprAndComputeRange (sink:TcResultsSink) (ncenv:NameResolv
// Record the precise resolution of the field for intellisense
let item = FilterMethodGroups ncenv itemRange item true
// Fake idents e.g. 'Microsoft.FSharp.Core.None' have identical ranges for each part
let isFakeIdents =
match lid with
| [] | [_] -> false
| head :: ids ->
ids |> List.forall (fun id -> id.idRange = head.idRange)
let callSink refinedItem =
CallNameResolutionSink sink (itemRange, nenv, refinedItem, item, ItemOccurence.Use, nenv.DisplayEnv, ad);
if not isFakeIdents then
CallNameResolutionSink sink (itemRange, nenv, refinedItem, item, ItemOccurence.Use, nenv.DisplayEnv, ad)
let afterOverloadResolution =
match sink.CurrentSink with
| None -> AfterOverloadResolution.DoNothing
......
src/fsharp/NameResolution.fsi
浏览文件 @ 9635bd0d
......@@ -32,6 +32,14 @@ type ArgumentContainer =
/// The named argument is a static parameter to a union case constructor
| UnionCase of UnionCaseInfo
//---------------------------------------------------------------------------
//
//-------------------------------------------------------------------------
/// Detect a use of a nominal type, including type abbreviations.
/// When reporting symbols, we care about abbreviations, e.g. 'int' and 'int32' count as two separate symbols.
val (|AbbrevOrAppTy|_|) : TType -> TyconRef option
[<NoEquality; NoComparison; RequireQualifiedAccess>]
/// Represents an item that results from name resolution
type Item =
......@@ -57,7 +65,7 @@ type Item =
/// Used to indicate the availability or resolution of a custom query operation such as 'sortBy' or 'where' in computation expression syntax
| CustomOperation of string * (unit -> string option) * MethInfo option
| CustomBuilder of string * ValRef
| TypeVar of string
| TypeVar of string * Typar
| ModuleOrNamespaces of Tast.ModuleOrNamespaceRef list
/// Represents the resolution of a source identifier to an implicit use of an infix operator (+solution if such available)
| ImplicitOp of Ident * TraitConstraintSln option ref
......@@ -65,7 +73,7 @@ type Item =
| ArgName of Ident * TType * ArgumentContainer option
| SetterArg of Ident * Item
| UnqualifiedType of TyconRef list
member DisplayName : TcGlobals -> string
member DisplayName : string
/// Represents a record field resolution and the information if the usage is deprecated.
type FieldResolution = FieldResolution of RecdFieldRef * bool
......@@ -179,13 +187,101 @@ type internal ItemOccurence =
| UseInType
| UseInAttribute
| Pattern
| Implemented
| RelatedText
/// Check for equality, up to signature matching
val ItemsAreEffectivelyEqual : TcGlobals -> Item -> Item -> bool
[<Class>]
type internal CapturedNameResolution =
/// line and column
member Pos : pos
/// Named item
member Item : Item
/// Information about the occurence of the symbol
member ItemOccurence : ItemOccurence
/// Information about printing. For example, should redundant keywords be hidden?
member DisplayEnv : DisplayEnv
/// Naming environment--for example, currently open namespaces.
member NameResolutionEnv : NameResolutionEnv
/// The access rights of code at the location
member AccessorDomain : AccessorDomain
/// The starting and ending position
member Range : range
[<Class>]
type internal TcResolutions =
/// Name resolution environments for every interesting region in the file. These regions may
/// overlap, in which case the smallest region applicable should be used.
member CapturedEnvs : ResizeArray<range * NameResolutionEnv * AccessorDomain>
/// Information of exact types found for expressions, that can be to the left of a dot.
/// typ - the inferred type for an expression
member CapturedExpressionTypings : ResizeArray<pos * TType * DisplayEnv * NameResolutionEnv * AccessorDomain * range>
/// Exact name resolutions
member CapturedNameResolutions : ResizeArray<CapturedNameResolution>
/// Represents all the resolutions of names to groups of methods.
member CapturedMethodGroupResolutions : ResizeArray<CapturedNameResolution>
/// Represents the empty set of resolutions
static member Empty : TcResolutions
[<Class>]
/// Represents container for all name resolutions that were met so far when typechecking some particular file
type internal TcSymbolUses =
/// Get all the uses of a particular item within the file
member GetUsesOfSymbol : Item -> (ItemOccurence * DisplayEnv * range)[]
/// Get all the uses of all items within the file
member GetAllUsesOfSymbols : unit -> (Item * ItemOccurence * DisplayEnv * range)[]
/// Get the locations of all the printf format specifiers in the file
member GetFormatSpecifierLocations : unit -> range[]
/// An abstract type for reporting the results of name resolution and type checking
type ITypecheckResultsSink =
/// Record that an environment is active over the given scope range
abstract NotifyEnvWithScope : range * NameResolutionEnv * AccessorDomain -> unit
/// Record that an expression has a specific type at the given range.
abstract NotifyExprHasType : pos * TType * DisplayEnv * NameResolutionEnv * AccessorDomain * range -> unit
/// Record that a name resolution occurred at a specific location in the source
abstract NotifyNameResolution : pos * Item * Item * ItemOccurence * DisplayEnv * NameResolutionEnv * AccessorDomain * range -> unit
/// Record that a printf format specifier occurred at a specific location in the source
abstract NotifyFormatSpecifierLocation : range -> unit
/// Get the current source
abstract CurrentSource : string option
/// An implementation of ITypecheckResultsSink to collect information during type checking
type internal TcResultsSinkImpl =
/// Create a TcResultsSinkImpl
new : tcGlobals : TcGlobals * ?source:string -> TcResultsSinkImpl
/// Get all the resolutions reported to the sink
member GetResolutions : unit -> TcResolutions
/// Get all the uses of all symbols remorted to the sink
member GetSymbolUses : unit -> TcSymbolUses
interface ITypecheckResultsSink
/// An abstract type for reporting the results of name resolution and type checking, and which allows
/// temporary suspension and/or redirection of reporting.
type TcResultsSink =
......
src/fsharp/NicePrint.fs
浏览文件 @ 9635bd0d
......@@ -647,7 +647,7 @@ module private PrintTypes =
/// Layout an attribute 'Type(arg1, ..., argN)'
//
// REVIEW: we are ignoring "props" here
and private layoutAttrib denv (Attrib(_,k,args,_props,_,_,_)) =
and layoutAttrib denv (Attrib(_,k,args,_props,_,_,_)) =
let argsL = bracketL (layoutAttribArgs denv args)
match k with
| (ILAttrib(ilMethRef)) ->
......@@ -667,6 +667,47 @@ module private PrintTypes =
let tcref = tcrefOfAppTy denv.g rty
layoutTyconRef denv tcref ++ argsL
and layoutILAttribElement denv arg =
match arg with
| ILAttribElem.String (Some x) -> wordL ("\"" + x + "\"")
| ILAttribElem.String None -> wordL ""
| ILAttribElem.Bool x -> if x then wordL "true" else wordL "false"
| ILAttribElem.Char x -> wordL ("'" + x.ToString() + "'" )
| ILAttribElem.SByte x -> wordL ((x |> string)+"y")
| ILAttribElem.Int16 x -> wordL ((x |> string)+"s")
| ILAttribElem.Int32 x -> wordL ((x |> string))
| ILAttribElem.Int64 x -> wordL ((x |> string)+"L")
| ILAttribElem.Byte x -> wordL ((x |> string)+"uy")
| ILAttribElem.UInt16 x -> wordL ((x |> string)+"us")
| ILAttribElem.UInt32 x -> wordL ((x |> string)+"u")
| ILAttribElem.UInt64 x -> wordL ((x |> string)+"UL")
| ILAttribElem.Single x ->
let str =
let s = x.ToString("g12",System.Globalization.CultureInfo.InvariantCulture)
(if String.forall (fun c -> System.Char.IsDigit(c) || c = '-') s
then s + ".0"
else s) + "f"
wordL str
| ILAttribElem.Double x ->
let str =
let s = x.ToString("g12",System.Globalization.CultureInfo.InvariantCulture)
if String.forall (fun c -> System.Char.IsDigit(c) || c = '-') s
then s + ".0"
else s
wordL str
| ILAttribElem.Null -> wordL "null"
| ILAttribElem.Array (_, xs) ->
leftL "[|" ^^ semiListL (List.map (layoutILAttribElement denv) xs) ^^ rightL "|]"
| ILAttribElem.Type (Some ty) ->
leftL "typeof<" ^^ PrintIL.layoutILType denv [] ty ^^ rightL ">"
| ILAttribElem.Type None -> wordL ""
| ILAttribElem.TypeRef (Some ty) ->
leftL "typedefof<" ^^ PrintIL.layoutILTypeRef denv ty ^^ rightL ">"
| ILAttribElem.TypeRef None -> wordL ""
and layoutILAttrib denv (ty, args) =
let argsL = bracketL (sepListL (rightL ",") (List.map (layoutILAttribElement denv) args))
PrintIL.layoutILType denv [] ty ++ argsL
/// Layout '[<attribs>]' above another block
and layoutAttribs denv kind attrs restL =
......@@ -690,7 +731,7 @@ module private PrintTypes =
| TyparKind.Type -> restL
| TyparKind.Measure -> squareAngleL (wordL "Measure") @@ restL
and private layoutTyparAttribs denv kind attrs restL =
and layoutTyparAttribs denv kind attrs restL =
match attrs, kind with
| [], TyparKind.Type -> restL
| _, _ -> squareAngleL (sepListL (rightL ";") ((match kind with TyparKind.Type -> [] | TyparKind.Measure -> [wordL "Measure"]) @ List.map (layoutAttrib denv) attrs)) ^^ restL
......@@ -1026,6 +1067,9 @@ module private PrintTypes =
let cxsL = layoutConstraintsWithInfo denv env env.postfixConstraints
layoutTypeWithInfoAndPrec denv env 2 typ --- cxsL
let layoutPrettyTypeNoCx denv typ =
let _,typ,_cxs = PrettyTypes.PrettifyTypes1 denv.g typ
layoutTypeWithInfoAndPrec denv SimplifyTypes.typeSimplificationInfo0 5 typ
/// Printing TAST objects
module private PrintTastMemberOrVals =
......@@ -1838,10 +1882,14 @@ let isGeneratedExceptionField pos f = TastDefinitionPrinting.isGeneratedExce
let stringOfTyparConstraint denv tpc = stringOfTyparConstraints denv [tpc]
let stringOfTy denv x = x |> PrintTypes.layoutType denv |> showL
let prettyStringOfTy denv x = x |> PrintTypes.layoutPrettyType denv |> showL
let prettyStringOfTyNoCx denv x = x |> PrintTypes.layoutPrettyTypeNoCx denv |> showL
let stringOfRecdField denv x = x |> TastDefinitionPrinting.layoutRecdField false denv |> showL
let stringOfUnionCase denv x = x |> TastDefinitionPrinting.layoutUnionCase denv (wordL "|") |> showL
let stringOfExnDef denv x = x |> TastDefinitionPrinting.layoutExnDefn denv |> showL
let stringOfFSAttrib denv x = x |> PrintTypes.layoutAttrib denv |> squareAngleL |> showL
let stringOfILAttrib denv x = x |> PrintTypes.layoutILAttrib denv |> squareAngleL |> showL
let layoutInferredSigOfModuleExpr showHeader denv infoReader ad m expr = InferredSigPrinting.layoutInferredSigOfModuleExpr showHeader denv infoReader ad m expr
let layoutValOrMember denv v = PrintTastMemberOrVals.layoutValOrMember denv v
let layoutPrettifiedTypes denv taus = PrintTypes.layoutPrettifiedTypes denv taus
......
src/fsharp/QuotationTranslator.fs
浏览文件 @ 9635bd0d
......@@ -71,7 +71,7 @@ type QuotationGenerationScope =
static member ComputeQuotationFormat g =
let deserializeExValRef = ValRefForIntrinsic g.deserialize_quoted_FSharp_40_plus_info
if deserializeExValRef.TryDeref.IsSome then
if deserializeExValRef.TryDeref.IsSome then
QuotationSerializationFormat.FSharp_40_Plus
else
QuotationSerializationFormat.FSharp_20_Plus
......@@ -125,7 +125,7 @@ exception IgnoringPartOfQuotedTermWarning of string * Range.range
let wfail e = raise (InvalidQuotedTerm(e))
let (|ModuleValueOrMemberUse|_|) cenv expr =
let (|ModuleValueOrMemberUse|_|) g expr =
let rec loop expr args =
match stripExpr expr with
| Expr.App((InnerExprPat(Expr.Val(vref,vFlags,_) as f)),fty,tyargs,actualArgs,_m) when vref.IsMemberOrModuleBinding ->
......@@ -133,7 +133,7 @@ let (|ModuleValueOrMemberUse|_|) cenv expr =
| Expr.App(f,_fty,[],actualArgs,_) ->
loop f (actualArgs @ args)
| (Expr.Val(vref,vFlags,_m) as f) when (match vref.ActualParent with ParentNone -> false | _ -> true) ->
let fty = tyOfExpr cenv.g f
let fty = tyOfExpr g f
Some(vref,vFlags,f,fty,[],args)
| _ ->
None
......@@ -228,7 +228,7 @@ and private ConvExprCore cenv (env : QuotationTranslationEnv) (expr: Expr) : QP.
let hole = QP.mkHole(ConvType cenv env m ty,idx)
(hole, rest) ||> List.fold (fun fR arg -> QP.mkApp (fR,ConvExpr cenv env arg))
| ModuleValueOrMemberUse cenv (vref,vFlags,_f,_fty,tyargs,curriedArgs)
| ModuleValueOrMemberUse cenv.g (vref,vFlags,_f,_fty,tyargs,curriedArgs)
when not (isSplice cenv.g vref) ->
let m = expr.Range
......
src/fsharp/QuotationTranslator.fsi
浏览文件 @ 9635bd0d
......@@ -41,3 +41,9 @@ val ConvExprPublic : QuotationGenerationScope -> QuotationTranslationEnv -> Expr
val ConvMethodBase : QuotationGenerationScope -> QuotationTranslationEnv -> string * Val -> QuotationPickler.MethodBaseData
val (|ModuleValueOrMemberUse|_|) : TcGlobals -> Expr -> (ValRef * ValUseFlag * Expr * TType * TypeInst * Expr list) option
val (|SimpleArrayLoopUpperBound|_|) : Expr -> unit option
val (|SimpleArrayLoopBody|_|) : TcGlobals -> Expr -> (Expr * TType * Expr) option
val (|ObjectInitializationCheck|_|) : TcGlobals -> Expr -> unit option
val isSplice : TcGlobals -> ValRef -> bool
src/fsharp/TastOps.fs
浏览文件 @ 9635bd0d
......@@ -2282,8 +2282,9 @@ module PrettyTypes = begin
let PrettifyTypes1 g x = PrettifyTypes g (fun f -> f) (fun f -> f) x
let PrettifyTypes2 g x = PrettifyTypes g (fun f -> foldPair (f,f)) (fun f -> mapPair (f,f)) x
let PrettifyTypesN g x = PrettifyTypes g List.fold List.map x
let PrettifyTypesNN g x = PrettifyTypes g (fun f -> List.fold (List.fold f)) List.mapSquared x
let PrettifyTypesNN1 g x = PrettifyTypes g (fun f -> foldPair (List.fold (List.fold f),f)) (fun f -> mapPair (List.mapSquared f,f)) x
let PrettifyTypesN1 g (x:UncurriedArgInfos * TType) = PrettifyTypes g (fun f -> foldPair (List.fold (fold1Of2 f), f)) (fun f -> mapPair (List.map (map1Of2 f),f)) x
let PrettifyTypesNN1 g x = PrettifyTypes g (fun f -> foldTriple (List.fold f, List.fold (fold1Of2 f),f)) (fun f -> mapTriple (List.map f, List.map (map1Of2 f), f)) x
let PrettifyTypesNM1 g (x:TType list * CurriedArgInfos * TType) = PrettifyTypes g (fun f -> foldTriple (List.fold f, List.fold (List.fold (fold1Of2 f)),f)) (fun f -> mapTriple (List.map f, List.mapSquared (map1Of2 f), f)) x
end
......@@ -4454,7 +4455,7 @@ and remapValData g tmenv d =
val_type = ty';
val_actual_parent = d.val_actual_parent |> remapParentRef tmenv;
val_repr_info = d.val_repr_info |> Option.map (remapValReprInfo g tmenv);
val_member_info = d.val_member_info |> Option.map (remapMemberInfo g d.val_defn_range topValInfo ty ty' tmenv);
val_member_info = d.val_member_info |> Option.map (remapMemberInfo g d.val_range topValInfo ty ty' tmenv);
val_attribs = d.val_attribs |> remapAttribs g tmenv }
and remapParentRef tyenv p =
......
src/fsharp/TastOps.fsi
浏览文件 @ 9635bd0d
......@@ -582,6 +582,8 @@ module PrettyTypes =
val PrettifyTypes1 : TcGlobals -> TType -> TyparInst * TType * TyparConstraintsWithTypars
val PrettifyTypes2 : TcGlobals -> TType * TType -> TyparInst * (TType * TType) * TyparConstraintsWithTypars
val PrettifyTypesN : TcGlobals -> TType list -> TyparInst * TType list * TyparConstraintsWithTypars
val PrettifyTypesNN : TcGlobals -> TType list list -> TyparInst * TType list list * TyparConstraintsWithTypars
val PrettifyTypesNN1 : TcGlobals -> TType list list * TType -> TyparInst * (TType list list * TType) * TyparConstraintsWithTypars
val PrettifyTypesN1 : TcGlobals -> UncurriedArgInfos * TType -> TyparInst * (UncurriedArgInfos * TType) * TyparConstraintsWithTypars
val PrettifyTypesNM1 : TcGlobals -> TType list * CurriedArgInfos * TType -> TyparInst * (TType list * CurriedArgInfos * TType) * TyparConstraintsWithTypars
......
src/fsharp/TastPickle.fs
浏览文件 @ 9635bd0d
......@@ -154,7 +154,7 @@ type ReaderState =
inlerefs: InputTable<NonLocalEntityRef>;
isimpletyps: InputTable<TType>;
ifile: string;
iILModule : ILModuleDef // the Abstract IL metadata for the DLL being read
iILModule : ILModuleDef option // the Abstract IL metadata for the DLL being read
}
let ufailwith st str = ffailwith st.ifile str
......@@ -731,7 +731,7 @@ let check (ilscope:ILScopeRef) (inMap : NodeInTable<_,_>) =
warning(Error(FSComp.SR.pickleMissingDefinition (i, inMap.Name, ilscope.QualifiedName), range0))
// Note for compiler developers: to get information about which item this index relates to, enable the conditional in Pickle.p_osgn_ref to refer to the given index number and recompile an identical copy of the source for the DLL containing the data being unpickled. A message will then be printed indicating the name of the item.\n"
let unpickleObjWithDanglingCcus file ilscope (iILModule:ILModuleDef) u (phase2bytes:byte[]) =
let unpickleObjWithDanglingCcus file ilscope (iILModule:ILModuleDef option) u (phase2bytes:byte[]) =
let st2 =
{ is = ByteStream.FromBytes (phase2bytes,0,phase2bytes.Length);
iilscope= ilscope;
......@@ -1840,7 +1840,7 @@ and p_ValData x st =
( x.val_logical_name,
x.val_compiled_name,
// only keep range information on published values, not on optimization data
(if x.val_repr_info.IsSome then Some(x.val_range, x.val_defn_range) else None),
(if x.val_repr_info.IsSome then Some(x.val_range, x.DefinitionRange) else None),
x.val_type,
x.val_flags.PickledBits,
x.val_member_info,
......@@ -1887,13 +1887,16 @@ and u_tycon_repr st =
(fun flagBit ->
if flagBit then
let iltref = v.TypeRef
match st.iILModule with
| None -> TNoRepr
| Some iILModule ->
try
let rec find acc enclosingTypeNames (tdefs:ILTypeDefs) =
match enclosingTypeNames with
| [] -> List.rev acc, tdefs.FindByName iltref.Name
| h::t -> let nestedTypeDef = tdefs.FindByName h
find (tdefs.FindByName h :: acc) t nestedTypeDef.NestedTypes
let nestedILTypeDefs,ilTypeDef = find [] iltref.Enclosing st.iILModule.TypeDefs
let nestedILTypeDefs,ilTypeDef = find [] iltref.Enclosing iILModule.TypeDefs
TILObjModelRepr(st.iilscope,nestedILTypeDefs,ilTypeDef)
with _ ->
System.Diagnostics.Debug.Assert(false, sprintf "failed to find IL backing metadata for cross-assembly generated type %s" iltref.FullName)
......@@ -1915,7 +1918,14 @@ and u_tycon_objmodel_data st =
and u_unioncase_spec st =
let a,b,c,d,e,f,i = u_tup7 u_rfield_table u_typ u_string u_ident u_attribs u_string u_access st
{FieldTable=a; ReturnType=b; CompiledName=c; Id=d; Attribs=e;XmlDoc=XmlDoc.Empty;XmlDocSig=f;Accessibility=i }
{FieldTable=a;
ReturnType=b;
CompiledName=c;
Id=d;
Attribs=e;
XmlDoc=XmlDoc.Empty;
XmlDocSig=f;Accessibility=i;
OtherRangeOpt=None }
and u_exnc_spec_data st = u_entity_spec_data st
......@@ -1961,7 +1971,8 @@ and u_recdfield_spec st =
rfield_fattribs=e2;
rfield_xmldoc=XmlDoc.Empty;
rfield_xmldocsig=f;
rfield_access=g }
rfield_access=g
rfield_other_range = None }
and u_rfield_table st = MakeRecdFieldsTable (u_list u_recdfield_spec st)
......@@ -1995,6 +2006,7 @@ and u_entity_spec_data st : EntityData =
entity_logical_name=x2a;
entity_compiled_name=x2b;
entity_range=x2c;
entity_other_range=None;
entity_pubpath=x3;
entity_accessiblity=x4a;
entity_tycon_repr_accessibility=x4b;
......@@ -2129,7 +2141,7 @@ and u_ValData st =
{ val_logical_name=x1;
val_compiled_name=x1z;
val_range=(match x1a with None -> range0 | Some(a,_) -> a);
val_defn_range=(match x1a with None -> range0 | Some(_,b) -> b);
val_other_range=(match x1a with None -> None | Some(_,b) -> Some(b,true));
val_type=x2;
val_stamp=newStamp();
val_flags=ValFlags(x4);
......
src/fsharp/TastPickle.fsi
浏览文件 @ 9635bd0d
......@@ -145,7 +145,7 @@ val internal u_typ : unpickler<TType>
val internal unpickleCcuInfo : ReaderState -> PickledCcuInfo
/// Deserialize an arbitrary object which may have holes referring to other compilation units
val internal unpickleObjWithDanglingCcus : string -> viewedScope:ILScopeRef -> ilModule:ILModuleDef -> ('T unpickler) -> byte[] -> PickledDataWithReferences<'T>
val internal unpickleObjWithDanglingCcus : string -> viewedScope:ILScopeRef -> ilModule:ILModuleDef option -> ('T unpickler) -> byte[] -> PickledDataWithReferences<'T>
src/fsharp/TcGlobals.fs
浏览文件 @ 9635bd0d
......@@ -325,6 +325,7 @@ type public TcGlobals =
attrib_StructAttribute : BuiltinAttribInfo
attrib_ReflectedDefinitionAttribute : BuiltinAttribInfo
attrib_AutoOpenAttribute : BuiltinAttribInfo
attrib_InternalsVisibleToAttribute : BuiltinAttribInfo
attrib_CompilationRepresentationAttribute : BuiltinAttribInfo
attrib_CompilationArgumentCountsAttribute : BuiltinAttribInfo
attrib_CompilationMappingAttribute : BuiltinAttribInfo
......@@ -1223,6 +1224,7 @@ let mkTcGlobals (compilingFslib,sysCcu,ilg,fslibCcu,directoryToResolveRelativePa
attrib_ReflectedDefinitionAttribute = mk_MFCore_attrib "ReflectedDefinitionAttribute"
attrib_CompiledNameAttribute = mk_MFCore_attrib "CompiledNameAttribute"
attrib_AutoOpenAttribute = mk_MFCore_attrib "AutoOpenAttribute"
attrib_InternalsVisibleToAttribute = mkSystemRuntimeAttrib "System.Runtime.CompilerServices.InternalsVisibleToAttribute"
attrib_CompilationRepresentationAttribute = mk_MFCore_attrib "CompilationRepresentationAttribute"
attrib_CompilationArgumentCountsAttribute = mk_MFCore_attrib "CompilationArgumentCountsAttribute"
attrib_CompilationMappingAttribute = mk_MFCore_attrib "CompilationMappingAttribute"
......
src/fsharp/TypeChecker.fs
浏览文件 @ 9635bd0d
此差异已折叠。
src/fsharp/TypeRelations.fs
浏览文件 @ 9635bd0d
......@@ -423,6 +423,9 @@ module SignatureConformance = begin
and checkTypeDef (aenv: TypeEquivEnv) (implTycon:Tycon) (sigTycon:Tycon) =
let m = implTycon.Range
// Propagate defn location information from implementation to signature .
sigTycon.SetOtherRange (implTycon.Range, true)
implTycon.SetOtherRange (sigTycon.Range, false)
let err f = Error(f(implTycon.TypeOrMeasureKind.ToString()), m)
if implTycon.LogicalName <> sigTycon.LogicalName then (errorR (err (FSComp.SR.DefinitionsInSigAndImplNotCompatibleNamesDiffer)); false) else
if implTycon.CompiledName <> sigTycon.CompiledName then (errorR (err (FSComp.SR.DefinitionsInSigAndImplNotCompatibleNamesDiffer)); false) else
......@@ -532,7 +535,8 @@ module SignatureConformance = begin
and checkVal implModRef (aenv:TypeEquivEnv) (implVal:Val) (sigVal:Val) =
// Propagate defn location information from implementation to signature .
sigVal.SetDefnRange implVal.DefinitionRange
sigVal.SetOtherRange (implVal.Range, true)
implVal.SetOtherRange (sigVal.Range, false)
let mk_err denv f = ValueNotContained(denv,implModRef,implVal,sigVal,f)
let err denv f = errorR(mk_err denv f); false
......@@ -577,6 +581,8 @@ module SignatureConformance = begin
and checkUnionCase aenv implUnionCase sigUnionCase =
let err f = errorR(ConstrNotContained(denv,implUnionCase,sigUnionCase,f));false
sigUnionCase.OtherRangeOpt <- Some (implUnionCase.Range, true)
implUnionCase.OtherRangeOpt <- Some (sigUnionCase.Range, false)
if implUnionCase.Id.idText <> sigUnionCase.Id.idText then err FSComp.SR.ModuleContainsConstructorButNamesDiffer
elif implUnionCase.RecdFields.Length <> sigUnionCase.RecdFields.Length then err FSComp.SR.ModuleContainsConstructorButDataFieldsDiffer
elif not (List.forall2 (checkField aenv) implUnionCase.RecdFields sigUnionCase.RecdFields) then err FSComp.SR.ModuleContainsConstructorButTypesOfFieldsDiffer
......@@ -585,6 +591,8 @@ module SignatureConformance = begin
and checkField aenv implField sigField =
let err f = errorR(FieldNotContained(denv,implField,sigField,f)); false
sigField.rfield_other_range <- Some (implField.Range, true)
implField.rfield_other_range <- Some (sigField.Range, false)
if implField.rfield_id.idText <> sigField.rfield_id.idText then err FSComp.SR.FieldNotContainedNamesDiffer
elif isLessAccessible implField.Accessibility sigField.Accessibility then err FSComp.SR.FieldNotContainedAccessibilitiesDiffer
elif implField.IsStatic <> sigField.IsStatic then err FSComp.SR.FieldNotContainedStaticsDiffer
......@@ -845,6 +853,9 @@ module SignatureConformance = begin
and checkModuleOrNamespace aenv implModRef sigModRef =
// Propagate defn location information from implementation to signature .
sigModRef.SetOtherRange (implModRef.Range, true)
implModRef.Deref.SetOtherRange (sigModRef.Range, false)
checkModuleOrNamespaceContents implModRef.Range aenv implModRef sigModRef.ModuleOrNamespaceType &&
checkAttribs aenv implModRef.Attribs sigModRef.Attribs implModRef.Deref.SetAttribs
......@@ -900,14 +911,15 @@ type OverrideCanImplement =
/// The overall information about a method implementation in a class or object expression
type OverrideInfo =
| Override of OverrideCanImplement * TyconRef * Ident * (Typars * TyparInst) * TType list list * TType option * bool
member x.CanImplement = let (Override(a,_,_,_,_,_,_)) = x in a
member x.BoundingTyconRef = let (Override(_,ty,_,_,_,_,_)) = x in ty
member x.LogicalName = let (Override(_,_,id,_,_,_,_)) = x in id.idText
member x.Range = let (Override(_,_,id,_,_,_,_)) = x in id.idRange
member x.IsFakeEventProperty = let (Override(_,_,_,_,_,_,b)) = x in b
member x.ArgTypes = let (Override(_,_,_,_,b,_,_)) = x in b
member x.ReturnType = let (Override(_,_,_,_,_,b,_)) = x in b
| Override of OverrideCanImplement * TyconRef * Ident * (Typars * TyparInst) * TType list list * TType option * bool * bool
member x.CanImplement = let (Override(a,_,_,_,_,_,_,_)) = x in a
member x.BoundingTyconRef = let (Override(_,ty,_,_,_,_,_,_)) = x in ty
member x.LogicalName = let (Override(_,_,id,_,_,_,_,_)) = x in id.idText
member x.Range = let (Override(_,_,id,_,_,_,_,_)) = x in id.idRange
member x.IsFakeEventProperty = let (Override(_,_,_,_,_,_,b,_)) = x in b
member x.ArgTypes = let (Override(_,_,_,_,b,_,_,_)) = x in b
member x.ReturnType = let (Override(_,_,_,_,_,b,_,_)) = x in b
member x.IsCompilerGenerated = let (Override(_,_,_,_,_,_,_,b)) = x in b
// If the bool is true then the slot is optional, i.e. is an interface slot
// which does not _have_ to be implemented, because an inherited implementation
......@@ -922,7 +934,7 @@ exception OverrideDoesntOverride of DisplayEnv * OverrideInfo * MethInfo option
module DispatchSlotChecking =
/// Print the signature of an override to a buffer as part of an error message
let PrintOverrideToBuffer denv os (Override(_,_,id,(mtps,memberToParentInst),argTys,retTy,_)) =
let PrintOverrideToBuffer denv os (Override(_,_,id,(mtps,memberToParentInst),argTys,retTy,_,_)) =
let denv = { denv with showTyparBinding = true }
let retTy = (retTy |> GetFSharpViewOfReturnType denv.g)
let argInfos =
......@@ -952,7 +964,7 @@ module DispatchSlotChecking =
let (CompiledSig (argTys,retTy,fmtps,ttpinst)) = CompiledSigOfMeth g amap m minfo
let isFakeEventProperty = minfo.IsFSharpEventPropertyMethod
Override(parentType,tcrefOfAppTy g minfo.EnclosingType,mkSynId m nm, (fmtps,ttpinst),argTys,retTy,isFakeEventProperty)
Override(parentType,tcrefOfAppTy g minfo.EnclosingType,mkSynId m nm, (fmtps,ttpinst),argTys,retTy,isFakeEventProperty,false)
/// Get the override info for a value being used to implement a dispatch slot.
let GetTypeMemberOverrideInfo g reqdTy (overrideBy:ValRef) =
......@@ -990,7 +1002,7 @@ module DispatchSlotChecking =
//CanImplementAnySlot <<----- Change to this to enable implicit interface implementation
let isFakeEventProperty = overrideBy.IsFSharpEventProperty(g)
Override(implKind,overrideBy.MemberApparentParent, mkSynId overrideBy.Range nm, (memberMethodTypars,memberToParentInst),argTys,retTy,isFakeEventProperty)
Override(implKind,overrideBy.MemberApparentParent, mkSynId overrideBy.Range nm, (memberMethodTypars,memberToParentInst),argTys,retTy,isFakeEventProperty, overrideBy.IsCompilerGenerated)
/// Get the override information for an object expression method being used to implement dispatch slots
let GetObjectExprOverrideInfo g amap (implty, id:Ident, memberFlags, ty, arityInfo, bindingAttribs, rhsExpr) =
......@@ -1013,7 +1025,7 @@ module DispatchSlotChecking =
CanImplementAnyClassHierarchySlot
//CanImplementAnySlot <<----- Change to this to enable implicit interface implementation
let isFakeEventProperty = CompileAsEvent g bindingAttribs
let overrideByInfo = Override(implKind, tcrefOfAppTy g implty, id, (tps,[]), argTys, retTy, isFakeEventProperty)
let overrideByInfo = Override(implKind, tcrefOfAppTy g implty, id, (tps,[]), argTys, retTy, isFakeEventProperty, false)
overrideByInfo, (baseValOpt, thisv, vs, bindingAttribs, rhsExpr)
| _ ->
error(InternalError("Unexpected shape for object expression override",id.idRange))
......@@ -1034,12 +1046,12 @@ module DispatchSlotChecking =
| CanImplementAnyInterfaceSlot -> isInterfaceTy g dispatchSlot.EnclosingType)
/// Check if the kinds of type parameters match between a dispatch slot and an override.
let IsTyparKindMatch g amap m (dispatchSlot:MethInfo) (Override(_,_,_,(mtps,_),_,_,_)) =
let IsTyparKindMatch g amap m (dispatchSlot:MethInfo) (Override(_,_,_,(mtps,_),_,_,_,_)) =
let (CompiledSig(_,_,fvmtps,_)) = CompiledSigOfMeth g amap m dispatchSlot
List.lengthsEqAndForall2 (fun (tp1:Typar) (tp2:Typar) -> tp1.Kind = tp2.Kind) mtps fvmtps
/// Check if an override is a partial match for the requirements for a dispatch slot
let IsPartialMatch g amap m (dispatchSlot:MethInfo) (Override(_,_,_,(mtps,_),argTys,_retTy,_) as overrideBy) =
let IsPartialMatch g amap m (dispatchSlot:MethInfo) (Override(_,_,_,(mtps,_),argTys,_retTy,_,_) as overrideBy) =
IsNameMatch dispatchSlot overrideBy &&
let (CompiledSig (vargtys,_,fvmtps,_)) = CompiledSigOfMeth g amap m dispatchSlot
mtps.Length = fvmtps.Length &&
......@@ -1056,7 +1068,7 @@ module DispatchSlotChecking =
inst1 |> List.map (map2Of2 (instType inst2))
/// Check if an override exactly matches the requirements for a dispatch slot
let IsExactMatch g amap m dispatchSlot (Override(_,_,_,(mtps,mtpinst),argTys,retTy,_) as overrideBy) =
let IsExactMatch g amap m dispatchSlot (Override(_,_,_,(mtps,mtpinst),argTys,retTy,_,_) as overrideBy) =
IsPartialMatch g amap m dispatchSlot overrideBy &&
let (CompiledSig (vargtys,vrty,fvmtps,ttpinst)) = CompiledSigOfMeth g amap m dispatchSlot
......@@ -1116,6 +1128,7 @@ module DispatchSlotChecking =
/// Check all dispatch slots are implemented by some override.
let CheckDispatchSlotsAreImplemented (denv,g,amap,m,
nenv,sink:TcResultsSink,
isOverallTyAbstract,
reqdTy,
dispatchSlots:RequiredSlot list,
......@@ -1135,7 +1148,11 @@ module DispatchSlotChecking =
match NameMultiMap.find dispatchSlot.LogicalName overridesKeyed
|> List.filter (OverrideImplementsDispatchSlot g amap m dispatchSlot) with
| [_] ->
| [ovd] ->
if not ovd.IsCompilerGenerated then
let item = Item.MethodGroup(ovd.LogicalName,[dispatchSlot])
CallNameResolutionSink sink (ovd.Range,nenv,item,item,ItemOccurence.Implemented,denv,AccessorDomain.AccessibleFromSomewhere)
sink |> ignore
()
| [] ->
if not isOptional &&
......@@ -1151,7 +1168,7 @@ module DispatchSlotChecking =
IsImplMatch g dispatchSlot overrideBy) with
| [] ->
noimpl()
| [ Override(_,_,_,(mtps,_),argTys,_,_) as overrideBy ] ->
| [ Override(_,_,_,(mtps,_),argTys,_,_,_) as overrideBy ] ->
let error_msg =
if argTys.Length <> vargtys.Length then FSComp.SR.typrelMemberDoesNotHaveCorrectNumberOfArguments(FormatOverride denv overrideBy, FormatMethInfoSig g amap m denv dispatchSlot)
elif mtps.Length <> fvmtps.Length then FSComp.SR.typrelMemberDoesNotHaveCorrectNumberOfTypeParameters(FormatOverride denv overrideBy, FormatMethInfoSig g amap m denv dispatchSlot)
......@@ -1356,7 +1373,7 @@ module DispatchSlotChecking =
/// Check that a type definition implements all its required interfaces after processing all declarations
/// within a file.
let CheckImplementationRelationAtEndOfInferenceScope (infoReader:InfoReader,denv,tycon:Tycon,isImplementation) =
let CheckImplementationRelationAtEndOfInferenceScope (infoReader :InfoReader,denv,nenv,sink,tycon:Tycon,isImplementation) =
let g = infoReader.g
let amap = infoReader.amap
......@@ -1418,7 +1435,7 @@ module DispatchSlotChecking =
if isImplementation && not (isInterfaceTy g overallTy) then
let overrides = allImmediateMembersThatMightImplementDispatchSlots |> List.map snd
let allCorrect = CheckDispatchSlotsAreImplemented (denv,g,amap,m,tcaug.tcaug_abstract,reqdTy,dispatchSlots,availPriorOverrides,overrides)
let allCorrect = CheckDispatchSlotsAreImplemented (denv,g,amap,m,nenv,sink,tcaug.tcaug_abstract,reqdTy,dispatchSlots,availPriorOverrides,overrides)
// Tell the user to mark the thing abstract if it was missing implementations
if not allCorrect && not tcaug.tcaug_abstract && not (isInterfaceTy g reqdTy) then
......@@ -1928,7 +1945,7 @@ let ExamineMethodForLambdaPropagation(x:CalledMeth<SynExpr>) =
/// "Type Completion" inference and a few other checks at the end of the inference scope
let FinalTypeDefinitionChecksAtEndOfInferenceScope (infoReader:InfoReader) isImplementation denv (tycon:Tycon) =
let FinalTypeDefinitionChecksAtEndOfInferenceScope (infoReader:InfoReader, nenv, sink, isImplementation, denv) (tycon:Tycon) =
let g = infoReader.g
let amap = infoReader.amap
......@@ -1985,7 +2002,7 @@ let FinalTypeDefinitionChecksAtEndOfInferenceScope (infoReader:InfoReader) isImp
&& not tycon.IsFSharpInterfaceTycon
&& not tycon.IsFSharpDelegateTycon then
DispatchSlotChecking.CheckImplementationRelationAtEndOfInferenceScope (infoReader,denv,tycon,isImplementation)
DispatchSlotChecking.CheckImplementationRelationAtEndOfInferenceScope (infoReader,denv,nenv,sink,tycon,isImplementation)
//-------------------------------------------------------------------------
// Additional helpers for type checking and constraint solving
......
src/fsharp/fsc.fs
浏览文件 @ 9635bd0d
......@@ -232,8 +232,10 @@ let AdjustForScriptCompile(tcConfigB:TcConfigBuilder,commandLineSourceFiles,lexR
let AppendClosureInformation(filename) =
if IsScript filename then
let closure = LoadClosure.ComputeClosureOfSourceFiles(tcConfig,[filename,rangeStartup],CodeContext.Compilation,lexResourceManager=lexResourceManager,useDefaultScriptingReferences=false)
let references = closure.References |> List.map snd |> List.concat |> List.map (fun r->r.originalReference) |> List.filter (fun r->r.Range<>range0)
references |> List.iter (fun r-> tcConfigB.AddReferencedAssemblyByPath(r.Range,r.Text))
// Record the references from the analysis of the script. The full resolutions are recorded as the corresponding #I paths used to resolve them
// are local to the scripts and not added to the tcConfigB (they are added to localized clones of the tcConfigB).
let references = closure.References |> List.map snd |> List.concat |> List.filter (fun r->r.originalReference.Range<>range0 && r.originalReference.Range<>rangeStartup)
references |> List.iter (fun r-> tcConfigB.AddReferencedAssemblyByPath(r.originalReference.Range,r.resolvedPath))
closure.NoWarns |> List.map(fun (n,ms)->ms|>List.map(fun m->m,n)) |> List.concat |> List.iter tcConfigB.TurnWarningOff
closure.SourceFiles |> List.map fst |> List.iter AddIfNotPresent
closure.RootWarnings |> List.iter warnSink
......@@ -613,7 +615,7 @@ type ILResource with
| ILResourceLocation.Local b -> b()
| _-> error(InternalError("Bytes",rangeStartup))
let EncodeInterfaceData(tcConfig:TcConfig,tcGlobals,exportRemapping,generatedCcu,outfile) =
let EncodeInterfaceData(tcConfig:TcConfig,tcGlobals,exportRemapping,generatedCcu,outfile,isIncrementalBuild) =
if GenerateInterfaceData(tcConfig) then
if verbose then dprintfn "Generating interface data attribute...";
let resource = WriteSignatureData (tcConfig,tcGlobals,exportRemapping,generatedCcu,outfile)
......@@ -621,7 +623,7 @@ let EncodeInterfaceData(tcConfig:TcConfig,tcGlobals,exportRemapping,generatedCcu
// REVIEW: need a better test for this
let outFileNoExtension = Filename.chopExtension outfile
let isCompilerServiceDll = outFileNoExtension.Contains("FSharp.LanguageService.Compiler")
if tcConfig.useOptimizationDataFile || tcGlobals.compilingFslib || isCompilerServiceDll then
if (tcConfig.useOptimizationDataFile || tcGlobals.compilingFslib || isCompilerServiceDll) && not isIncrementalBuild then
let sigDataFileName = (Filename.chopExtension outfile)+".sigdata"
File.WriteAllBytes(sigDataFileName,resource.Bytes);
let sigAttr = mkSignatureDataVersionAttr tcGlobals (IL.parseILVersion Internal.Utilities.FSharpEnvironment.FSharpBinaryMetadataFormatRevision)
......@@ -1402,7 +1404,7 @@ module StaticLinker =
| ResolvedCcu ccu -> Some ccu
| UnresolvedCcu(_ccuName) -> None
let modul = dllInfo.RawMetadata
let modul = dllInfo.RawMetadata.TryGetRawILModule().Value
let refs =
if ilAssemRef.Name = GetFSharpCoreLibraryName() then
......@@ -1471,7 +1473,7 @@ module StaticLinker =
| ResolvedCcu ccu -> Some ccu
| UnresolvedCcu(_ccuName) -> None
let modul = dllInfo.RawMetadata
let modul = dllInfo.RawMetadata.TryGetRawILModule().Value
yield (ccu, dllInfo.ILScopeRef, modul), (ilAssemRef.Name, provAssemStaticLinkInfo)
| None -> () ]
......@@ -1850,7 +1852,7 @@ let main2(Args(tcConfig, tcImports, frameworkTcImports: TcImports, tcGlobals, er
let sigDataAttributes,sigDataResources =
try
EncodeInterfaceData(tcConfig, tcGlobals, exportRemapping, generatedCcu, outfile)
EncodeInterfaceData(tcConfig, tcGlobals, exportRemapping, generatedCcu, outfile, false)
with e ->
errorRecoveryNoRange e
SqmLoggerWithConfig tcConfig errorLogger.ErrorNumbers errorLogger.WarningNumbers
......@@ -1867,7 +1869,7 @@ let main2(Args(tcConfig, tcImports, frameworkTcImports: TcImports, tcGlobals, er
let metadataVersion =
match tcConfig.metadataVersion with
| Some(v) -> v
| _ -> match (frameworkTcImports.DllTable.TryFind tcConfig.primaryAssembly.Name) with | Some(ib) -> ib.RawMetadata.MetadataVersion | _ -> ""
| _ -> match (frameworkTcImports.DllTable.TryFind tcConfig.primaryAssembly.Name) with | Some(ib) -> ib.RawMetadata.TryGetRawILModule().Value.MetadataVersion | _ -> ""
let optimizedImpls,optimizationData,_ = ApplyAllOptimizations (tcConfig, tcGlobals, (LightweightTcValForUsingInBuildMethodCall tcGlobals), outfile, importMap, false, optEnv0, generatedCcu, typedAssembly)
AbortOnError(errorLogger,tcConfig,exiter)
......@@ -1983,9 +1985,6 @@ let typecheckAndCompile(argv,bannerAlreadyPrinted,exiter:Exiter, errorLoggerProv
|> main4
let mainCompile (argv, bannerAlreadyPrinted, exiter:Exiter) =
// Enabling batch latency mode currently overrides app config <gcConcurrent>.
// If batch mode is ever removed or changed, revisit use of <gcConcurrent>.
System.Runtime.GCSettings.LatencyMode <- System.Runtime.GCLatencyMode.Batch
typecheckAndCompile(argv, bannerAlreadyPrinted, exiter, DefaultLoggerProvider())
[<RequireQualifiedAccess>]
......
src/fsharp/fsc.fsi
浏览文件 @ 9635bd0d
......@@ -21,7 +21,7 @@ type ErrorLoggerProvider =
type SigningInfo = SigningInfo of (* delaysign:*) bool * (*signer:*) string option * (*container:*) string option
val EncodeInterfaceData: tcConfig:TcConfig * tcGlobals:TcGlobals * exportRemapping:Tastops.Remap * generatedCcu: Tast.CcuThunk * outfile: string -> ILAttribute list * ILResource list
val EncodeInterfaceData: tcConfig:TcConfig * tcGlobals:TcGlobals * exportRemapping:Tastops.Remap * generatedCcu: Tast.CcuThunk * outfile: string * isIncrementalBuild: bool -> ILAttribute list * ILResource list
val ValidateKeySigningAttributes : tcConfig:TcConfig * tcGlobals:TcGlobals * TypeChecker.TopAttribs -> SigningInfo
val GetSigner : SigningInfo -> ILBinaryWriter.ILStrongNameSigner option
......
src/fsharp/fscmain.fs
浏览文件 @ 9635bd0d
......@@ -278,6 +278,7 @@ do ()
[<EntryPoint>]
let main(argv) =
System.Runtime.GCSettings.LatencyMode <- System.Runtime.GCLatencyMode.Batch
use unwindBuildPhase = PushThreadBuildPhaseUntilUnwind (BuildPhase.Parameter)
if not runningOnMono then Lib.UnmanagedProcessExecutionOptions.EnableHeapTerminationOnCorruption() (* SDL recommendation *)
......
src/fsharp/fsi/fsi.fs
浏览文件 @ 9635bd0d
......@@ -774,7 +774,7 @@ type internal FsiDynamicCompiler
let valuePrinter = FsiValuePrinter(ilGlobals, generateDebugInfo, resolvePath, outWriter)
let assemblyBuilder,moduleBuilder = ILRuntimeWriter.mkDynamicAssemblyAndModule (assemblyName, tcConfigB.optSettings.localOpt(), generateDebugInfo)
let assemblyBuilder,moduleBuilder = ILRuntimeWriter.mkDynamicAssemblyAndModule (assemblyName, tcConfigB.optSettings.localOpt(), generateDebugInfo, false)
let rangeStdin = rangeN Lexhelp.stdinMockFilename 0
......@@ -1009,7 +1009,7 @@ type internal FsiDynamicCompiler
if FileSystem.IsInvalidPathShim(path) then
error(Error(FSIstrings.SR.fsiInvalidAssembly(path),m))
// Check the file can be resolved before calling requireDLLReference
let resolutions = tcImports.ResolveAssemblyReference(AssemblyReference(m,path),ResolveAssemblyReferenceMode.ReportErrors)
let resolutions = tcImports.ResolveAssemblyReference(AssemblyReference(m,path,None),ResolveAssemblyReferenceMode.ReportErrors)
tcConfigB.AddReferencedAssemblyByPath(m,path)
let tcState = istate.tcState
let tcEnv,(_dllinfos,ccuinfos) =
......@@ -1120,7 +1120,7 @@ type internal FsiIntellisenseProvider(tcGlobals, tcImports: TcImports) =
// Note: for the accessor domain we should use (AccessRightsOfEnv tcState.TcEnvFromImpls)
let ad = Infos.AccessibleFromSomeFSharpCode
let nItems = NameResolution.ResolvePartialLongIdent ncenv tcState.TcEnvFromImpls.NameEnv (ConstraintSolver.IsApplicableMethApprox tcGlobals amap rangeStdin) rangeStdin ad lid false
let names = nItems |> List.map (fun d -> d.DisplayName tcGlobals)
let names = nItems |> List.map (fun d -> d.DisplayName)
let names = names |> List.filter (fun (name:string) -> name.StartsWith(stem,StringComparison.Ordinal))
names
......@@ -1383,14 +1383,14 @@ module internal MagicAssemblyResolution =
let assemblyReferenceTextExe = (simpleAssemName + ".exe")
let overallSearchResult =
// OK, try to resolve as a .dll
let searchResult = tcImports.TryResolveAssemblyReference (AssemblyReference(rangeStdin,assemblyReferenceTextDll),ResolveAssemblyReferenceMode.Speculative)
let searchResult = tcImports.TryResolveAssemblyReference (AssemblyReference(rangeStdin,assemblyReferenceTextDll,None),ResolveAssemblyReferenceMode.Speculative)
match searchResult with
| OkResult (warns,[r]) -> OkResult (warns, Choice1Of2 r.resolvedPath)
| _ ->
// OK, try to resolve as a .exe
let searchResult = tcImports.TryResolveAssemblyReference (AssemblyReference(rangeStdin,assemblyReferenceTextExe),ResolveAssemblyReferenceMode.Speculative)
let searchResult = tcImports.TryResolveAssemblyReference (AssemblyReference(rangeStdin,assemblyReferenceTextExe,None),ResolveAssemblyReferenceMode.Speculative)
match searchResult with
| OkResult (warns, [r]) -> OkResult (warns, Choice1Of2 r.resolvedPath)
......
src/fsharp/infos.fs
浏览文件 @ 9635bd0d
......@@ -365,6 +365,21 @@ type ValRef with
let flags = membInfo.MemberFlags
not flags.IsDispatchSlot && (flags.IsOverrideOrExplicitImpl || nonNil membInfo.ImplementedSlotSigs)
/// Check if an F#-declared member value is an explicit interface member implementation
member vref.IsFSharpExplicitInterfaceImplementation g =
match vref.MemberInfo with
| None -> false
| Some membInfo ->
not membInfo.MemberFlags.IsDispatchSlot &&
(match membInfo.ImplementedSlotSigs with
| TSlotSig(_,oty,_,_,_,_) :: _ -> isInterfaceTy g oty
| [] -> false)
member vref.ImplementedSlotSignatures =
match vref.MemberInfo with
| None -> []
| Some membInfo -> membInfo.ImplementedSlotSigs
//-------------------------------------------------------------------------
// Helper methods associated with using TAST metadata (F# members, values etc.)
// as backing data for MethInfo, PropInfo etc.
......@@ -1060,6 +1075,15 @@ type MethInfo =
#endif
| DefaultStructCtor _ -> false))
/// Check if this method is an explicit implementation of an interface member
member x.IsFSharpExplicitInterfaceImplementation =
match x with
| ILMeth _ -> false
| FSMeth(g,_,vref,_) -> vref.IsFSharpExplicitInterfaceImplementation g
| DefaultStructCtor _ -> false
#if EXTENSIONTYPING
| ProvidedMeth _ -> false
#endif
/// Check if this method is marked 'override' and thus definitely overrides another method.
member x.IsDefiniteFSharpOverride =
......@@ -1071,6 +1095,11 @@ type MethInfo =
| ProvidedMeth _ -> false
#endif
member x.ImplementedSlotSignatures =
match x with
| FSMeth(_,_,vref,_) -> vref.ImplementedSlotSignatures
| _ -> failwith "not supported"
/// Indicates if this is an extension member.
member x.IsExtensionMember = x.IsCSharpStyleExtensionMember || x.IsFSharpStyleExtensionMember
......@@ -1502,6 +1531,14 @@ type ILFieldInfo =
| ProvidedField(amap,fi,m) -> Import.ImportProvidedType amap m (fi.PApply((fun fi -> fi.FieldType),m))
#endif
static member ILFieldInfosUseIdenticalDefinitions x1 x2 =
match x1,x2 with
| ILFieldInfo(_, x1), ILFieldInfo(_, x2) -> (x1 === x2)
#if EXTENSIONTYPING
| ProvidedField(_,fi1,_), ProvidedField(_,fi2,_)-> ProvidedFieldInfo.TaintedEquals (fi1, fi2)
| _ -> false
#endif
/// Get an (uninstantiated) reference to the field as an Abstract IL ILFieldRef
member x.ILFieldRef = rescopeILFieldRef x.ScopeRef (mkILFieldRef(x.ILTypeRef,x.FieldName,x.ILFieldType))
override x.ToString() = x.FieldName
......@@ -1769,6 +1806,15 @@ type PropInfo =
| Some vref -> vref.IsDefiniteFSharpOverrideMember
| None -> false
member x.ImplementedSlotSignatures =
x.ArbitraryValRef.Value.ImplementedSlotSignatures
member x.IsFSharpExplicitInterfaceImplementation =
match x.ArbitraryValRef with
| Some vref -> vref.IsFSharpExplicitInterfaceImplementation x.TcGlobals
| None -> false
/// Indicates if this property is an indexer property, i.e. a property with arguments.
member x.IsIndexer =
match x with
......@@ -2418,26 +2464,32 @@ module AccessibilityLogic =
IsProvidedMemberAccessible amap m ad pfi.EnclosingType access
#endif
let IsILEventInfoAccessible g amap m ad (ILEventInfo (tinfo,edef)) =
let access = (resolveILMethodRef tinfo.RawMetadata edef.AddMethod).Access
IsILTypeAndMemberAccessible g amap m ad ad tinfo access
let GetILAccessOfILEventInfo (ILEventInfo (tinfo,edef)) =
(resolveILMethodRef tinfo.RawMetadata edef.AddMethod).Access
let IsILEventInfoAccessible g amap m ad einfo =
let access = GetILAccessOfILEventInfo einfo
IsILTypeAndMemberAccessible g amap m ad ad einfo.ILTypeInfo access
let private IsILMethInfoAccessible g amap m adType ad ilminfo =
match ilminfo with
| ILMethInfo (_,typ,None,mdef,_) -> IsILTypeAndMemberAccessible g amap m adType ad (ILTypeInfo.FromType g typ) mdef.Access
| ILMethInfo (_,_,Some declaringTyconRef,mdef,_) -> IsILMemberAccessible g amap m declaringTyconRef ad mdef.Access
let IsILPropInfoAccessible g amap m ad (ILPropInfo(tinfo,pdef)) =
let GetILAccessOfILPropInfo (ILPropInfo(tinfo,pdef)) =
let tdef = tinfo.RawMetadata
let ilAccess =
let ilAccess =
match pdef.GetMethod with
| Some mref -> (resolveILMethodRef tdef mref).Access
| None ->
match pdef.SetMethod with
| None -> ILMemberAccess.Public
| Some mref -> (resolveILMethodRef tdef mref).Access
ilAccess
IsILTypeAndMemberAccessible g amap m ad ad tinfo ilAccess
let IsILPropInfoAccessible g amap m ad pinfo =
let ilAccess = GetILAccessOfILPropInfo pinfo
IsILTypeAndMemberAccessible g amap m ad ad pinfo.ILTypeInfo ilAccess
let IsValAccessible ad (vref:ValRef) =
vref.Accessibility |> IsAccessible ad
......@@ -2533,10 +2585,180 @@ open AccessibilityLogic
exception ObsoleteWarning of string * range
exception ObsoleteError of string * range
let fail() = failwith "This custom attribute has an argument that can not yet be converted using this API"
let rec evalILAttribElem e =
match e with
| ILAttribElem.String (Some x) -> box x
| ILAttribElem.String None -> null
| ILAttribElem.Bool x -> box x
| ILAttribElem.Char x -> box x
| ILAttribElem.SByte x -> box x
| ILAttribElem.Int16 x -> box x
| ILAttribElem.Int32 x -> box x
| ILAttribElem.Int64 x -> box x
| ILAttribElem.Byte x -> box x
| ILAttribElem.UInt16 x -> box x
| ILAttribElem.UInt32 x -> box x
| ILAttribElem.UInt64 x -> box x
| ILAttribElem.Single x -> box x
| ILAttribElem.Double x -> box x
| ILAttribElem.Null -> null
| ILAttribElem.Array (_, a) -> box [| for i in a -> evalILAttribElem i |]
// TODO: typeof<..> in attribute values
| ILAttribElem.Type (Some _t) -> fail()
| ILAttribElem.Type None -> null
| ILAttribElem.TypeRef (Some _t) -> fail()
| ILAttribElem.TypeRef None -> null
let rec evalFSharpAttribArg g e =
match e with
| Expr.Const(c,_,_) ->
match c with
| Const.Bool b -> box b
| Const.SByte i -> box i
| Const.Int16 i -> box i
| Const.Int32 i -> box i
| Const.Int64 i -> box i
| Const.Byte i -> box i
| Const.UInt16 i -> box i
| Const.UInt32 i -> box i
| Const.UInt64 i -> box i
| Const.Single i -> box i
| Const.Double i -> box i
| Const.Char i -> box i
| Const.Zero -> null
| Const.String s -> box s
| _ -> fail()
| Expr.Op (TOp.Array,_,a,_) -> box [| for i in a -> evalFSharpAttribArg g i |]
| TypeOfExpr g ty -> box ty
// TODO: | TypeDefOfExpr g ty
| _ -> fail()
type AttribInfo =
| FSAttribInfo of TcGlobals * Attrib
| ILAttribInfo of TcGlobals * Import.ImportMap * ILScopeRef * ILAttribute * range
member x.TyconRef =
match x with
| FSAttribInfo(_g,Attrib(tcref,_,_,_,_,_,_)) -> tcref
| ILAttribInfo (g, amap, scoref, a, m) ->
let ty = ImportType scoref amap m [] a.Method.EnclosingType
tcrefOfAppTy g ty
member x.ConstructorArguments =
match x with
| FSAttribInfo(g,Attrib(_,_,unnamedArgs,_,_,_,_)) ->
unnamedArgs
|> List.map (fun (AttribExpr(origExpr,evaluatedExpr)) ->
let ty = tyOfExpr g origExpr
let obj = evalFSharpAttribArg g evaluatedExpr
ty,obj)
| ILAttribInfo (g, amap, scoref, cattr, m) ->
let parms, _args = decodeILAttribData g.ilg cattr
[ for (argty,argval) in Seq.zip cattr.Method.FormalArgTypes parms ->
let ty = ImportType scoref amap m [] argty
let obj = evalILAttribElem argval
ty,obj ]
member x.NamedArguments =
match x with
| FSAttribInfo(g,Attrib(_,_,_,namedArgs,_,_,_)) ->
namedArgs
|> List.map (fun (AttribNamedArg(nm,_,isField,AttribExpr(origExpr,evaluatedExpr))) ->
let ty = tyOfExpr g origExpr
let obj = evalFSharpAttribArg g evaluatedExpr
ty, nm, isField, obj)
| ILAttribInfo (g, amap, scoref, cattr, m) ->
let _parms, namedArgs = decodeILAttribData g.ilg cattr
[ for (nm, argty, isProp, argval) in namedArgs ->
let ty = ImportType scoref amap m [] argty
let obj = evalILAttribElem argval
let isField = not isProp
ty, nm, isField, obj ]
/// Check custom attributes. This is particularly messy because custom attributes come in in three different
/// formats.
module AttributeChecking =
let AttribInfosOfIL g amap scoref m (attribs: ILAttributes) =
attribs.AsList |> List.map (fun a -> ILAttribInfo (g, amap, scoref, a, m))
let AttribInfosOfFS g attribs =
attribs |> List.map (fun a -> FSAttribInfo (g, a))
let GetAttribInfosOfEntity g amap m (tcref:TyconRef) =
match metadataOfTycon tcref.Deref with
#if EXTENSIONTYPING
// TODO: provided attributes
| ProvidedTypeMetadata _info -> []
//let provAttribs = info.ProvidedType.PApply((fun a -> (a :> IProvidedCustomAttributeProvider)),m)
//match provAttribs.PUntaint((fun a -> a. .GetAttributeConstructorArgs(provAttribs.TypeProvider.PUntaintNoFailure(id), atref.FullName)),m) with
//| Some args -> f3 args
//| None -> None
#endif
| ILTypeMetadata (scoref,tdef) ->
tdef.CustomAttrs |> AttribInfosOfIL g amap scoref m
| FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata ->
tcref.Attribs |> List.map (fun a -> FSAttribInfo (g, a))
let GetAttribInfosOfMethod amap m minfo =
match minfo with
| ILMeth (g,ilminfo,_) -> ilminfo.RawMetadata.CustomAttrs |> AttribInfosOfIL g amap ilminfo.MetadataScope m
| FSMeth (g,_,vref,_) -> vref.Attribs |> AttribInfosOfFS g
| DefaultStructCtor _ -> []
#if EXTENSIONTYPING
// TODO: provided attributes
| ProvidedMeth (_,_mi,_,_m) ->
[]
#endif
let GetAttribInfosOfProp amap m pinfo =
match pinfo with
| ILProp(g,ilpinfo) -> ilpinfo.RawMetadata.CustomAttrs |> AttribInfosOfIL g amap ilpinfo.ILTypeInfo.ILScopeRef m
| FSProp(g,_,Some vref,_)
| FSProp(g,_,_,Some vref) -> vref.Attribs |> AttribInfosOfFS g
| FSProp _ -> failwith "GetAttribInfosOfProp: unreachable"
#if EXTENSIONTYPING
// TODO: provided attributes
| ProvidedProp _ -> []
#endif
let GetAttribInfosOfEvent amap m einfo =
match einfo with
| ILEvent(g, x) -> x.RawMetadata.CustomAttrs |> AttribInfosOfIL g amap x.ILTypeInfo.ILScopeRef m
| FSEvent(_, pi, _vref1, _vref2) -> GetAttribInfosOfProp amap m pi
#if EXTENSIONTYPING
// TODO: provided attributes
| ProvidedEvent _ -> []
#endif
/// Analyze three cases for attributes declared on type definitions: IL-declared attributes, F#-declared attributes and
/// provided attributes.
//
// This is used for AttributeUsageAttribute, DefaultMemberAttribute and ConditionalAttribute (on attribute types)
let TryBindTyconRefAttribute g m (AttribInfo (atref,_) as args) (tcref:TyconRef) f1 f2 f3 =
ignore m; ignore f3
match metadataOfTycon tcref.Deref with
#if EXTENSIONTYPING
| ProvidedTypeMetadata info ->
let provAttribs = info.ProvidedType.PApply((fun a -> (a :> IProvidedCustomAttributeProvider)),m)
match provAttribs.PUntaint((fun a -> a.GetAttributeConstructorArgs(provAttribs.TypeProvider.PUntaintNoFailure(id), atref.FullName)),m) with
| Some args -> f3 args
| None -> None
#endif
| ILTypeMetadata (_,tdef) ->
match TryDecodeILAttribute g atref tdef.CustomAttrs with
| Some attr -> f1 attr
| _ -> None
| FSharpOrArrayOrByrefOrTupleOrExnTypeMetadata ->
match TryFindFSharpAttribute g args tcref.Attribs with
| Some attr -> f2 attr
| _ -> None
/// Analyze three cases for attributes declared on methods: IL-declared attributes, F#-declared attributes and
/// provided attributes.
let BindMethInfoAttributes m minfo f1 f2 f3 =
......@@ -3118,7 +3340,7 @@ type InfoReader(g:TcGlobals, amap:Import.ImportMap) =
infos
/// Get the declared events of a type, not including inherited events
let GetImmediateIntrinsicEventsOfType (optFilter,ad) m typ =
let ComputeImmediateIntrinsicEventsOfType (optFilter,ad) m typ =
let infos =
match metadataOfTy g typ with
#if EXTENSIONTYPING
......@@ -3178,7 +3400,7 @@ type InfoReader(g:TcGlobals, amap:Import.ImportMap) =
FoldPrimaryHierarchyOfType (fun typ acc -> GetImmediateIntrinsicILFieldsOfType (optFilter,ad) m typ @ acc) g amap m AllowMultiIntfInstantiations.Yes typ []
let GetIntrinsicEventInfosUncached ((optFilter,ad),m,typ) =
FoldPrimaryHierarchyOfType (fun typ acc -> GetImmediateIntrinsicEventsOfType (optFilter,ad) m typ @ acc) g amap m AllowMultiIntfInstantiations.Yes typ []
FoldPrimaryHierarchyOfType (fun typ acc -> ComputeImmediateIntrinsicEventsOfType (optFilter,ad) m typ @ acc) g amap m AllowMultiIntfInstantiations.Yes typ []
let GetIntrinsicRecdOrClassFieldInfosUncached ((optFilter,ad),m,typ) =
FoldPrimaryHierarchyOfType (fun typ acc -> GetImmediateIntrinsicRecdOrClassFieldsOfType (optFilter,ad) m typ @ acc) g amap m AllowMultiIntfInstantiations.Yes typ []
......@@ -3197,7 +3419,7 @@ type InfoReader(g:TcGlobals, amap:Import.ImportMap) =
let minfos = GetImmediateIntrinsicMethInfosOfType (optFilter,ad) g amap m typ
let pinfos = GetImmediateIntrinsicPropInfosOfType (optFilter,ad) g amap m typ
let finfos = GetImmediateIntrinsicILFieldsOfType (optFilter,ad) m typ
let einfos = GetImmediateIntrinsicEventsOfType (optFilter,ad) m typ
let einfos = ComputeImmediateIntrinsicEventsOfType (optFilter,ad) m typ
let rfinfos = GetImmediateIntrinsicRecdOrClassFieldsOfType (optFilter,ad) m typ
match acc with
| Some(MethodItem(inheritedMethSets)) when nonNil minfos -> Some(MethodItem (minfos::inheritedMethSets))
......@@ -3291,6 +3513,8 @@ type InfoReader(g:TcGlobals, amap:Import.ImportMap) =
member x.GetILFieldInfosOfType (optFilter,ad,m,typ) =
ilFieldInfoCache.Apply(((optFilter,ad),m,typ))
member x.GetImmediateIntrinsicEventsOfType (optFilter,ad,m,typ) = ComputeImmediateIntrinsicEventsOfType (optFilter,ad) m typ
/// Read the events of a type, including inherited ones. Cache the result for monomorphic types.
member x.GetEventInfosOfType (optFilter,ad,m,typ) =
eventInfoCache.Apply(((optFilter,ad),m,typ))
......
src/fsharp/lib.fs
浏览文件 @ 9635bd0d
......@@ -19,6 +19,8 @@ let tracking = ref false // intended to be a general hook to control diagnostic
let condition _s =
try (System.Environment.GetEnvironmentVariable(_s) <> null) with _ -> false
let GetEnvInteger e dflt = match System.Environment.GetEnvironmentVariable(e) with null -> dflt | t -> try int t with _ -> dflt
let dispose (x:System.IDisposable) = match x with null -> () | x -> x.Dispose()
//-------------------------------------------------------------------------
......
src/fsharp/pars.fsy
浏览文件 @ 9635bd0d
......@@ -30,7 +30,8 @@ let debugPrint(s) = ignore s
let exprFromParseError (e:SynExpr) = SynExpr.FromParseError(e,e.Range)
let patFromParseError (e:SynPat) = SynPat.FromParseError(e, e.Range)
let mkSynOptionalExpr m xopt =
let mkSynOptionalExpr (m: range) xopt =
let m = m.MakeSynthetic()
match xopt with
| None -> mkSynLidGet m Ast.FSharpLib.CorePath "None"
| Some x -> SynExpr.App(ExprAtomicFlag.NonAtomic, false, mkSynLidGet m Ast.FSharpLib.CorePath "Some",x,m)
......@@ -258,12 +259,13 @@ let rangeOfLongIdent(lid:LongIdent) =
%token <Ast.LexerWhitespaceContinuation> COMMENT WHITESPACE HASH_LINE HASH_LIGHT INACTIVECODE LINE_COMMENT STRING_TEXT EOF
%token <range * string * Ast.LexerWhitespaceContinuation> HASH_IF HASH_ELSE HASH_ENDIF
%start signatureFile implementationFile interaction
%start signatureFile implementationFile interaction typedSeqExprEOF typEOF
%type <Ast.SynExpr> typedSeqExprEOF
%type <Ast.ParsedImplFile> implementationFile
%type <Ast.ParsedSigFile> signatureFile
%type <Ast.ParsedFsiInteraction> interaction
%type <Ast.Ident> ident
%type <Ast.SynType> typ
%type <Ast.SynType> typ typEOF
%type <Ast.SynTypeDefnSig list> tyconSpfns
%type <Ast.SynExpr> patternResult
%type <Ast.SynExpr> declExpr
......@@ -495,10 +497,9 @@ interaction:
{ IDefns ([],lhs parseState) }
/* The terminator of an interaction in F# Interactive */
interactiveTerminator:
| SEMICOLON_SEMICOLON {}
| EOF {}
| EOF { checkEndOfFileError $1 }
/* An group of items considered to be one interaction, plus a terminator */
......@@ -2939,6 +2940,9 @@ typedSeqExpr:
| seqExpr COLON typeWithTypeConstraints { SynExpr.Typed ($1,$3, unionRanges $1.Range $3.Range) }
| seqExpr { $1 }
typedSeqExprEOF:
| typedSeqExpr EOF { checkEndOfFileError $2; $1 }
seqExpr:
| declExpr seps seqExpr
{ SynExpr.Sequential(SequencePointsAtSeq,true,$1,$3,unionRanges $1.Range $3.Range) }
......@@ -4219,6 +4223,9 @@ typ:
| tupleType %prec prec_typ_prefix
{ $1 }
typEOF:
| typ EOF { checkEndOfFileError $2; $1 }
tupleType:
| appType STAR tupleOrQuotTypeElements
......@@ -4581,7 +4588,8 @@ typar:
staticallyKnownHeadTypar:
| INFIX_AT_HAT_OP ident
{ if $1 <> "^" then reportParseErrorAt (rhs parseState 1) (FSComp.SR.parsUnexpectedTypeParameter());
Typar($2,HeadTypeStaticReq,false) }
let id = mkSynId (lhs parseState) ($2).idText
Typar(id,HeadTypeStaticReq,false) }
......
src/fsharp/range.fs
浏览文件 @ 9635bd0d
......@@ -231,14 +231,29 @@ let trimRangeToLine (r:range) =
let stringOfPos (pos:pos) = sprintf "(%d,%d)" pos.Line pos.Column
let stringOfRange (r:range) = sprintf "%s%s-%s" r.FileName (stringOfPos r.Start) (stringOfPos r.End)
#if CHECK_LINE0_TYPES // turn on to check that we correctly transform zero-based line counts to one-based line counts
// Visual Studio uses line counts starting at 0, F# uses them starting at 1
[<Measure>] type ZeroBasedLineAnnotation
module Pos =
type Line0 = int<ZeroBasedLineAnnotation>
#else
type Line0 = int
#endif
type Pos01 = Line0 * int
type Range01 = Pos01 * Pos01
module Line =
// Visual Studio uses line counts starting at 0, F# uses them starting at 1
let fromVS line idx = mkPos (line+1) idx
let toVS (p:pos) = (p.Line - 1, p.Column)
let fromZ (line:Line0) = int line+1
let toZ (line:int) : Line0 = LanguagePrimitives.Int32WithMeasure(line - 1)
module Pos =
let fromZ (line:Line0) idx = mkPos (Line.fromZ line) idx
let toZ (p:pos) = (Line.toZ p.Line, p.Column)
module Range =
let toVS (m:range) = Pos.toVS m.Start, Pos.toVS m.End
let toZ (m:range) = Pos.toZ m.Start, Pos.toZ m.End
let toFileZ (m:range) = m.FileName, toZ m
src/fsharp/range.fsi
浏览文件 @ 9635bd0d
......@@ -86,11 +86,34 @@ val rangeCmdArgs : range
val stringOfPos : pos -> string
val stringOfRange : range -> string
module Pos =
// Visual Studio uses line counts starting at 0, F# uses them starting at 1
val fromVS : line:int -> column:int -> pos
val toVS : pos -> (int * int)
/// Represents a line number when using zero-based line counting (used by Visual Studio)
#if CHECK_LINE0_TYPES
// Visual Studio uses line counts starting at 0, F# uses them starting at 1
[<Measure>] type ZeroBasedLineAnnotation
type Line0 = int<ZeroBasedLineAnnotation>
#else
type Line0 = int
#endif
/// Represents a position using zero-based line counting (used by Visual Studio)
type Pos01 = Line0 * int
/// Represents a range using zero-based line counting (used by Visual Studio)
type Range01 = Pos01 * Pos01
module Line =
/// Convert a line number from zero-based line counting (used by Visual Studio) to one-based line counting (used internally in the F# compiler and in F# error messages)
val fromZ : Line0 -> int
/// Convert a line number from one-based line counting (used internally in the F# compiler and in F# error messages) to zero-based line counting (used by Visual Studio)
val toZ : int -> Line0
module Pos =
/// Convert a position from zero-based line counting (used by Visual Studio) to one-based line counting (used internally in the F# compiler and in F# error messages)
val fromZ : line:Line0 -> column:int -> pos
/// Convert a position from one-based line counting (used internally in the F# compiler and in F# error messages) to zero-based line counting (used by Visual Studio)
val toZ : pos -> Pos01
module Range =
val toVS : range -> (int * int) * (int * int)
/// Convert a range from one-based line counting (used internally in the F# compiler and in F# error messages) to zero-based line counting (used by Visual Studio)
val toZ : range -> Range01
val toFileZ : range -> string * Range01
src/fsharp/tast.fs
浏览文件 @ 9635bd0d
......@@ -471,6 +471,13 @@ type Entity =
/// The display name of the namespace, module or type, e.g. List instead of List`1, including static parameters if any
member x.DisplayNameWithStaticParameters = x.GetDisplayName(true, false)
#if EXTENSIONTYPING
member x.IsStaticInstantiationTycon =
x.IsProvidedErasedTycon &&
let _nm,args = PrettyNaming.demangleProvidedTypeName x.LogicalName
args.Length > 0
#endif
member x.GetDisplayName(withStaticParameters, withUnderscoreTypars) =
let nm = x.LogicalName
let getName () =
......@@ -510,6 +517,19 @@ type Entity =
#endif
x.Data.entity_range
/// The range in the implementation, adjusted for an item in a signature
member x.DefinitionRange =
match x.Data.entity_other_range with
| Some (r, true) -> r
| _ -> x.Range
member x.SigRange =
match x.Data.entity_other_range with
| Some (r, false) -> r
| _ -> x.Range
member x.SetOtherRange m = x.Data.entity_other_range <- Some m
/// A unique stamp for this module, namespace or type definition within the context of this compilation.
/// Note that because of signatures, there are situations where in a single compilation the "same"
/// module, namespace or type may have two distinct Entity objects that have distinct stamps.
......@@ -956,6 +976,11 @@ and
/// The declaration location for the type constructor
entity_range: range
// MUTABILITY: the signature is adjusted when it is checked
/// If this field is populated, this is the implementation range for an item in a signature, otherwise it is
/// the signature range for an item in an implementation
mutable entity_other_range: (range * bool) option
/// The declared accessibility of the representation, not taking signatures into account
entity_tycon_repr_accessibility: Accessibility
......@@ -1278,6 +1303,11 @@ and
/// Name/range of the case
Id: Ident
/// If this field is populated, this is the implementation range for an item in a signature, otherwise it is
/// the signature range for an item in an implementation
// MUTABILITY: used when propagating signature attributes into the implementation.
mutable OtherRangeOpt : (range * bool) option
/// Indicates the declared visibility of the union constructor, not taking signatures into account
Accessibility: Accessibility
......@@ -1286,6 +1316,17 @@ and
mutable Attribs: Attribs }
member uc.Range = uc.Id.idRange
member uc.DefinitionRange =
match uc.OtherRangeOpt with
| Some (m,true) -> m
| _ -> uc.Range
member uc.SigRange =
match uc.OtherRangeOpt with
| Some (m,false) -> m
| _ -> uc.Range
member uc.DisplayName = uc.Id.idText
member uc.RecdFieldsArray = uc.FieldTable.FieldsByIndex
member uc.RecdFields = uc.FieldTable.FieldsByIndex |> Array.toList
......@@ -1333,7 +1374,12 @@ and
mutable rfield_fattribs: Attribs
/// Name/declaration-location of the field
rfield_id: Ident }
rfield_id: Ident
/// If this field is populated, this is the implementation range for an item in a signature, otherwise it is
/// the signature range for an item in an implementation
// MUTABILITY: used when propagating signature attributes into the implementation.
mutable rfield_other_range: (range * bool) option }
/// Indicates the declared visibility of the field, not taking signatures into account
member v.Accessibility = v.rfield_access
......@@ -1347,6 +1393,16 @@ and
/// Declaration-location of the field
member v.Range = v.rfield_id.idRange
member v.DefinitionRange =
match v.rfield_other_range with
| Some (m, true) -> m
| _ -> v.Range
member v.SigRange =
match v.rfield_other_range with
| Some (m, false) -> m
| _ -> v.Range
/// Name/declaration-location of the field
member v.Id = v.rfield_id
......@@ -1656,6 +1712,7 @@ and Construct =
entity_compiled_name=None
entity_kind=kind
entity_range=m
entity_other_range=None
entity_flags=EntityFlags(usesPrefixDisplay=false, isModuleOrNamespace=false,preEstablishedHasDefaultCtor=false, hasSelfReferentialCtor=false)
entity_attribs=[] // fetched on demand via est.fs API
entity_typars= LazyWithContext.NotLazy []
......@@ -1681,6 +1738,7 @@ and Construct =
{ entity_logical_name=id.idText
entity_compiled_name=None
entity_range = id.idRange
entity_other_range = None
entity_stamp=stamp
entity_kind=TyparKind.Type
entity_modul_contents = mtype
......@@ -1997,8 +2055,10 @@ and
member x.Accessibility = x.Data.val_access
/// Range of the definition (implementation) of the value, used by Visual Studio
/// Updated by mutation when the implementation is matched against the signature.
member x.DefinitionRange = x.Data.val_defn_range
member x.DefinitionRange = x.Data.DefinitionRange
/// Range of the definition (signature) of the value, used by Visual Studio
member x.SigRange = x.Data.SigRange
/// The value of a value or member marked with [<LiteralAttribute>]
member x.LiteralValue = x.Data.val_const
......@@ -2304,7 +2364,7 @@ and
member x.SetIsCompiledAsStaticPropertyWithoutField() = x.Data.val_flags <- x.Data.val_flags.SetIsCompiledAsStaticPropertyWithoutField
member x.SetValReprInfo info = x.Data.val_repr_info <- info
member x.SetType ty = x.Data.val_type <- ty
member x.SetDefnRange m = x.Data.val_defn_range <- m
member x.SetOtherRange m = x.Data.val_other_range <- Some m
/// Create a new value with empty, unlinked data. Only used during unpickling of F# metadata.
static member NewUnlinked() : Val = { Data = nullableSlotEmpty() }
......@@ -2335,7 +2395,9 @@ and
{ val_logical_name: string
val_compiled_name: string option
val_range: range
mutable val_defn_range: range
/// If this field is populated, this is the implementation range for an item in a signature, otherwise it is
/// the signature range for an item in an implementation
mutable val_other_range: (range * bool) option
mutable val_type: TType
val_stamp: Stamp
/// See vflags section further below for encoding/decodings here
......@@ -2379,6 +2441,15 @@ and
/// XML documentation signature for the value
mutable val_xmldocsig : string }
member x.DefinitionRange =
match x.val_other_range with
| Some (m,true) -> m
| _ -> x.val_range
member x.SigRange =
match x.val_other_range with
| Some (m,false) -> m
| _ -> x.val_range
and
[<NoEquality; NoComparison; RequireQualifiedAccess>]
ValMemberInfo =
......@@ -2520,9 +2591,12 @@ and NonLocalEntityRef =
#endif
/// Try to link a non-local entity reference to an actual entity
member nleref.TryDeref =
member nleref.TryDeref(canError) =
let (NonLocalEntityRef(ccu,path)) = nleref
ccu.EnsureDerefable(path)
if canError then
ccu.EnsureDerefable(path)
if ccu.IsUnresolvedReference then None else
match NonLocalEntityRef.TryDerefEntityPath(ccu, path, 0, ccu.Contents) with
| Some _ as r -> r
......@@ -2567,16 +2641,12 @@ and NonLocalEntityRef =
/// Dereference the nonlocal reference, and raise an error if this fails.
member nleref.Deref =
match nleref.TryDeref with
match nleref.TryDeref(canError=true) with
| Some res -> res
| None ->
errorR (InternalUndefinedItemRef (FSComp.SR.tastUndefinedItemRefModuleNamespace, nleref.DisplayName, nleref.AssemblyName, "<some module on this path>"))
raise (KeyNotFoundException())
/// Try to get the details of the module or namespace fragment referred to by this non-local reference.
member nleref.TryModuleOrNamespaceType =
nleref.TryDeref |> Option.map (fun v -> v.ModuleOrNamespaceType)
/// Get the details of the module or namespace fragment for the entity referred to by this non-local reference.
member nleref.ModuleOrNamespaceType =
nleref.Deref.ModuleOrNamespaceType
......@@ -2596,8 +2666,8 @@ and
member x.PrivateTarget = x.binding
member x.ResolvedTarget = x.binding
member private tcr.Resolve() =
let res = tcr.nlr.TryDeref
member private tcr.Resolve(canError) =
let res = tcr.nlr.TryDeref(canError)
match res with
| Some r ->
tcr.binding <- nullableSlotFull r
......@@ -2609,7 +2679,7 @@ and
member tcr.Deref =
match box tcr.binding with
| null ->
tcr.Resolve()
tcr.Resolve(canError=true)
match box tcr.binding with
| null -> error (InternalUndefinedItemRef (FSComp.SR.tastUndefinedItemRefModuleNamespaceType, String.concat "." tcr.nlr.EnclosingMangledPath, tcr.nlr.AssemblyName, tcr.nlr.LastItemMangledName))
| _ -> tcr.binding
......@@ -2620,7 +2690,7 @@ and
member tcr.TryDeref =
match box tcr.binding with
| null ->
tcr.Resolve()
tcr.Resolve(canError=false)
match box tcr.binding with
| null -> None
| _ -> Some tcr.binding
......@@ -2643,6 +2713,12 @@ and
/// Gets the data indicating the compiled representation of a named type or module in terms of Abstract IL data structures.
member x.CompiledRepresentationForNamedType = x.Deref.CompiledRepresentationForNamedType
/// The implementation definition location of the namespace, module or type
member x.DefinitionRange = x.Deref.DefinitionRange
/// The signature definition location of the namespace, module or type
member x.SigRange = x.Deref.SigRange
/// The name of the namespace, module or type, possibly with mangling, e.g. List`1, List or FailureException
member x.LogicalName = x.Deref.LogicalName
......@@ -2755,6 +2831,9 @@ and
/// Indicates if the entity is an erased provided type definition
member x.IsProvidedErasedTycon = x.Deref.IsProvidedErasedTycon
/// Indicates if the entity is an erased provided type definition that incorporates a static instantiation (and therefore in some sense compiler generated)
member x.IsStaticInstantiationTycon = x.Deref.IsStaticInstantiationTycon
/// Indicates if the entity is a generated provided type definition, i.e. not erased.
member x.IsProvidedGeneratedTycon = x.Deref.IsProvidedGeneratedTycon
#endif
......@@ -2975,10 +3054,10 @@ and
/// For other values it is just the actual parent.
member x.ApparentParent = x.Deref.ApparentParent
/// Range of the definition (implementation) of the value, used by Visual Studio
/// Updated by mutation when the implementation is matched against the signature.
member x.DefinitionRange = x.Deref.DefinitionRange
member x.SigRange = x.Deref.SigRange
/// The value of a value or member marked with [<LiteralAttribute>]
member x.LiteralValue = x.Deref.LiteralValue
......@@ -3110,8 +3189,16 @@ and UnionCaseRef =
match x.TyconRef.GetUnionCaseByName x.CaseName with
| Some res -> res
| None -> error(InternalError(sprintf "union case %s not found in type %s" x.CaseName x.TyconRef.LogicalName, x.TyconRef.Range))
member x.TryUnionCase = x.TyconRef.TryDeref |> Option.bind (fun tcref -> tcref.GetUnionCaseByName x.CaseName)
member x.Attribs = x.UnionCase.Attribs
member x.Range = x.UnionCase.Range
member x.DefinitionRange = x.UnionCase.DefinitionRange
member x.SigRange = x.UnionCase.DefinitionRange
member x.Index =
try
// REVIEW: this could be faster, e.g. by storing the index in the NameMap
......@@ -3132,9 +3219,16 @@ and RecdFieldRef =
match tcref.GetFieldByName id with
| Some res -> res
| None -> error(InternalError(sprintf "field %s not found in type %s" id tcref.LogicalName, tcref.Range))
member x.TryRecdField = x.TyconRef.TryDeref |> Option.bind (fun tcref -> tcref.GetFieldByName x.FieldName)
member x.PropertyAttribs = x.RecdField.PropertyAttribs
member x.Range = x.RecdField.Range
member x.DefinitionRange = x.RecdField.DefinitionRange
member x.SigRange = x.RecdField.DefinitionRange
member x.Index =
let (RFRef(tcref,id)) = x
try
......@@ -4431,7 +4525,8 @@ let NewUnionCase id nm tys rty attribs docOption access : UnionCase =
Accessibility=access
FieldTable = MakeRecdFieldsTable tys
ReturnType = rty
Attribs=attribs }
Attribs=attribs
OtherRangeOpt = None }
let NewModuleOrNamespaceType mkind tycons vals =
ModuleOrNamespaceType(mkind, QueueList.ofList vals, QueueList.ofList tycons)
......@@ -4446,6 +4541,7 @@ let NewExn cpath (id:Ident) access repr attribs doc =
entity_logical_name=id.idText
entity_compiled_name=None
entity_range=id.idRange
entity_other_range=None
entity_exn_info= repr
entity_tycon_tcaug=TyconAugmentation.Create()
entity_xmldoc=doc
......@@ -4473,7 +4569,8 @@ let NewRecdField stat konst id ty isMutable isVolatile pattribs fattribs docOpt
rfield_secret = secret
rfield_xmldoc = docOption
rfield_xmldocsig = ""
rfield_id=id }
rfield_id=id
rfield_other_range = None }
let NewTycon (cpath, nm, m, access, reprAccess, kind, typars, docOption, usesPrefixDisplay, preEstablishedHasDefaultCtor, hasSelfReferentialCtor, mtyp) =
......@@ -4484,6 +4581,7 @@ let NewTycon (cpath, nm, m, access, reprAccess, kind, typars, docOption, usesPre
entity_compiled_name=None
entity_kind=kind
entity_range=m
entity_other_range=None
entity_flags=EntityFlags(usesPrefixDisplay=usesPrefixDisplay, isModuleOrNamespace=false,preEstablishedHasDefaultCtor=preEstablishedHasDefaultCtor, hasSelfReferentialCtor=hasSelfReferentialCtor)
entity_attribs=[] // fixed up after
entity_typars=typars
......@@ -4524,7 +4622,7 @@ let NewVal (logicalName:string,m:range,compiledName,ty,isMutable,isCompGen,arity
val_logical_name=logicalName
val_compiled_name= (match compiledName with Some v when v <> logicalName -> compiledName | _ -> None)
val_range=m
val_defn_range=m
val_other_range=None
val_defn=None
val_repr_info= arity
val_actual_parent= actualParent
......
Markdown is supported
0% 或 .
You are about to add 0 people to the discussion. Proceed with caution.
先完成此消息的编辑！
想要评论请 注册 或