diff --git a/PublishToBlob.proj b/PublishToBlob.proj index 6d71be84df..ba08968773 100644 --- a/PublishToBlob.proj +++ b/PublishToBlob.proj @@ -16,6 +16,7 @@ + diff --git a/fcs/README.md b/fcs/README.md index 5110d7cbcc..8f86342739 100644 --- a/fcs/README.md +++ b/fcs/README.md @@ -1,11 +1,11 @@ -# The FSharp.Compiler.Service components and nuget package +# The FSharp.Compiler.Service components and NuGet package -This directory contains the build, packaging, test and documentation-generation logic for the nuget package ``FSharp.Compiler.Service``. The source for this nuget +This directory contains the build, packaging, test and documentation-generation logic for the NuGet package ``FSharp.Compiler.Service``. The source for this NuGet package is in ``..\src``. -Basically we are packaging up the compiler as a DLL and publishing it as a nuget package. +Basically we are packaging up the compiler as a DLL and publishing it as a NuGet package. ## FSharp.Compiler.Service v. FSharp.Compiler.Private @@ -13,7 +13,7 @@ There are subtle differences between FSharp.Compiler.Service and FSharp.Compiler - FCS has a public API - FCS is built against **.NET 4.5** and **FSharp.Core 4.0.0.0** to give broader reach -- FCS has a Nuget package +- FCS has a NuGet package - FCS has a .NET Standard 1.6 version in the nuget package - FCS testing also tests the "Project Cracker" (see below) - FCS doesn't add the System.ValueTuple.dll reference by default, see ``#if COMPILER_SERVICE_AS_DLL`` in compiler codebase @@ -57,17 +57,17 @@ which does things like: ### Manual push of packages -Yu can push the packages if you have permissions, either automatically using ``build Release`` or manually +You can push the packages if you have permissions, either automatically using ``build Release`` or manually set APIKEY=... - ..\fsharp\.nuget\nuget.exe push %HOMEDRIVE%%HOMEPATH%\Downloads\FSharp.Compiler.Service.22.0.2.nupkg %APIKEY% -Source https://nuget.org - ..\fsharp\.nuget\nuget.exe push %HOMEDRIVE%%HOMEPATH%\Downloads\FSharp.Compiler.Service.MSBuild.v12.22.0.2.nupkg %APIKEY% -Source https://nuget.org - ..\fsharp\.nuget\nuget.exe push %HOMEDRIVE%%HOMEPATH%\Downloads\FSharp.Compiler.Service.ProjectCracker.22.0.2.nupkg %APIKEY% -Source https://nuget.org + ..\fsharp\.nuget\nuget.exe push %HOMEDRIVE%%HOMEPATH%\Downloads\FSharp.Compiler.Service.22.0.3.nupkg %APIKEY% -Source https://nuget.org + ..\fsharp\.nuget\nuget.exe push %HOMEDRIVE%%HOMEPATH%\Downloads\FSharp.Compiler.Service.MSBuild.v12.22.0.3.nupkg %APIKEY% -Source https://nuget.org + ..\fsharp\.nuget\nuget.exe push %HOMEDRIVE%%HOMEPATH%\Downloads\FSharp.Compiler.Service.ProjectCracker.22.0.3.nupkg %APIKEY% -Source https://nuget.org ### Use of Paket and FAKE -Paket is only used to get fake and formating tools. Eventually we will likely remove this once we update the project files to .NET SDK 2.0. +Paket is only used to get FAKE and FSharp.Formatting tools. Eventually we will likely remove this once we update the project files to .NET SDK 2.0. FAKE is only used to run build.fsx. Eventually we will likely remove this once we update the project files to .NET SDK 2.0. @@ -83,7 +83,7 @@ Testing reuses the test files from ..\tests\service which were are also FCS test Output is in ``docs``. In the ``FSharp.Compiler.Service`` repo this is checked in and hosted as http://fsharp.github.io/FSharp.Compiler.Service. -## The two other nuget packages +## The two other NuGet packages It also contains both the source, build, packaging and test logic for diff --git a/fcs/RELEASE_NOTES.md b/fcs/RELEASE_NOTES.md index 530f8143bd..1dfdd95dd0 100644 --- a/fcs/RELEASE_NOTES.md +++ b/fcs/RELEASE_NOTES.md @@ -1,3 +1,6 @@ +#### 22.0.3 + * [Add entity.DeclaringEntity](https://github.com/Microsoft/visualfsharp/pull/4633), [FCS feature request](https://github.com/fsharp/FSharp.Compiler.Service/issues/830) + #### 22.0.2 * Use correct version number in DLLs (needed until https://github.com/Microsoft/visualfsharp/issues/3113 is fixed) diff --git a/fcs/fcs.props b/fcs/fcs.props index 4a4dfbc007..8c9869c4fc 100644 --- a/fcs/fcs.props +++ b/fcs/fcs.props @@ -3,7 +3,7 @@ - 22.0.2 + 22.0.3 --version:$(VersionPrefix) diff --git a/src/absil/il.fs b/src/absil/il.fs index ce8ee4065e..32e1812c52 100644 --- a/src/absil/il.fs +++ b/src/absil/il.fs @@ -408,8 +408,6 @@ type ILAssemblyRef(data) = ILAssemblyRef.Create(aname.Name,None,publicKey,retargetable,version,locale) - - member aref.QualifiedName = let b = new System.Text.StringBuilder(100) let add (s:string) = (b.Append(s) |> ignore) @@ -478,13 +476,6 @@ type ILScopeRef = member x.AssemblyRef = match x with ILScopeRef.Assembly x -> x | _ -> failwith "not an assembly reference" member scoref.QualifiedName = - match scoref with - | ILScopeRef.Local -> "" - | ILScopeRef.Module mref -> "module "^mref.Name - | ILScopeRef.Assembly aref when aref.Name = "mscorlib" -> "" - | ILScopeRef.Assembly aref -> aref.QualifiedName - - member scoref.QualifiedNameWithNoShortPrimaryAssembly = match scoref with | ILScopeRef.Local -> "" | ILScopeRef.Module mref -> "module "+mref.Name @@ -602,18 +593,12 @@ type ILTypeRef = member tref.BasicQualifiedName = (String.concat "+" (tref.Enclosing @ [ tref.Name ] )).Replace(",", @"\,") - member tref.AddQualifiedNameExtensionWithNoShortPrimaryAssembly(basic) = - let sco = tref.Scope.QualifiedNameWithNoShortPrimaryAssembly - if sco = "" then basic else String.concat ", " [basic;sco] - - member tref.QualifiedNameWithNoShortPrimaryAssembly = - tref.AddQualifiedNameExtensionWithNoShortPrimaryAssembly(tref.BasicQualifiedName) - - member tref.QualifiedName = - let basic = tref.BasicQualifiedName + member tref.AddQualifiedNameExtension(basic) = let sco = tref.Scope.QualifiedName if sco = "" then basic else String.concat ", " [basic;sco] + member tref.QualifiedName = + tref.AddQualifiedNameExtension(tref.BasicQualifiedName) override x.ToString() = x.FullName @@ -624,22 +609,30 @@ and { tspecTypeRef: ILTypeRef; /// The type instantiation if the type is generic. tspecInst: ILGenericArgs } + member x.TypeRef=x.tspecTypeRef + member x.Scope=x.TypeRef.Scope + member x.Enclosing=x.TypeRef.Enclosing + member x.Name=x.TypeRef.Name + member x.GenericArgs=x.tspecInst + static member Create(tref,inst) = { tspecTypeRef =tref; tspecInst=inst } + override x.ToString() = x.TypeRef.ToString() + if isNil x.GenericArgs then "" else "<...>" + member x.BasicQualifiedName = let tc = x.TypeRef.BasicQualifiedName if isNil x.GenericArgs then tc else - tc + "[" + String.concat "," (x.GenericArgs |> List.map (fun arg -> "[" + arg.QualifiedNameWithNoShortPrimaryAssembly + "]")) + "]" + tc + "[" + String.concat "," (x.GenericArgs |> List.map (fun arg -> "[" + arg.QualifiedName + "]")) + "]" - member x.AddQualifiedNameExtensionWithNoShortPrimaryAssembly(basic) = - x.TypeRef.AddQualifiedNameExtensionWithNoShortPrimaryAssembly(basic) + member x.AddQualifiedNameExtension(basic) = + x.TypeRef.AddQualifiedNameExtension(basic) member x.FullName=x.TypeRef.FullName @@ -666,19 +659,19 @@ and [] | ILType.Byref _ty -> failwith "unexpected byref type" | ILType.FunctionPointer _mref -> failwith "unexpected function pointer type" - member x.AddQualifiedNameExtensionWithNoShortPrimaryAssembly(basic) = + member x.AddQualifiedNameExtension(basic) = match x with | ILType.TypeVar _n -> basic - | ILType.Modified(_,_ty1,ty2) -> ty2.AddQualifiedNameExtensionWithNoShortPrimaryAssembly(basic) - | ILType.Array (ILArrayShape(_s),ty) -> ty.AddQualifiedNameExtensionWithNoShortPrimaryAssembly(basic) - | ILType.Value tr | ILType.Boxed tr -> tr.AddQualifiedNameExtensionWithNoShortPrimaryAssembly(basic) + | ILType.Modified(_,_ty1,ty2) -> ty2.AddQualifiedNameExtension(basic) + | ILType.Array (ILArrayShape(_s),ty) -> ty.AddQualifiedNameExtension(basic) + | ILType.Value tr | ILType.Boxed tr -> tr.AddQualifiedNameExtension(basic) | ILType.Void -> failwith "void" | ILType.Ptr _ty -> failwith "unexpected pointer type" | ILType.Byref _ty -> failwith "unexpected byref type" | ILType.FunctionPointer _mref -> failwith "unexpected function pointer type" - member x.QualifiedNameWithNoShortPrimaryAssembly = - x.AddQualifiedNameExtensionWithNoShortPrimaryAssembly(x.BasicQualifiedName) + member x.QualifiedName = + x.AddQualifiedNameExtension(x.BasicQualifiedName) member x.TypeSpec = match x with @@ -3301,7 +3294,7 @@ let rec encodeCustomAttrElemType x = | ILType.Boxed tspec when tspec.Name = tname_String -> [| et_STRING |] | ILType.Boxed tspec when tspec.Name = tname_Object -> [| 0x51uy |] | ILType.Boxed tspec when tspec.Name = tname_Type -> [| 0x50uy |] - | ILType.Value tspec -> Array.append [| 0x55uy |] (encodeCustomAttrString tspec.TypeRef.QualifiedNameWithNoShortPrimaryAssembly) + | ILType.Value tspec -> Array.append [| 0x55uy |] (encodeCustomAttrString tspec.TypeRef.QualifiedName) | ILType.Array (shape, elemType) when shape = ILArrayShape.SingleDimensional -> Array.append [| et_SZARRAY |] (encodeCustomAttrElemType elemType) | _ -> failwith "encodeCustomAttrElemType: unrecognized custom element type" @@ -3372,8 +3365,8 @@ let rec encodeCustomAttrPrimValue ilg c = | ILAttribElem.UInt64 x -> u64AsBytes x | ILAttribElem.Single x -> ieee32AsBytes x | ILAttribElem.Double x -> ieee64AsBytes x - | ILAttribElem.Type (Some ty) -> encodeCustomAttrString ty.QualifiedNameWithNoShortPrimaryAssembly - | ILAttribElem.TypeRef (Some tref) -> encodeCustomAttrString tref.QualifiedNameWithNoShortPrimaryAssembly + | ILAttribElem.Type (Some ty) -> encodeCustomAttrString ty.QualifiedName + | ILAttribElem.TypeRef (Some tref) -> encodeCustomAttrString tref.QualifiedName | ILAttribElem.Array (_,elems) -> [| yield! i32AsBytes elems.Length; for elem in elems do yield! encodeCustomAttrPrimValue ilg elem |] @@ -3427,7 +3420,7 @@ let mkPermissionSet (ilg: ILGlobals) (action,attributes: list<(ILTypeRef * (stri [| yield (byte '.'); yield! z_unsigned_int attributes.Length; for (tref:ILTypeRef,props) in attributes do - yield! encodeCustomAttrString tref.QualifiedNameWithNoShortPrimaryAssembly + yield! encodeCustomAttrString tref.QualifiedName let bytes = [| yield! z_unsigned_int props.Length; for (nm,typ,value) in props do diff --git a/src/absil/il.fsi b/src/absil/il.fsi index 33b077e197..621bfb1eff 100755 --- a/src/absil/il.fsi +++ b/src/absil/il.fsi @@ -184,15 +184,12 @@ type ILTypeRef = member QualifiedName: string -#if !NO_EXTENSIONTYPING - member QualifiedNameWithNoShortPrimaryAssembly: string -#endif - interface System.IComparable /// Type specs and types. [] type ILTypeSpec = + /// Create an ILTypeSpec. static member Create: typeRef:ILTypeRef * instantiation:ILGenericArgs -> ILTypeSpec /// Which type is being referred to? @@ -200,10 +197,19 @@ type ILTypeSpec = /// The type instantiation if the type is generic, otherwise empty member GenericArgs: ILGenericArgs + + /// Where is the type, i.e. is it in this module, in another module in this assembly or in another assembly? member Scope: ILScopeRef + + /// The list of enclosing type names for a nested type. If non-nil then the first of these also contains the namespace. member Enclosing: string list + + /// The name of the type. This also contains the namespace if Enclosing is empty. member Name: string + + /// The name of the type in the assembly using the '.' notation for nested types. member FullName: string + interface System.IComparable and @@ -244,13 +250,20 @@ and ILType member TypeSpec: ILTypeSpec + member Boxity: ILBoxity + member TypeRef: ILTypeRef + member IsNominal: bool + member GenericArgs: ILGenericArgs + member IsTyvar: bool + member BasicQualifiedName: string - member QualifiedNameWithNoShortPrimaryAssembly: string + + member QualifiedName: string and [] ILCallingSignature = @@ -271,13 +284,21 @@ type ILMethodRef = static member Create: enclosingTypeRef: ILTypeRef * callingConv: ILCallingConv * name: string * genericArity: int * argTypes: ILTypes * returnType: ILType -> ILMethodRef member DeclaringTypeRef: ILTypeRef + member CallingConv: ILCallingConv + member Name: string + member GenericArity: int + member ArgCount: int + member ArgTypes: ILTypes + member ReturnType: ILType + member CallingSignature: ILCallingSignature + interface System.IComparable /// Formal identities of fields. @@ -295,13 +316,21 @@ type ILMethodSpec = static member Create: ILType * ILMethodRef * ILGenericArgs -> ILMethodSpec member MethodRef: ILMethodRef + member DeclaringType: ILType + member GenericArgs: ILGenericArgs + member CallingConv: ILCallingConv + member GenericArity: int + member Name: string + member FormalArgTypes: ILTypes + member FormalReturnType: ILType + interface System.IComparable /// Field specs. The data given for a ldfld, stfld etc. instruction. @@ -311,8 +340,11 @@ type ILFieldSpec = DeclaringType: ILType } member DeclaringTypeRef: ILTypeRef + member Name: string + member FormalType: ILType + member ActualType: ILType /// ILCode labels. In structured code each code label refers to a basic block somewhere in the code of the method. diff --git a/src/fsharp/CompileOps.fs b/src/fsharp/CompileOps.fs index 7c0c6220f1..144fd3a65c 100755 --- a/src/fsharp/CompileOps.fs +++ b/src/fsharp/CompileOps.fs @@ -5326,7 +5326,6 @@ let CheckSimulateException(tcConfig:TcConfig) = type RootSigs = Zmap type RootImpls = Zset -type TypecheckerSigsAndImpls = RootSigsAndImpls of RootSigs * RootImpls * ModuleOrNamespaceType * ModuleOrNamespaceType let qnameOrder = Order.orderBy (fun (q:QualifiedNameOfFile) -> q.Text) @@ -5337,17 +5336,25 @@ type TcState = tcsTcSigEnv: TcEnv tcsTcImplEnv: TcEnv tcsCreatesGeneratedProvidedTypes: bool - /// The accumulated results of type checking for this assembly - tcsRootSigsAndImpls : TypecheckerSigsAndImpls } + tcsRootSigs: RootSigs + tcsRootImpls: RootImpls + tcsCcuSig: ModuleOrNamespaceType } + member x.NiceNameGenerator = x.tcsNiceNameGen + member x.TcEnvFromSignatures = x.tcsTcSigEnv + member x.TcEnvFromImpls = x.tcsTcImplEnv + member x.Ccu = x.tcsCcu + member x.CreatesGeneratedProvidedTypes = x.tcsCreatesGeneratedProvidedTypes - member x.PartialAssemblySignature = - let (RootSigsAndImpls(_rootSigs, _rootImpls, _allSigModulTyp, allImplementedSigModulTyp)) = x.tcsRootSigsAndImpls - allImplementedSigModulTyp + // Assem(a.fsi + b.fsi + c.fsi) (after checking implementation file ) + member x.CcuType = x.tcsCcuType + + // a.fsi + b.fsi + c.fsi (after checking implementation file for c.fs) + member x.CcuSig = x.tcsCcuSig member x.NextStateAfterIncrementalFragment(tcEnvAtEndOfLastInput) = { x with tcsTcSigEnv = tcEnvAtEndOfLastInput @@ -5385,133 +5392,127 @@ let GetInitialTcState(m, ccuName, tcConfig:TcConfig, tcGlobals, tcImports:TcImpo if tcConfig.compilingFslib then tcGlobals.fslibCcu.Fixup(ccu) - let rootSigs = Zmap.empty qnameOrder - let rootImpls = Zset.empty qnameOrder - let allSigModulTyp = NewEmptyModuleOrNamespaceType Namespace - let allImplementedSigModulTyp = NewEmptyModuleOrNamespaceType Namespace { tcsCcu= ccu tcsCcuType=ccuType tcsNiceNameGen=niceNameGen tcsTcSigEnv=tcEnv0 tcsTcImplEnv=tcEnv0 tcsCreatesGeneratedProvidedTypes=false - tcsRootSigsAndImpls = RootSigsAndImpls (rootSigs, rootImpls, allSigModulTyp, allImplementedSigModulTyp) } + tcsRootSigs = Zmap.empty qnameOrder + tcsRootImpls = Zset.empty qnameOrder + tcsCcuSig = NewEmptyModuleOrNamespaceType Namespace } + /// Typecheck a single file (or interactive entry into F# Interactive) -let TypeCheckOneInputEventually - (checkForErrors, tcConfig:TcConfig, tcImports:TcImports, - tcGlobals, prefixPathOpt, tcSink, tcState: TcState, inp: ParsedInput) = - eventually { - try - let! ctok = Eventually.token - RequireCompilationThread ctok // Everything here requires the compilation thread since it works on the TAST - - CheckSimulateException(tcConfig) - let (RootSigsAndImpls(rootSigs, rootImpls, allSigModulTyp, allImplementedSigModulTyp)) = tcState.tcsRootSigsAndImpls - let m = inp.Range - let amap = tcImports.GetImportMap() - let! (topAttrs, implFiles, tcEnvAtEnd, tcSigEnv, tcImplEnv, topSigsAndImpls, ccuType, createsGeneratedProvidedTypes) = - eventually { - match inp with - | ParsedInput.SigFile (ParsedSigFileInput(_, qualNameOfFile, _, _, _) as file) -> - - // Check if we've seen this top module signature before. - if Zmap.mem qualNameOfFile rootSigs then - errorR(Error(FSComp.SR.buildSignatureAlreadySpecified(qualNameOfFile.Text), m.StartRange)) +let TypeCheckOneInputEventually (checkForErrors, tcConfig:TcConfig, tcImports:TcImports, tcGlobals, prefixPathOpt, tcSink, tcState: TcState, inp: ParsedInput) = - // Check if the implementation came first in compilation order - if Zset.contains qualNameOfFile rootImpls then - errorR(Error(FSComp.SR.buildImplementationAlreadyGivenDetail(qualNameOfFile.Text), m)) + eventually { + try + let! ctok = Eventually.token + RequireCompilationThread ctok // Everything here requires the compilation thread since it works on the TAST - // Typecheck the signature file - let! (tcEnv, sigFileType, createsGeneratedProvidedTypes) = - TypeCheckOneSigFile (tcGlobals, tcState.tcsNiceNameGen, amap, tcState.tcsCcu, checkForErrors, tcConfig.conditionalCompilationDefines, tcSink) tcState.tcsTcSigEnv file + CheckSimulateException(tcConfig) - let rootSigs = Zmap.add qualNameOfFile sigFileType rootSigs + let m = inp.Range + let amap = tcImports.GetImportMap() + match inp with + | ParsedInput.SigFile (ParsedSigFileInput(_, qualNameOfFile, _, _, _) as file) -> + + // Check if we've seen this top module signature before. + if Zmap.mem qualNameOfFile tcState.tcsRootSigs then + errorR(Error(FSComp.SR.buildSignatureAlreadySpecified(qualNameOfFile.Text), m.StartRange)) - // Open the prefixPath for fsi.exe - let tcEnv = - match prefixPathOpt with - | None -> tcEnv - | Some prefixPath -> - let m = qualNameOfFile.Range - TcOpenDecl tcSink tcGlobals amap m m tcEnv prefixPath + // Check if the implementation came first in compilation order + if Zset.contains qualNameOfFile tcState.tcsRootImpls then + errorR(Error(FSComp.SR.buildImplementationAlreadyGivenDetail(qualNameOfFile.Text), m)) - let res = (EmptyTopAttrs, None, tcEnv, tcEnv, tcState.tcsTcImplEnv, RootSigsAndImpls(rootSigs, rootImpls, allSigModulTyp, allImplementedSigModulTyp), tcState.tcsCcuType, createsGeneratedProvidedTypes) - return res + // Typecheck the signature file + let! (tcEnv, sigFileType, createsGeneratedProvidedTypes) = + TypeCheckOneSigFile (tcGlobals, tcState.tcsNiceNameGen, amap, tcState.tcsCcu, checkForErrors, tcConfig.conditionalCompilationDefines, tcSink) tcState.tcsTcSigEnv file - | ParsedInput.ImplFile (ParsedImplFileInput(filename, _, qualNameOfFile, _, _, _, _) as file) -> - - // Check if we've got an interface for this fragment - let rootSigOpt = rootSigs.TryFind(qualNameOfFile) + let rootSigs = Zmap.add qualNameOfFile sigFileType tcState.tcsRootSigs - if verbose then dprintf "ParsedInput.ImplFile, nm = %s, qualNameOfFile = %s, ?rootSigOpt = %b\n" filename qualNameOfFile.Text (Option.isSome rootSigOpt) + // Add the signature to the signature env (unless it had an explicit signature) + let ccuSigForFile = CombineCcuContentFragments m [sigFileType; tcState.tcsCcuSig] + + // Open the prefixPath for fsi.exe + let tcEnv = + match prefixPathOpt with + | None -> tcEnv + | Some prefixPath -> + let m = qualNameOfFile.Range + TcOpenDecl tcSink tcGlobals amap m m tcEnv prefixPath + + let tcState = + { tcState with + tcsTcSigEnv=tcEnv + tcsTcImplEnv=tcState.tcsTcImplEnv + tcsRootSigs=rootSigs + tcsCreatesGeneratedProvidedTypes=tcState.tcsCreatesGeneratedProvidedTypes || createsGeneratedProvidedTypes} + + return (tcEnv, EmptyTopAttrs, None, ccuSigForFile), tcState + + | ParsedInput.ImplFile (ParsedImplFileInput(_, _, qualNameOfFile, _, _, _, _) as file) -> + + // Check if we've got an interface for this fragment + let rootSigOpt = tcState.tcsRootSigs.TryFind(qualNameOfFile) - // Check if we've already seen an implementation for this fragment - if Zset.contains qualNameOfFile rootImpls then + // Check if we've already seen an implementation for this fragment + if Zset.contains qualNameOfFile tcState.tcsRootImpls then errorR(Error(FSComp.SR.buildImplementationAlreadyGiven(qualNameOfFile.Text), m)) - let tcImplEnv = tcState.tcsTcImplEnv + let tcImplEnv = tcState.tcsTcImplEnv - // Typecheck the implementation file - let! topAttrs, implFile, tcEnvAtEnd, createsGeneratedProvidedTypes = - TypeCheckOneImplFile (tcGlobals, tcState.tcsNiceNameGen, amap, tcState.tcsCcu, checkForErrors, tcConfig.conditionalCompilationDefines, tcSink) tcImplEnv rootSigOpt file + // Typecheck the implementation file + let! topAttrs, implFile, _implFileHiddenType, tcEnvAtEnd, createsGeneratedProvidedTypes = + TypeCheckOneImplFile (tcGlobals, tcState.tcsNiceNameGen, amap, tcState.tcsCcu, checkForErrors, tcConfig.conditionalCompilationDefines, tcSink) tcImplEnv rootSigOpt file - let hadSig = Option.isSome rootSigOpt - let implFileSigType = SigTypeOfImplFile implFile + let hadSig = rootSigOpt.IsSome + let implFileSigType = SigTypeOfImplFile implFile - if verbose then dprintf "done TypeCheckOneImplFile...\n" - let rootImpls = Zset.add qualNameOfFile rootImpls + let rootImpls = Zset.add qualNameOfFile tcState.tcsRootImpls - // Only add it to the environment if it didn't have a signature - let m = qualNameOfFile.Range + // Only add it to the environment if it didn't have a signature + let m = qualNameOfFile.Range - // Add the implementation as to the implementation env - let tcImplEnv = AddLocalRootModuleOrNamespace TcResultsSink.NoSink tcGlobals amap m tcImplEnv implFileSigType + // Add the implementation as to the implementation env + let tcImplEnv = AddLocalRootModuleOrNamespace TcResultsSink.NoSink tcGlobals amap m tcImplEnv implFileSigType - // Add the implementation as to the signature env (unless it had an explicit signature) - let tcSigEnv = - if hadSig then tcState.tcsTcSigEnv - else AddLocalRootModuleOrNamespace TcResultsSink.NoSink tcGlobals amap m tcState.tcsTcSigEnv implFileSigType + // Add the implementation as to the signature env (unless it had an explicit signature) + let tcSigEnv = + if hadSig then tcState.tcsTcSigEnv + else AddLocalRootModuleOrNamespace TcResultsSink.NoSink tcGlobals amap m tcState.tcsTcSigEnv implFileSigType - // Open the prefixPath for fsi.exe (tcImplEnv) - let tcImplEnv = - match prefixPathOpt with - | Some prefixPath -> TcOpenDecl tcSink tcGlobals amap m m tcImplEnv prefixPath - | _ -> tcImplEnv - - // Open the prefixPath for fsi.exe (tcSigEnv) - let tcSigEnv = - match prefixPathOpt with - | Some prefixPath when not hadSig -> TcOpenDecl tcSink tcGlobals amap m m tcSigEnv prefixPath - | _ -> tcSigEnv - - let allImplementedSigModulTyp = CombineCcuContentFragments m [implFileSigType; allImplementedSigModulTyp] - - // Add it to the CCU - let ccuType = - // The signature must be reestablished. - // [CHECK: Why? This seriously degraded performance] - NewCcuContents ILScopeRef.Local m tcState.tcsCcu.AssemblyName allImplementedSigModulTyp - - if verbose then dprintf "done TypeCheckOneInputEventually...\n" - - let topSigsAndImpls = RootSigsAndImpls(rootSigs, rootImpls, allSigModulTyp, allImplementedSigModulTyp) - let res = (topAttrs, Some implFile, tcEnvAtEnd, tcSigEnv, tcImplEnv, topSigsAndImpls, ccuType, createsGeneratedProvidedTypes) - return res } + // Open the prefixPath for fsi.exe (tcImplEnv) + let tcImplEnv = + match prefixPathOpt with + | Some prefixPath -> TcOpenDecl tcSink tcGlobals amap m m tcImplEnv prefixPath + | _ -> tcImplEnv + + // Open the prefixPath for fsi.exe (tcSigEnv) + let tcSigEnv = + match prefixPathOpt with + | Some prefixPath when not hadSig -> TcOpenDecl tcSink tcGlobals amap m m tcSigEnv prefixPath + | _ -> tcSigEnv + + let ccuSig = CombineCcuContentFragments m [implFileSigType; tcState.tcsCcuSig ] + + let ccuSigForFile = CombineCcuContentFragments m [implFileSigType; tcState.tcsCcuSig] + + let tcState = + { tcState with + tcsTcSigEnv=tcSigEnv + tcsTcImplEnv=tcImplEnv + tcsRootImpls=rootImpls + tcsCcuSig=ccuSig + tcsCreatesGeneratedProvidedTypes=tcState.tcsCreatesGeneratedProvidedTypes || createsGeneratedProvidedTypes } + return (tcEnvAtEnd, topAttrs, Some implFile, ccuSigForFile), tcState - return (tcEnvAtEnd, topAttrs, implFiles), - { tcState with - tcsCcuType=ccuType - tcsTcSigEnv=tcSigEnv - tcsTcImplEnv=tcImplEnv - tcsCreatesGeneratedProvidedTypes=tcState.tcsCreatesGeneratedProvidedTypes || createsGeneratedProvidedTypes - tcsRootSigsAndImpls = topSigsAndImpls } - with e -> - errorRecovery e range0 - return (tcState.TcEnvFromSignatures, EmptyTopAttrs, None), tcState - } + with e -> + errorRecovery e range0 + return (tcState.TcEnvFromSignatures, EmptyTopAttrs, None, tcState.tcsCcuSig), tcState + } /// Typecheck a single file (or interactive entry into F# Interactive) let TypeCheckOneInput (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt) tcState inp = @@ -5523,19 +5524,12 @@ let TypeCheckOneInput (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, pre /// Finish checking multiple files (or one interactive entry into F# Interactive) let TypeCheckMultipleInputsFinish(results, tcState: TcState) = - let tcEnvsAtEndFile, topAttrs, implFiles = List.unzip3 results - + let tcEnvsAtEndFile, topAttrs, implFiles, ccuSigsForFiles = List.unzip4 results let topAttrs = List.foldBack CombineTopAttrs topAttrs EmptyTopAttrs let implFiles = List.choose id implFiles // This is the environment required by fsi.exe when incrementally adding definitions let tcEnvAtEndOfLastFile = (match tcEnvsAtEndFile with h :: _ -> h | _ -> tcState.TcEnvFromSignatures) - - (tcEnvAtEndOfLastFile, topAttrs, implFiles), tcState - -/// Check multiple files (or one interactive entry into F# Interactive) -let TypeCheckMultipleInputs (ctok, checkForErrors, tcConfig: TcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, inputs) = - let results, tcState = (tcState, inputs) ||> List.mapFold (TypeCheckOneInput (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt)) - TypeCheckMultipleInputsFinish(results, tcState) + (tcEnvAtEndOfLastFile, topAttrs, implFiles, ccuSigsForFiles), tcState let TypeCheckOneInputAndFinishEventually(checkForErrors, tcConfig: TcConfig, tcImports, tcGlobals, prefixPathOpt, tcSink, tcState, input) = eventually { @@ -5545,18 +5539,18 @@ let TypeCheckOneInputAndFinishEventually(checkForErrors, tcConfig: TcConfig, tcI let TypeCheckClosedInputSetFinish (declaredImpls: TypedImplFile list, tcState) = // Publish the latest contents to the CCU - tcState.tcsCcu.Deref.Contents <- tcState.tcsCcuType + tcState.tcsCcu.Deref.Contents <- NewCcuContents ILScopeRef.Local range0 tcState.tcsCcu.AssemblyName tcState.tcsCcuSig // Check all interfaces have implementations - let (RootSigsAndImpls(rootSigs, rootImpls, _, _)) = tcState.tcsRootSigsAndImpls - rootSigs |> Zmap.iter (fun qualNameOfFile _ -> - if not (Zset.contains qualNameOfFile rootImpls) then + tcState.tcsRootSigs |> Zmap.iter (fun qualNameOfFile _ -> + if not (Zset.contains qualNameOfFile tcState.tcsRootImpls) then errorR(Error(FSComp.SR.buildSignatureWithoutImplementation(qualNameOfFile.Text), qualNameOfFile.Range))) tcState, declaredImpls let TypeCheckClosedInputSet (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, inputs) = // tcEnvAtEndOfLastFile is the environment required by fsi.exe when incrementally adding definitions - let (tcEnvAtEndOfLastFile, topAttrs, implFiles), tcState = TypeCheckMultipleInputs (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt, tcState, inputs) + let results, tcState = (tcState, inputs) ||> List.mapFold (TypeCheckOneInput (ctok, checkForErrors, tcConfig, tcImports, tcGlobals, prefixPathOpt)) + let (tcEnvAtEndOfLastFile, topAttrs, implFiles, _), tcState = TypeCheckMultipleInputsFinish(results, tcState) let tcState, declaredImpls = TypeCheckClosedInputSetFinish (implFiles, tcState) tcState, topAttrs, declaredImpls, tcEnvAtEndOfLastFile diff --git a/src/fsharp/CompileOps.fsi b/src/fsharp/CompileOps.fsi index 0b40471266..50f2add519 100755 --- a/src/fsharp/CompileOps.fsi +++ b/src/fsharp/CompileOps.fsi @@ -704,8 +704,10 @@ type TcState = /// Get the typing environment implied by the set of implementation files checked so far member TcEnvFromImpls: TcEnv - /// The inferred contents of the assembly, containing the signatures of all implemented files. - member PartialAssemblySignature: ModuleOrNamespaceType + + /// The inferred contents of the assembly, containing the signatures of all files. + // a.fsi + b.fsi + c.fsi (after checking implementation file for c.fs) + member CcuSig: ModuleOrNamespaceType member NextStateAfterIncrementalFragment: TcEnv -> TcState @@ -718,10 +720,10 @@ val GetInitialTcState: /// Check one input, returned as an Eventually computation val TypeCheckOneInputEventually : checkForErrors:(unit -> bool) * TcConfig * TcImports * TcGlobals * Ast.LongIdent option * NameResolution.TcResultsSink * TcState * Ast.ParsedInput - -> Eventually<(TcEnv * TopAttribs * TypedImplFile option) * TcState> + -> Eventually<(TcEnv * TopAttribs * TypedImplFile option * ModuleOrNamespaceType) * TcState> /// Finish the checking of multiple inputs -val TypeCheckMultipleInputsFinish: (TcEnv * TopAttribs * 'T option) list * TcState -> (TcEnv * TopAttribs * 'T list) * TcState +val TypeCheckMultipleInputsFinish: (TcEnv * TopAttribs * 'T option * 'U) list * TcState -> (TcEnv * TopAttribs * 'T list * 'U list) * TcState /// Finish the checking of a closed set of inputs val TypeCheckClosedInputSetFinish: TypedImplFile list * TcState -> TcState * TypedImplFile list @@ -732,7 +734,7 @@ val TypeCheckClosedInputSet: CompilationThreadToken * checkForErrors: (unit -> b /// Check a single input and finish the checking val TypeCheckOneInputAndFinishEventually : checkForErrors: (unit -> bool) * TcConfig * TcImports * TcGlobals * Ast.LongIdent option * NameResolution.TcResultsSink * TcState * Ast.ParsedInput - -> Eventually<(TcEnv * TopAttribs * TypedImplFile list) * TcState> + -> Eventually<(TcEnv * TopAttribs * TypedImplFile list * ModuleOrNamespaceType list) * TcState> /// Indicates if we should report a warning val ReportWarning: FSharpErrorSeverityOptions -> PhasedDiagnostic -> bool diff --git a/src/fsharp/FindUnsolved.fs b/src/fsharp/FindUnsolved.fs index f207262e93..aa144dc49e 100755 --- a/src/fsharp/FindUnsolved.fs +++ b/src/fsharp/FindUnsolved.fs @@ -218,7 +218,7 @@ let accTycons cenv env tycons = List.iter (accTycon cenv env) tycons let rec accModuleOrNamespaceExpr cenv env x = match x with - | ModuleOrNamespaceExprWithSig(_mty,def,_m) -> accModuleOrNamespaceDef cenv env def + | ModuleOrNamespaceExprWithSig(_mty, def, _m) -> accModuleOrNamespaceDef cenv env def and accModuleOrNamespaceDefs cenv env x = List.iter (accModuleOrNamespaceDef cenv env) x diff --git a/src/fsharp/IlxGen.fs b/src/fsharp/IlxGen.fs index 493b9c3c96..56325f5a6f 100755 --- a/src/fsharp/IlxGen.fs +++ b/src/fsharp/IlxGen.fs @@ -970,7 +970,7 @@ and AddBindingsForModuleDef allocVal cloc eenv x = allocVal cloc bind.Var eenv | TMDefDo _ -> eenv - | TMAbstract(ModuleOrNamespaceExprWithSig(mtyp,_,_)) -> + | TMAbstract(ModuleOrNamespaceExprWithSig(mtyp, _, _)) -> AddBindingsForLocalModuleType allocVal cloc eenv mtyp | TMDefs(mdefs) -> AddBindingsForModuleDefs allocVal cloc eenv mdefs @@ -1001,8 +1001,7 @@ let AddIncrementalLocalAssemblyFragmentToIlxGenEnv (amap:ImportMap, isIncrementa let cloc = { cloc with clocTopImplQualifiedName = qname.Text } if isIncrementalFragment then match mexpr with - | ModuleOrNamespaceExprWithSig(_,mdef,_) -> AddBindingsForModuleDef allocVal cloc eenv mdef - (* | ModuleOrNamespaceExprWithSig(mtyp,_,m) -> error(Error("don't expect inner defs to have a constraint",m)) *) + | ModuleOrNamespaceExprWithSig(_, mdef, _) -> AddBindingsForModuleDef allocVal cloc eenv mdef else AddBindingsForLocalModuleType allocVal cloc eenv mexpr.Type) @@ -5782,7 +5781,7 @@ and GenTypeDefForCompLoc (cenv, eenv, mgbuf: AssemblyBuilder, cloc, hidden, attr and GenModuleExpr cenv cgbuf qname lazyInitInfo eenv x = - let (ModuleOrNamespaceExprWithSig(mty,def,_)) = x + let (ModuleOrNamespaceExprWithSig(mty, def, _)) = x // REVIEW: the scopeMarks are used for any shadow locals we create for the module bindings // We use one scope for all the bindings in the module, which makes them all appear with their "default" values // rather than incrementally as we step through the initializations in the module. This is a little unfortunate diff --git a/src/fsharp/InnerLambdasToTopLevelFuncs.fs b/src/fsharp/InnerLambdasToTopLevelFuncs.fs index f8fc135449..0828e1cd0f 100755 --- a/src/fsharp/InnerLambdasToTopLevelFuncs.fs +++ b/src/fsharp/InnerLambdasToTopLevelFuncs.fs @@ -1249,9 +1249,9 @@ module Pass4_RewriteAssembly = and TransValBindings penv z binds = List.mapFold (TransValBinding penv) z binds and TransModuleExpr penv z x = match x with - | ModuleOrNamespaceExprWithSig(mty,def,m) -> + | ModuleOrNamespaceExprWithSig(mty, def, m) -> let def,z = TransModuleDef penv z def - ModuleOrNamespaceExprWithSig(mty,def,m),z + ModuleOrNamespaceExprWithSig(mty, def, m),z and TransModuleDefs penv z x = List.mapFold (TransModuleDef penv) z x and TransModuleDef penv (z: RewriteState) x : ModuleOrNamespaceExpr * RewriteState = diff --git a/src/fsharp/NicePrint.fs b/src/fsharp/NicePrint.fs index e3ad74ad0d..f31fc657cc 100755 --- a/src/fsharp/NicePrint.fs +++ b/src/fsharp/NicePrint.fs @@ -1824,11 +1824,11 @@ module private InferredSigPrinting = | TMDefLet _ -> true | TMDefDo _ -> true | TMDefs defs -> defs |> List.exists isConcreteNamespace - | TMAbstract(ModuleOrNamespaceExprWithSig(_,def,_)) -> isConcreteNamespace def + | TMAbstract(ModuleOrNamespaceExprWithSig(_, def, _)) -> isConcreteNamespace def - let rec imexprLP denv (ModuleOrNamespaceExprWithSig(_,def,_)) = imdefL denv def + let rec imexprLP denv (ModuleOrNamespaceExprWithSig(_, def, _)) = imdefL denv def - and imexprL denv (ModuleOrNamespaceExprWithSig(mty,def,m)) = imexprLP denv (ModuleOrNamespaceExprWithSig(mty,def,m)) + and imexprL denv (ModuleOrNamespaceExprWithSig(mty, def, m)) = imexprLP denv (ModuleOrNamespaceExprWithSig(mty, def, m)) and imdefsL denv x = aboveListL (x |> List.map (imdefL denv)) diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index 7ce763fede..308736ddbd 100755 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -3154,7 +3154,7 @@ and OptimizeModuleDefs cenv (env, bindInfosColl) defs = let defs, minfos = List.unzip defs (defs, UnionOptimizationInfos minfos), (env, bindInfosColl) -and OptimizeImplFileInternal cenv env isIncrementalFragment hidden (TImplFile(qname, pragmas, (ModuleOrNamespaceExprWithSig(mty, _, _) as mexpr), hasExplicitEntryPoint, isScript)) = +and OptimizeImplFileInternal cenv env isIncrementalFragment hidden (TImplFile(qname, pragmas, mexpr, hasExplicitEntryPoint, isScript)) = let env, mexpr', minfo = match mexpr with // FSI: FSI compiles everything as if you're typing incrementally into one module @@ -3170,7 +3170,7 @@ and OptimizeImplFileInternal cenv env isIncrementalFragment hidden (TImplFile(qn let env = { env with localExternalVals=env.localExternalVals.MarkAsCollapsible() } // take the chance to flatten to a dictionary env, mexpr', minfo - let hidden = ComputeHidingInfoAtAssemblyBoundary mty hidden + let hidden = ComputeHidingInfoAtAssemblyBoundary mexpr.Type hidden let minfo = AbstractLazyModulInfoByHiding true hidden minfo env, TImplFile(qname, pragmas, mexpr', hasExplicitEntryPoint, isScript), minfo, hidden diff --git a/src/fsharp/PostInferenceChecks.fs b/src/fsharp/PostInferenceChecks.fs index c22fb3f409..1d722b3e45 100755 --- a/src/fsharp/PostInferenceChecks.fs +++ b/src/fsharp/PostInferenceChecks.fs @@ -1657,7 +1657,7 @@ let CheckEntityDefns cenv env tycons = let rec CheckModuleExpr cenv env x = match x with - | ModuleOrNamespaceExprWithSig(mty,def,_) -> + | ModuleOrNamespaceExprWithSig(mty, def, _) -> let (rpi,mhi) = ComputeRemappingFromImplementationToSignature cenv.g def mty let env = { env with sigToImplRemapInfo = (mkRepackageRemapping rpi,mhi) :: env.sigToImplRemapInfo } CheckDefnInModule cenv env def diff --git a/src/fsharp/TastOps.fs b/src/fsharp/TastOps.fs index 31f0b9790d..25a2ac7b9c 100644 --- a/src/fsharp/TastOps.fs +++ b/src/fsharp/TastOps.fs @@ -3692,6 +3692,7 @@ let wrapModuleOrNamespaceExprInNamespace (id :Ident) cpath mexpr = // cleanup: make this a property let SigTypeOfImplFile (TImplFile(_, _, mexpr, _, _)) = mexpr.Type + //-------------------------------------------------------------------------- // Data structures representing what gets hidden and what gets remapped (i.e. renamed or alpha-converted) // when a module signature is applied to a module. @@ -5087,12 +5088,12 @@ and allValsOfModDef mdef = | TMAbstract(ModuleOrNamespaceExprWithSig(mty, _, _)) -> yield! allValsOfModuleOrNamespaceTy mty } -and remapAndBindModExpr g compgen tmenv (ModuleOrNamespaceExprWithSig(mty, mdef, m)) = +and remapAndBindModuleOrNamespaceExprWithSig g compgen tmenv (ModuleOrNamespaceExprWithSig(mty, mdef, m)) = let mdef = copyAndRemapModDef g compgen tmenv mdef let mty, tmenv = copyAndRemapAndBindModTy g compgen tmenv mty ModuleOrNamespaceExprWithSig(mty, mdef, m), tmenv -and remapModExpr g compgen tmenv (ModuleOrNamespaceExprWithSig(mty, mdef, m)) = +and remapModuleOrNamespaceExprWithSig g compgen tmenv (ModuleOrNamespaceExprWithSig(mty, mdef, m)) = let mdef = copyAndRemapModDef g compgen tmenv mdef let mty = remapModTy g compgen tmenv mty ModuleOrNamespaceExprWithSig(mty, mdef, m) @@ -5124,7 +5125,7 @@ and remapAndRenameModDef g compgen tmenv mdef = let defs = remapAndRenameModDefs g compgen tmenv defs TMDefs defs | TMAbstract mexpr -> - let mexpr = remapModExpr g compgen tmenv mexpr + let mexpr = remapModuleOrNamespaceExprWithSig g compgen tmenv mexpr TMAbstract mexpr and remapAndRenameModBind g compgen tmenv x = @@ -5139,7 +5140,7 @@ and remapAndRenameModBind g compgen tmenv x = ModuleOrNamespaceBinding.Module(mspec, def) and remapImplFile g compgen tmenv mv = - mapAccImplFile (remapAndBindModExpr g compgen) tmenv mv + mapAccImplFile (remapAndBindModuleOrNamespaceExprWithSig g compgen) tmenv mv let copyModuleOrNamespaceType g compgen mtyp = copyAndRemapAndBindModTy g compgen Remap.Empty mtyp |> fst let copyExpr g compgen e = remapExpr g compgen Remap.Empty e @@ -7709,7 +7710,6 @@ and rewriteObjExprInterfaceImpl env (ty, overrides) = and rewriteModuleOrNamespaceExpr env x = match x with - (* | ModuleOrNamespaceExprWithSig(mty, e, m) -> ModuleOrNamespaceExprWithSig(mty, rewriteModuleOrNamespaceExpr env e, m) *) | ModuleOrNamespaceExprWithSig(mty, def, m) -> ModuleOrNamespaceExprWithSig(mty, rewriteModuleOrNamespaceDef env def, m) and rewriteModuleOrNamespaceDefs env x = List.map (rewriteModuleOrNamespaceDef env) x diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index eb3e39783a..a18f6f5f72 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -17166,7 +17166,7 @@ let TypeCheckOneImplFile let implFile = TImplFile(qualNameOfFile, scopedPragmas, implFileExprAfterSig, hasExplicitEntryPoint, isScript) - return (topAttrs, implFile, envAtEnd, cenv.createsGeneratedProvidedTypes) + return (topAttrs, implFile, implFileTypePriorToSig, envAtEnd, cenv.createsGeneratedProvidedTypes) } diff --git a/src/fsharp/TypeChecker.fsi b/src/fsharp/TypeChecker.fsi index 448ba2cd6e..045c1e8437 100644 --- a/src/fsharp/TypeChecker.fsi +++ b/src/fsharp/TypeChecker.fsi @@ -43,7 +43,7 @@ val TypeCheckOneImplFile : -> TcEnv -> Tast.ModuleOrNamespaceType option -> ParsedImplFileInput - -> Eventually + -> Eventually val TypeCheckOneSigFile : TcGlobals * NiceNameGenerator * ImportMap * CcuThunk * (unit -> bool) * ConditionalDefines * NameResolution.TcResultsSink diff --git a/src/fsharp/fsi/fsi.fs b/src/fsharp/fsi/fsi.fs index 6b662c12af..bc40ac47ac 100644 --- a/src/fsharp/fsi/fsi.fs +++ b/src/fsharp/fsi/fsi.fs @@ -1162,7 +1162,7 @@ type internal FsiDynamicCompiler // Find all new declarations the EvaluationListener try - let contents = FSharpAssemblyContents(tcGlobals, tcState.Ccu, tcImports, declaredImpls) + let contents = FSharpAssemblyContents(tcGlobals, tcState.Ccu, Some tcState.CcuSig, tcImports, declaredImpls) let contentFile = contents.ImplementationFiles.[0] // Skip the "FSI_NNNN" match contentFile.Declarations with @@ -1177,16 +1177,16 @@ type internal FsiDynamicCompiler | Item.Value vref -> let optValue = newState.ilxGenerator.LookupGeneratedValue(valuePrinter.GetEvaluationContext(newState.emEnv), vref.Deref) match optValue with - | Some (res, typ) -> Some(FsiValue(res, typ, FSharpType(tcGlobals, newState.tcState.Ccu, newState.tcImports, vref.Type))) + | Some (res, typ) -> Some(FsiValue(res, typ, FSharpType(tcGlobals, newState.tcState.Ccu, newState.tcState.CcuSig, newState.tcImports, vref.Type))) | None -> None | _ -> None - let symbol = FSharpSymbol.Create(newState.tcGlobals, newState.tcState.Ccu, newState.tcImports, v.Item) + let symbol = FSharpSymbol.Create(newState.tcGlobals, newState.tcState.Ccu, newState.tcState.CcuSig, newState.tcImports, v.Item) let symbolUse = FSharpSymbolUse(tcGlobals, newState.tcState.TcEnvFromImpls.DisplayEnv, symbol, ItemOccurence.Binding, v.DeclarationLocation) fsi.TriggerEvaluation (fsiValueOpt, symbolUse, decl) | FSharpImplementationFileDeclaration.Entity (e,_) -> // Report a top-level module or namespace definition - let symbol = FSharpSymbol.Create(newState.tcGlobals, newState.tcState.Ccu, newState.tcImports, e.Item) + let symbol = FSharpSymbol.Create(newState.tcGlobals, newState.tcState.Ccu, newState.tcState.CcuSig, newState.tcImports, e.Item) let symbolUse = FSharpSymbolUse(tcGlobals, newState.tcState.TcEnvFromImpls.DisplayEnv, symbol, ItemOccurence.Binding, e.DeclarationLocation) fsi.TriggerEvaluation (None, symbolUse, decl) | FSharpImplementationFileDeclaration.InitAction _ -> @@ -1224,7 +1224,7 @@ type internal FsiDynamicCompiler // let optValue = istate.ilxGenerator.LookupGeneratedValue(valuePrinter.GetEvaluationContext(istate.emEnv), vref.Deref); match optValue with - | Some (res, typ) -> istate, Completed(Some(FsiValue(res, typ, FSharpType(tcGlobals, istate.tcState.Ccu, istate.tcImports, vref.Type)))) + | Some (res, typ) -> istate, Completed(Some(FsiValue(res, typ, FSharpType(tcGlobals, istate.tcState.Ccu, istate.tcState.CcuSig, istate.tcImports, vref.Type)))) | _ -> istate, Completed None // Return the interactive state. @@ -1349,7 +1349,7 @@ type internal FsiDynamicCompiler } member __.CurrentPartialAssemblySignature(istate) = - FSharpAssemblySignature(istate.tcGlobals, istate.tcState.Ccu, istate.tcImports, None, istate.tcState.PartialAssemblySignature) + FSharpAssemblySignature(istate.tcGlobals, istate.tcState.Ccu, istate.tcState.CcuSig, istate.tcImports, None, istate.tcState.CcuSig) member __.FormatValue(obj:obj, objTy) = valuePrinter.FormatValue(obj, objTy) diff --git a/src/fsharp/service/IncrementalBuild.fs b/src/fsharp/service/IncrementalBuild.fs index f1977599a2..494ad478f3 100755 --- a/src/fsharp/service/IncrementalBuild.fs +++ b/src/fsharp/service/IncrementalBuild.fs @@ -1037,7 +1037,9 @@ type TypeCheckAccumulator = topAttribs:TopAttribs option /// Result of checking most recent file, if any - lastestTypedImplFile:TypedImplFile option + latestImplFile:TypedImplFile option + + latestCcuSigForFile: ModuleOrNamespaceType option tcDependencyFiles: string list @@ -1126,7 +1128,8 @@ type PartialCheckResults = TcDependencyFiles: string list TopAttribs: TopAttribs option TimeStamp: DateTime - LatestImplementationFile: TypedImplFile option } + LatestImplementationFile: TypedImplFile option + LastestCcuSigForFile: ModuleOrNamespaceType option } member x.TcErrors = Array.concat (List.rev x.TcErrorsRev) member x.TcSymbolUses = List.rev x.TcSymbolUsesRev @@ -1144,7 +1147,8 @@ type PartialCheckResults = TcDependencyFiles = tcAcc.tcDependencyFiles TopAttribs = tcAcc.topAttribs TimeStamp = timestamp - LatestImplementationFile = tcAcc.lastestTypedImplFile } + LatestImplementationFile = tcAcc.latestImplFile + LastestCcuSigForFile = tcAcc.latestCcuSigForFile } [] @@ -1350,7 +1354,8 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput tcSymbolUsesRev=[] tcOpenDeclarationsRev=[] topAttribs=None - lastestTypedImplFile=None + latestImplFile=None + latestCcuSigForFile=None tcDependencyFiles=basicDependencies tcErrorsRev = [ initialErrors ] } return tcAcc } @@ -1373,7 +1378,7 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput let sink = TcResultsSinkImpl(tcAcc.tcGlobals) let hadParseErrors = not (Array.isEmpty parseErrors) - let! (tcEnvAtEndOfFile, topAttribs, lastestTypedImplFile), tcState = + let! (tcEnvAtEndOfFile, topAttribs, implFile, ccuSigForFile), tcState = TypeCheckOneInputEventually ((fun () -> hadParseErrors || errorLogger.ErrorCount > 0), tcConfig, tcAcc.tcImports, @@ -1383,7 +1388,7 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput tcAcc.tcState, input) /// Only keep the typed interface files when doing a "full" build for fsc.exe, otherwise just throw them away - let lastestTypedImplFile = if keepAssemblyContents then lastestTypedImplFile else None + let implFile = if keepAssemblyContents then implFile else None let tcResolutions = if keepAllBackgroundResolutions then sink.GetResolutions() else TcResolutions.Empty let tcEnvAtEndOfFile = (if keepAllBackgroundResolutions then tcEnvAtEndOfFile else tcState.TcEnvFromImpls) let tcSymbolUses = sink.GetSymbolUses() @@ -1395,7 +1400,8 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput return {tcAcc with tcState=tcState tcEnvAtEndOfFile=tcEnvAtEndOfFile topAttribs=Some topAttribs - lastestTypedImplFile=lastestTypedImplFile + latestImplFile=implFile + latestCcuSigForFile=Some ccuSigForFile tcResolutionsRev=tcResolutions :: tcAcc.tcResolutionsRev tcSymbolUsesRev=tcSymbolUses :: tcAcc.tcSymbolUsesRev tcOpenDeclarationsRev = sink.GetOpenDeclarations() :: tcAcc.tcOpenDeclarationsRev @@ -1437,16 +1443,16 @@ type IncrementalBuilder(tcGlobals, frameworkTcImports, nonFrameworkAssemblyInput let finalAcc = tcStates.[tcStates.Length-1] // Finish the checking - let (_tcEnvAtEndOfLastFile, topAttrs, mimpls), tcState = - let results = tcStates |> List.ofArray |> List.map (fun acc-> acc.tcEnvAtEndOfFile, defaultArg acc.topAttribs EmptyTopAttrs, acc.lastestTypedImplFile) + let (_tcEnvAtEndOfLastFile, topAttrs, mimpls, _), tcState = + let results = tcStates |> List.ofArray |> List.map (fun acc-> acc.tcEnvAtEndOfFile, defaultArg acc.topAttribs EmptyTopAttrs, acc.latestImplFile, acc.latestCcuSigForFile) TypeCheckMultipleInputsFinish (results, finalAcc.tcState) let ilAssemRef, tcAssemblyDataOpt, tcAssemblyExprOpt = try - // TypeCheckClosedInputSetFinish fills in tcState.Ccu but in incremental scenarios we don't want this, - // so we make this temporary here - let oldContents = tcState.Ccu.Deref.Contents - try + // TypeCheckClosedInputSetFinish fills in tcState.Ccu but in incremental scenarios we don't want this, + // so we make this temporary here + let oldContents = tcState.Ccu.Deref.Contents + try let tcState, tcAssemblyExpr = TypeCheckClosedInputSetFinish (mimpls, tcState) // Compute the identity of the generated assembly based on attributes, options etc. diff --git a/src/fsharp/service/IncrementalBuild.fsi b/src/fsharp/service/IncrementalBuild.fsi index 0f41ce1054..b6b64a7ffd 100755 --- a/src/fsharp/service/IncrementalBuild.fsi +++ b/src/fsharp/service/IncrementalBuild.fsi @@ -64,7 +64,10 @@ type internal PartialCheckResults = /// Represents latest complete typechecked implementation file, including its typechecked signature if any. /// Empty for a signature file. - LatestImplementationFile: TypedImplFile option } + LatestImplementationFile: TypedImplFile option + + /// Represents latest inferred signature contents. + LastestCcuSigForFile: ModuleOrNamespaceType option} member TcErrors: (PhasedDiagnostic * FSharpErrorSeverity)[] diff --git a/src/fsharp/service/service.fs b/src/fsharp/service/service.fs index f5f4a64025..44a1d6b6a9 100755 --- a/src/fsharp/service/service.fs +++ b/src/fsharp/service/service.fs @@ -152,7 +152,7 @@ type TypeCheckInfo _sTcConfig: TcConfig, g: TcGlobals, // The signature of the assembly being checked, up to and including the current file - ccuSig: ModuleOrNamespaceType, + ccuSigForFile: ModuleOrNamespaceType, thisCcu: CcuThunk, tcImports: TcImports, tcAccessRights: AccessorDomain, @@ -939,7 +939,7 @@ type TypeCheckInfo | None -> FSharpDeclarationListInfo.Empty | Some (items, denv, ctx, m) -> let items = if isInterfaceFile then items |> List.filter (fun x -> IsValidSignatureFileItem x.Item) else items - let getAccessibility item = FSharpSymbol.GetAccessibility (FSharpSymbol.Create(g, thisCcu, tcImports, item)) + let getAccessibility item = FSharpSymbol.GetAccessibility (FSharpSymbol.Create(g, thisCcu, ccuSigForFile, tcImports, item)) let currentNamespaceOrModule = parseResultsOpt |> Option.bind (fun x -> x.ParseTree) @@ -1018,7 +1018,7 @@ type TypeCheckInfo | [] -> failwith "Unexpected empty bag" | items -> items - |> List.map (fun item -> let symbol = FSharpSymbol.Create(g, thisCcu, tcImports, item.Item) + |> List.map (fun item -> let symbol = FSharpSymbol.Create(g, thisCcu, ccuSigForFile, tcImports, item.Item) FSharpSymbolUse(g, denv, symbol, ItemOccurence.Use, m))) //end filtering @@ -1134,14 +1134,14 @@ type TypeCheckInfo | None | Some ([],_,_,_) -> None | Some (items, denv, _, m) -> let allItems = items |> List.collect (fun item -> SymbolHelpers.FlattenItems g m item.Item) - let symbols = allItems |> List.map (fun item -> FSharpSymbol.Create(g, thisCcu, tcImports, item)) + let symbols = allItems |> List.map (fun item -> FSharpSymbol.Create(g, thisCcu, ccuSigForFile, tcImports, item)) Some (symbols, denv, m) ) (fun msg -> Trace.TraceInformation(sprintf "FCS: recovering from error in GetMethodsAsSymbols: '%s'" msg) None) - member scope.GetDeclarationLocation (ctok, line, lineStr, colAtEndOfNames, names, preferFlag) = + member __.GetDeclarationLocation (ctok, line, lineStr, colAtEndOfNames, names, preferFlag) = ErrorScope.Protect Range.range0 (fun () -> match GetDeclItemsForNamesAtPosition (ctok, None,Some(names), None, None, line, lineStr, colAtEndOfNames, ResolveTypeNamesToCtors,ResolveOverloads.Yes,(fun() -> []), fun _ -> false) with @@ -1242,20 +1242,21 @@ type TypeCheckInfo Trace.TraceInformation(sprintf "FCS: recovering from error in GetDeclarationLocation: '%s'" msg) FSharpFindDeclResult.DeclNotFound (FSharpFindDeclFailureReason.Unknown msg)) - member scope.GetSymbolUseAtLocation (ctok, line, lineStr, colAtEndOfNames, names) = + member __.GetSymbolUseAtLocation (ctok, line, lineStr, colAtEndOfNames, names) = ErrorScope.Protect Range.range0 (fun () -> match GetDeclItemsForNamesAtPosition (ctok, None,Some(names), None, None, line, lineStr, colAtEndOfNames, ResolveTypeNamesToCtors, ResolveOverloads.Yes,(fun() -> []), fun _ -> false) with | None | Some ([], _, _, _) -> None | Some (item :: _, denv, _, m) -> - let symbol = FSharpSymbol.Create(g, thisCcu, tcImports, item.Item) + let symbol = FSharpSymbol.Create(g, thisCcu, ccuSigForFile, tcImports, item.Item) Some (symbol, denv, m) ) (fun msg -> Trace.TraceInformation(sprintf "FCS: recovering from error in GetSymbolUseAtLocation: '%s'" msg) None) - member scope.PartialAssemblySignature() = FSharpAssemblySignature(g, thisCcu, tcImports, None, ccuSig) + member __.PartialAssemblySignatureForFile = + FSharpAssemblySignature(g, thisCcu, ccuSigForFile, tcImports, None, ccuSigForFile) member __.AccessRights = tcAccessRights @@ -1389,7 +1390,7 @@ type TypeCheckInfo member __.TcImports = tcImports /// The inferred signature of the file - member __.CcuSig = ccuSig + member __.CcuSigForFile = ccuSigForFile /// The assembly being analyzed member __.ThisCcu = thisCcu @@ -1697,7 +1698,7 @@ module internal Parser = let sink = TcResultsSinkImpl(tcGlobals, source = source) let! ct = Async.CancellationToken - let! tcEnvAtEndOpt = + let! resOpt = async { try let checkForErrors() = (parseResults.ParseHadErrors || errHandler.ErrorCount > 0) @@ -1719,24 +1720,22 @@ module internal Parser = cancellable.Return(res) )) - return result |> Option.map (fun ((tcEnvAtEnd, _, typedImplFiles), tcState) -> tcEnvAtEnd, typedImplFiles, tcState) - with - | e -> + return result |> Option.map (fun ((tcEnvAtEnd, _, implFiles, ccuSigsForFiles), tcState) -> tcEnvAtEnd, implFiles, ccuSigsForFiles, tcState) + with e -> errorR e - return Some(tcState.TcEnvFromSignatures, [], tcState) + return Some(tcState.TcEnvFromSignatures, [], [NewEmptyModuleOrNamespaceType Namespace], tcState) } let errors = errHandler.CollectedDiagnostics - match tcEnvAtEndOpt with - | Some (tcEnvAtEnd, implFiles, tcState) -> + match resOpt with + | Some (tcEnvAtEnd, implFiles, ccuSigsForFiles, tcState) -> let scope = TypeCheckInfo(tcConfig, tcGlobals, - tcState.PartialAssemblySignature, + List.head ccuSigsForFiles, tcState.Ccu, tcImports, tcEnvAtEnd.AccessRights, - //typedImplFiles, projectFileName, mainInputFileName, sink.GetResolutions(), @@ -1807,7 +1806,8 @@ type FSharpProjectContext(thisCcu: CcuThunk, assemblies: FSharpAssembly list, ad [] // 'details' is an option because the creation of the tcGlobals etc. for the project may have failed. -type FSharpCheckProjectResults(projectFileName:string, tcConfigOption, keepAssemblyContents, errors: FSharpErrorInfo[], details:(TcGlobals*TcImports*CcuThunk*ModuleOrNamespaceType*TcSymbolUses list*TopAttribs option*CompileOps.IRawFSharpAssemblyData option * ILAssemblyRef * AccessorDomain * TypedImplFile list option * string[]) option, _reactorOps: IReactorOperations) = +type FSharpCheckProjectResults(projectFileName:string, tcConfigOption, keepAssemblyContents, errors: FSharpErrorInfo[], + details:(TcGlobals * TcImports * CcuThunk * ModuleOrNamespaceType * TcSymbolUses list * TopAttribs option * CompileOps.IRawFSharpAssemblyData option * ILAssemblyRef * AccessorDomain * TypedImplFile list option * string[]) option) = let getDetails() = match details with @@ -1825,7 +1825,7 @@ type FSharpCheckProjectResults(projectFileName:string, tcConfigOption, keepAssem member info.AssemblySignature = let (tcGlobals, tcImports, thisCcu, ccuSig, _tcSymbolUses, topAttribs, _tcAssemblyData, _ilAssemRef, _ad, _tcAssemblyExpr, _dependencyFiles) = getDetails() - FSharpAssemblySignature(tcGlobals, thisCcu, tcImports, topAttribs, ccuSig) + FSharpAssemblySignature(tcGlobals, thisCcu, ccuSig, tcImports, topAttribs, ccuSig) member info.TypedImplementionFiles = if not keepAssemblyContents then invalidOp "The 'keepAssemblyContents' flag must be set to true on the FSharpChecker in order to access the checked contents of assemblies" @@ -1836,10 +1836,22 @@ type FSharpCheckProjectResults(projectFileName:string, tcConfigOption, keepAssem | Some mimpls -> mimpls tcGlobals, thisCcu, tcImports, mimpls - member info.AssemblyContents = FSharpAssemblyContents(info.TypedImplementionFiles) + member info.AssemblyContents = + if not keepAssemblyContents then invalidOp "The 'keepAssemblyContents' flag must be set to true on the FSharpChecker in order to access the checked contents of assemblies" + let (tcGlobals, tcImports, thisCcu, ccuSig, _tcSymbolUses, _topAttribs, _tcAssemblyData, _ilAssemRef, _ad, tcAssemblyExpr, _dependencyFiles) = getDetails() + let mimpls = + match tcAssemblyExpr with + | None -> [] + | Some mimpls -> mimpls + FSharpAssemblyContents(tcGlobals, thisCcu, Some ccuSig, tcImports, mimpls) member info.GetOptimizedAssemblyContents() = - let tcGlobals, thisCcu, tcImports, mimpls = info.TypedImplementionFiles + if not keepAssemblyContents then invalidOp "The 'keepAssemblyContents' flag must be set to true on the FSharpChecker in order to access the checked contents of assemblies" + let (tcGlobals, tcImports, thisCcu, ccuSig, _tcSymbolUses, _topAttribs, _tcAssemblyData, _ilAssemRef, _ad, tcAssemblyExpr, _dependencyFiles) = getDetails() + let mimpls = + match tcAssemblyExpr with + | None -> [] + | Some mimpls -> mimpls let outfile = "" // only used if tcConfig.writeTermsToFiles is true let importMap = tcImports.GetImportMap() let optEnv0 = GetInitialOptimizationEnv (tcImports, tcGlobals) @@ -1850,7 +1862,7 @@ type FSharpCheckProjectResults(projectFileName:string, tcConfigOption, keepAssem | TypedAssemblyAfterOptimization files -> files |> List.map fst - FSharpAssemblyContents(tcGlobals, thisCcu, tcImports, mimpls) + FSharpAssemblyContents(tcGlobals, thisCcu, Some ccuSig, tcImports, mimpls) // Not, this does not have to be a SyncOp, it can be called from any thread member info.GetUsesOfSymbol(symbol:FSharpSymbol) = @@ -1865,32 +1877,32 @@ type FSharpCheckProjectResults(projectFileName:string, tcConfigOption, keepAssem |> async.Return // Not, this does not have to be a SyncOp, it can be called from any thread - member info.GetAllUsesOfAllSymbols() = - let (tcGlobals, tcImports, thisCcu, _ccuSig, tcSymbolUses, _topAttribs, _tcAssemblyData, _ilAssemRef, _ad, _tcAssemblyExpr, _dependencyFiles) = getDetails() + member __.GetAllUsesOfAllSymbols() = + let (tcGlobals, tcImports, thisCcu, ccuSig, tcSymbolUses, _topAttribs, _tcAssemblyData, _ilAssemRef, _ad, _tcAssemblyExpr, _dependencyFiles) = getDetails() [| for r in tcSymbolUses do for symbolUse in r.AllUsesOfSymbols do if symbolUse.ItemOccurence <> ItemOccurence.RelatedText then - let symbol = FSharpSymbol.Create(tcGlobals, thisCcu, tcImports, symbolUse.Item) + let symbol = FSharpSymbol.Create(tcGlobals, thisCcu, ccuSig, tcImports, symbolUse.Item) yield FSharpSymbolUse(tcGlobals, symbolUse.DisplayEnv, symbol, symbolUse.ItemOccurence, symbolUse.Range) |] |> async.Return - member info.ProjectContext = + member __.ProjectContext = let (tcGlobals, tcImports, thisCcu, _ccuSig, _tcSymbolUses, _topAttribs, _tcAssemblyData, _ilAssemRef, ad, _tcAssemblyExpr, _dependencyFiles) = getDetails() let assemblies = [ for x in tcImports.GetImportedAssemblies() do yield FSharpAssembly(tcGlobals, tcImports, x.FSharpViewOfMetadata) ] FSharpProjectContext(thisCcu, assemblies, ad) - member info.RawFSharpAssemblyData = + member __.RawFSharpAssemblyData = let (_tcGlobals, _tcImports, _thisCcu, _ccuSig, _tcSymbolUses, _topAttribs, tcAssemblyData, _ilAssemRef, _ad, _tcAssemblyExpr, _dependencyFiles) = getDetails() tcAssemblyData - member info.DependencyFiles = + member __.DependencyFiles = let (_tcGlobals, _tcImports, _thisCcu, _ccuSig, _tcSymbolUses, _topAttribs, _tcAssemblyData, _ilAssemRef, _ad, _tcAssemblyExpr, dependencyFiles) = getDetails() dependencyFiles - member info.AssemblyFullName = + member __.AssemblyFullName = let (_tcGlobals, _tcImports, _thisCcu, _ccuSig, _tcSymbolUses, _topAttribs, _tcAssemblyData, ilAssemRef, _ad, _tcAssemblyExpr, _dependencyFiles) = getDetails() ilAssemRef.QualifiedName @@ -2029,33 +2041,33 @@ type FSharpCheckFileResults(filename: string, errors: FSharpErrorInfo[], scopeOp member info.GetFormatSpecifierLocationsAndArity() = threadSafeOp - (fun () -> [| |]) - (fun scope -> - // This operation is not asynchronous - GetFormatSpecifierLocationsAndArity can be run on the calling thread - scope.GetFormatSpecifierLocationsAndArity()) + (fun () -> [| |]) + (fun scope -> + // This operation is not asynchronous - GetFormatSpecifierLocationsAndArity can be run on the calling thread + scope.GetFormatSpecifierLocationsAndArity()) - member info.GetSemanticClassification(range: range option) = + member __.GetSemanticClassification(range: range option) = threadSafeOp - (fun () -> [| |]) - (fun scope -> - // This operation is not asynchronous - GetSemanticClassification can be run on the calling thread - scope.GetSemanticClassification(range)) + (fun () -> [| |]) + (fun scope -> + // This operation is not asynchronous - GetSemanticClassification can be run on the calling thread + scope.GetSemanticClassification(range)) - member info.PartialAssemblySignature = + member __.PartialAssemblySignature = threadSafeOp (fun () -> failwith "not available") (fun scope -> - // This operation is not asynchronous - PartialAssemblySignature can be run on the calling thread - scope.PartialAssemblySignature()) + // This operation is not asynchronous - PartialAssemblySignature can be run on the calling thread + scope.PartialAssemblySignatureForFile) - member info.ProjectContext = + member __.ProjectContext = threadSafeOp (fun () -> failwith "not available") (fun scope -> // This operation is not asynchronous - GetReferencedAssemblies can be run on the calling thread FSharpProjectContext(scope.ThisCcu, scope.GetReferencedAssemblies(), scope.AccessRights)) - member info.DependencyFiles = dependencyFiles + member __.DependencyFiles = dependencyFiles member info.GetAllUsesOfAllSymbolsInFile() = threadSafeOp @@ -2063,7 +2075,7 @@ type FSharpCheckFileResults(filename: string, errors: FSharpErrorInfo[], scopeOp (fun scope -> [| for symbolUse in scope.ScopeSymbolUses.AllUsesOfSymbols do if symbolUse.ItemOccurence <> ItemOccurence.RelatedText then - let symbol = FSharpSymbol.Create(scope.TcGlobals, scope.ThisCcu, scope.TcImports, symbolUse.Item) + let symbol = FSharpSymbol.Create(scope.TcGlobals, scope.ThisCcu, scope.CcuSigForFile, scope.TcImports, symbolUse.Item) yield FSharpSymbolUse(scope.TcGlobals, symbolUse.DisplayEnv, symbol, symbolUse.ItemOccurence, symbolUse.Range) |]) |> async.Return @@ -2098,21 +2110,15 @@ type FSharpCheckFileResults(filename: string, errors: FSharpErrorInfo[], scopeOp if not keepAssemblyContents then invalidOp "The 'keepAssemblyContents' flag must be set to true on the FSharpChecker in order to access the checked contents of assemblies" scopeOptX |> Option.map (fun scope -> - let cenv = Impl.cenv(scope.TcGlobals, scope.ThisCcu, scope.TcImports) + let cenv = SymbolEnv(scope.TcGlobals, scope.ThisCcu, Some scope.CcuSigForFile, scope.TcImports) scope.ImplementationFile |> Option.map (fun implFile -> FSharpImplementationFileContents(cenv, implFile))) |> Option.defaultValue None member info.OpenDeclarations = scopeOptX |> Option.map (fun scope -> - let cenv = Impl.cenv(scope.TcGlobals, scope.ThisCcu, scope.TcImports) - scope.OpenDeclarations |> Array.map (fun x -> - { LongId = x.LongId - Range = x.Range - Modules = x.Modules |> List.map (fun x -> FSharpEntity(cenv, x)) - AppliedScope = x.AppliedScope - IsOwnNamespace = x.IsOwnNamespace } - : FSharpOpenDeclaration )) + let cenv = SymbolEnv(scope.TcGlobals, scope.ThisCcu, Some scope.CcuSigForFile, scope.TcImports) + scope.OpenDeclarations |> Array.map (fun x -> FSharpOpenDeclaration(x.LongId, x.Range, (x.Modules |> List.map (fun x -> FSharpEntity(cenv, x))), x.AppliedScope, x.IsOwnNamespace))) |> Option.defaultValue [| |] override info.ToString() = "FSharpCheckFileResults(" + filename + ")" @@ -2701,7 +2707,9 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC let parseResults = FSharpParseFileResults(errors = untypedErrors, input = parseTreeOpt, parseHadErrors = false, dependencyFiles = builder.AllDependenciesDeprecated) let loadClosure = scriptClosureCacheLock.AcquireLock (fun ltok -> scriptClosureCache.TryGet (ltok, options) ) let scope = - TypeCheckInfo(tcProj.TcConfig, tcProj.TcGlobals, tcProj.TcState.PartialAssemblySignature, tcProj.TcState.Ccu, tcProj.TcImports, tcProj.TcEnvAtEnd.AccessRights, + TypeCheckInfo(tcProj.TcConfig, tcProj.TcGlobals, + Option.get tcProj.LastestCcuSigForFile, + tcProj.TcState.Ccu, tcProj.TcImports, tcProj.TcEnvAtEnd.AccessRights, options.ProjectFileName, filename, List.head tcProj.TcResolutionsRev, List.head tcProj.TcSymbolUsesRev, @@ -2731,13 +2739,16 @@ type BackgroundCompiler(legacyReferenceResolver, projectCacheSize, keepAssemblyC use _unwind = decrement match builderOpt with | None -> - return FSharpCheckProjectResults (options.ProjectFileName, None, keepAssemblyContents, creationErrors, None, reactorOps) + return FSharpCheckProjectResults (options.ProjectFileName, None, keepAssemblyContents, creationErrors, None) | Some builder -> let! (tcProj, ilAssemRef, tcAssemblyDataOpt, tcAssemblyExprOpt) = builder.GetCheckResultsAndImplementationsForProject(ctok) let errorOptions = tcProj.TcConfig.errorSeverityOptions let fileName = TcGlobals.DummyFileNameForRangesWithoutASpecificLocation let errors = [| yield! creationErrors; yield! ErrorHelpers.CreateErrorInfos (errorOptions, true, fileName, tcProj.TcErrors) |] - return FSharpCheckProjectResults (options.ProjectFileName, Some tcProj.TcConfig, keepAssemblyContents, errors, Some(tcProj.TcGlobals, tcProj.TcImports, tcProj.TcState.Ccu, tcProj.TcState.PartialAssemblySignature, tcProj.TcSymbolUses, tcProj.TopAttribs, tcAssemblyDataOpt, ilAssemRef, tcProj.TcEnvAtEnd.AccessRights, tcAssemblyExprOpt, Array.ofList tcProj.TcDependencyFiles), reactorOps) + return FSharpCheckProjectResults (options.ProjectFileName, Some tcProj.TcConfig, keepAssemblyContents, errors, + Some(tcProj.TcGlobals, tcProj.TcImports, tcProj.TcState.Ccu, tcProj.TcState.CcuSig, + tcProj.TcSymbolUses, tcProj.TopAttribs, tcAssemblyDataOpt, ilAssemRef, + tcProj.TcEnvAtEnd.AccessRights, tcAssemblyExprOpt, Array.ofList tcProj.TcDependencyFiles)) } /// Get the timestamp that would be on the output if fully built immediately @@ -3267,10 +3278,14 @@ type FsiInteractiveChecker(legacyReferenceResolver, reactorOps: IReactorOperatio return match tcFileResult with - | Parser.TypeCheckAborted.No scope -> + | Parser.TypeCheckAborted.No tcFileInfo -> let errors = [| yield! parseErrors; yield! tcErrors |] - let typeCheckResults = FSharpCheckFileResults (filename, errors, Some scope, dependencyFiles, None, reactorOps, false) - let projectResults = FSharpCheckProjectResults (filename, Some tcConfig, keepAssemblyContents, errors, Some(tcGlobals, tcImports, scope.ThisCcu, scope.CcuSig, [scope.ScopeSymbolUses], None, None, mkSimpleAssRef "stdin", tcState.TcEnvFromImpls.AccessRights, None, dependencyFiles), reactorOps) + let typeCheckResults = FSharpCheckFileResults (filename, errors, Some tcFileInfo, dependencyFiles, None, reactorOps, false) + let projectResults = + FSharpCheckProjectResults (filename, Some tcConfig, keepAssemblyContents, errors, + Some(tcGlobals, tcImports, tcFileInfo.ThisCcu, tcFileInfo.CcuSigForFile, + [tcFileInfo.ScopeSymbolUses], None, None, mkSimpleAssRef "stdin", + tcState.TcEnvFromImpls.AccessRights, None, dependencyFiles)) parseResults, typeCheckResults, projectResults | _ -> failwith "unexpected aborted" diff --git a/src/fsharp/symbols/Exprs.fs b/src/fsharp/symbols/Exprs.fs index d818cf956a..ecbcea1019 100644 --- a/src/fsharp/symbols/Exprs.fs +++ b/src/fsharp/symbols/Exprs.fs @@ -268,7 +268,7 @@ module FSharpExprConvert = | DT_REF -> None | _ -> None - let (|TTypeConvOp|_|) (cenv:Impl.cenv) ty = + let (|TTypeConvOp|_|) (cenv:SymbolEnv) ty = let g = cenv.g match ty with | TType_app (tcref,_) -> @@ -291,14 +291,14 @@ module FSharpExprConvert = let ConvType cenv typ = FSharpType(cenv, typ) let ConvTypes cenv typs = List.map (ConvType cenv) typs - let ConvILTypeRefApp (cenv:Impl.cenv) m tref tyargs = + let ConvILTypeRefApp (cenv:SymbolEnv) m tref tyargs = let tcref = Import.ImportILTypeRef cenv.amap m tref ConvType cenv (mkAppTy tcref tyargs) let ConvUnionCaseRef cenv (ucref:UnionCaseRef) = FSharpUnionCase(cenv, ucref) let ConvRecdFieldRef cenv (rfref:RecdFieldRef) = FSharpField(cenv, rfref ) - let rec exprOfExprAddr (cenv:Impl.cenv) expr = + let rec exprOfExprAddr (cenv:SymbolEnv) expr = match expr with | Expr.Op(op, tyargs, args, m) -> match op, args, tyargs with @@ -323,7 +323,7 @@ module FSharpExprConvert = let Mk2 cenv (orig:Expr) e = FSharpExpr(cenv, None, e, orig.Range, tyOfExpr cenv.g orig) - let rec ConvLValueExpr (cenv:Impl.cenv) env expr = ConvExpr cenv env (exprOfExprAddr cenv expr) + let rec ConvLValueExpr (cenv:SymbolEnv) env expr = ConvExpr cenv env (exprOfExprAddr cenv expr) and ConvExpr cenv env expr = Mk2 cenv expr (ConvExprPrim cenv env expr) @@ -391,7 +391,7 @@ module FSharpExprConvert = /// A nasty function copied from creflect.fs. Made nastier by taking a continuation to process the /// arguments to the call in a tail-recursive fashion. - and ConvModuleValueOrMemberUseLinear (cenv:Impl.cenv) env (expr:Expr, vref, vFlags, tyargs, curriedArgs) contf = + and ConvModuleValueOrMemberUseLinear (cenv:SymbolEnv) env (expr:Expr, vref, vFlags, tyargs, curriedArgs) contf = let m = expr.Range let (numEnclTypeArgs, _, isNewObj, _valUseFlags, _isSelfInit, takesInstanceArg, _isPropGet, _isPropSet) = @@ -462,7 +462,7 @@ module FSharpExprConvert = // tailcall ConvObjectModelCallLinear cenv env (false, v, [], tyargs, List.concat untupledCurriedArgs) contf2 - and ConvExprPrim (cenv:Impl.cenv) (env:ExprTranslationEnv) expr = + and ConvExprPrim (cenv:SymbolEnv) (env:ExprTranslationEnv) expr = // Eliminate integer 'for' loops let expr = DetectAndOptimizeForExpression cenv.g OptimizeIntRangesOnly expr @@ -854,7 +854,7 @@ module FSharpExprConvert = let envinner = env.BindVal v Some(vR, rhsR), envinner - and ConvILCall (cenv:Impl.cenv) env (isNewObj, valUseFlags, ilMethRef, enclTypeArgs, methTypeArgs, callArgs, m) = + and ConvILCall (cenv:SymbolEnv) env (isNewObj, valUseFlags, ilMethRef, enclTypeArgs, methTypeArgs, callArgs, m) = let isNewObj = (isNewObj || (match valUseFlags with CtorValUsedAsSuperInit | CtorValUsedAsSelfInit -> true | _ -> false)) let methName = ilMethRef.Name let isPropGet = methName.StartsWith("get_", System.StringComparison.Ordinal) @@ -1210,9 +1210,9 @@ module FSharpExprConvert = /// The contents of the F# assembly as provided through the compiler API -type FSharpAssemblyContents(cenv: Impl.cenv, mimpls: TypedImplFile list) = +type FSharpAssemblyContents(cenv: SymbolEnv, mimpls: TypedImplFile list) = - new (g, thisCcu, tcImports, mimpls) = FSharpAssemblyContents(Impl.cenv(g, thisCcu, tcImports), mimpls) + new (g, thisCcu, thisCcuType, tcImports, mimpls) = FSharpAssemblyContents(SymbolEnv(g, thisCcu, thisCcuType, tcImports), mimpls) member __.ImplementationFiles = [ for mimpl in mimpls -> FSharpImplementationFileContents(cenv, mimpl)] @@ -1223,7 +1223,7 @@ and FSharpImplementationFileDeclaration = | InitAction of FSharpExpr and FSharpImplementationFileContents(cenv, mimpl) = - let (TImplFile(qname, _pragmas, ModuleOrNamespaceExprWithSig(_mty, mdef, _), hasExplicitEntryPoint, isScript)) = mimpl + let (TImplFile(qname, _pragmas, ModuleOrNamespaceExprWithSig(_, mdef, _), hasExplicitEntryPoint, isScript)) = mimpl let rec getDecls2 (ModuleOrNamespaceExprWithSig(_mty, def, _m)) = getDecls def and getBind (bind: Binding) = let v = bind.Var diff --git a/src/fsharp/symbols/Exprs.fsi b/src/fsharp/symbols/Exprs.fsi index 7e0e17ac8d..c9049b33c1 100644 --- a/src/fsharp/symbols/Exprs.fsi +++ b/src/fsharp/symbols/Exprs.fsi @@ -12,14 +12,14 @@ open Microsoft.FSharp.Compiler.CompileOps /// Represents the definitional contents of an assembly, as seen by the F# language type public FSharpAssemblyContents = - internal new : tcGlobals: TcGlobals * thisCcu: CcuThunk * tcImports: TcImports * mimpls: TypedImplFile list -> FSharpAssemblyContents + internal new : tcGlobals: TcGlobals * thisCcu: CcuThunk * thisCcuType: ModuleOrNamespaceType option * tcImports: TcImports * mimpls: TypedImplFile list -> FSharpAssemblyContents /// The contents of the implementation files in the assembly member ImplementationFiles: FSharpImplementationFileContents list /// Represents the definitional contents of a single file or fragment in an assembly, as seen by the F# language and [] public FSharpImplementationFileContents = - internal new : cenv: Impl.cenv * mimpl: TypedImplFile -> FSharpImplementationFileContents + internal new : cenv: SymbolEnv * mimpl: TypedImplFile -> FSharpImplementationFileContents /// The qualified name acts to fully-qualify module specifications and implementations member QualifiedName: string diff --git a/src/fsharp/symbols/Symbols.fs b/src/fsharp/symbols/Symbols.fs index a21b26650b..f24fed090a 100755 --- a/src/fsharp/symbols/Symbols.fs +++ b/src/fsharp/symbols/Symbols.fs @@ -49,6 +49,16 @@ type FSharpAccessibility(a:Accessibility, ?isProtected) = let mangledTextOfCompPath (CompPath(scoref, path)) = getNameOfScopeRef scoref + "/" + textOfPath (List.map fst path) String.concat ";" (List.map mangledTextOfCompPath paths) +type SymbolEnv(g:TcGlobals, thisCcu: CcuThunk, thisCcuTyp: ModuleOrNamespaceType option, tcImports: TcImports) = + let amapV = tcImports.GetImportMap() + let infoReaderV = InfoReader(g, amapV) + member __.g = g + member __.amap = amapV + member __.thisCcu = thisCcu + member __.thisCcuTyp = thisCcuTyp + member __.infoReader = infoReaderV + member __.tcImports = tcImports + [] module Impl = let protect f = @@ -58,7 +68,7 @@ module Impl = let makeReadOnlyCollection (arr: seq<'T>) = System.Collections.ObjectModel.ReadOnlyCollection<_>(Seq.toArray arr) :> IList<_> - + let makeXmlDoc (XmlDoc x) = makeReadOnlyCollection (x) let rescopeEntity optViewedCcu (entity: Entity) = @@ -166,16 +176,7 @@ module Impl = | None -> None - type cenv(g:TcGlobals, thisCcu: CcuThunk , tcImports: TcImports) = - let amapV = tcImports.GetImportMap() - let infoReaderV = InfoReader(g, amapV) - member __.g = g - member __.amap = amapV - member __.thisCcu = thisCcu - member __.infoReader = infoReaderV - member __.tcImports = tcImports - - let getXmlDocSigForEntity (cenv: cenv) (ent:EntityRef)= + let getXmlDocSigForEntity (cenv: SymbolEnv) (ent:EntityRef)= match SymbolHelpers.GetXmlDocSigOfEntityRef cenv.infoReader ent.Range ent with | Some (_, docsig) -> docsig | _ -> "" @@ -186,7 +187,7 @@ type FSharpDisplayContext(denv: TcGlobals -> DisplayEnv) = // delay the realization of 'item' in case it is unresolved -type FSharpSymbol(cenv:cenv, item: (unit -> Item), access: (FSharpSymbol -> CcuThunk -> AccessorDomain -> bool)) = +type FSharpSymbol(cenv: SymbolEnv, item: (unit -> Item), access: (FSharpSymbol -> CcuThunk -> AccessorDomain -> bool)) = member x.Assembly = let ccu = defaultArg (SymbolHelpers.ccuOfItem cenv.g x.Item) cenv.thisCcu @@ -207,6 +208,8 @@ type FSharpSymbol(cenv:cenv, item: (unit -> Item), access: (FSharpSymbol -> CcuT member x.IsEffectivelySameAs(y:FSharpSymbol) = x.Equals(y) || ItemsAreEffectivelyEqual cenv.g x.Item y.Item + member x.GetEffectivelySameAsHash() = ItemsAreEffectivelyEqualHash cenv.g x.Item + member internal x.Item = item() member x.DisplayName = item().DisplayName @@ -221,12 +224,90 @@ type FSharpSymbol(cenv:cenv, item: (unit -> Item), access: (FSharpSymbol -> CcuT override x.GetHashCode() = hash x.ImplementationLocation - member x.GetEffectivelySameAsHash() = ItemsAreEffectivelyEqualHash cenv.g x.Item - override x.ToString() = "symbol " + (try item().DisplayName with _ -> "?") + // TODO: there are several cases where we may need to report more interesting + // symbol information below. By default we return a vanilla symbol. + static member Create(g, thisCcu, thisCcuType, tcImports, item): FSharpSymbol = + FSharpSymbol.Create (SymbolEnv(g, thisCcu, Some thisCcuType, tcImports), item) + + static member Create(cenv, item): FSharpSymbol = + let dflt() = FSharpSymbol(cenv, (fun () -> item), (fun _ _ _ -> true)) + match item with + | Item.Value v -> FSharpMemberOrFunctionOrValue(cenv, V v, item) :> _ + | Item.UnionCase (uinfo, _) -> FSharpUnionCase(cenv, uinfo.UnionCaseRef) :> _ + | Item.ExnCase tcref -> FSharpEntity(cenv, tcref) :>_ + | Item.RecdField rfinfo -> FSharpField(cenv, RecdOrClass rfinfo.RecdFieldRef) :> _ + + | Item.ILField finfo -> FSharpField(cenv, ILField finfo) :> _ + + | Item.Event einfo -> + FSharpMemberOrFunctionOrValue(cenv, E einfo, item) :> _ + + | Item.Property(_, pinfo :: _) -> + FSharpMemberOrFunctionOrValue(cenv, P pinfo, item) :> _ + + | Item.MethodGroup(_, minfo :: _, _) -> + FSharpMemberOrFunctionOrValue(cenv, M minfo, item) :> _ + + | Item.CtorGroup(_, cinfo :: _) -> + FSharpMemberOrFunctionOrValue(cenv, C cinfo, item) :> _ + + | Item.DelegateCtor (AbbrevOrAppTy tcref) -> + FSharpEntity(cenv, tcref) :>_ + + | Item.UnqualifiedType(tcref :: _) + | Item.Types(_, AbbrevOrAppTy tcref :: _) -> + FSharpEntity(cenv, tcref) :>_ + + | Item.ModuleOrNamespaces(modref :: _) -> + FSharpEntity(cenv, modref) :> _ + + | Item.SetterArg (_id, item) -> FSharpSymbol.Create(cenv, item) + + | Item.CustomOperation (_customOpName, _, Some minfo) -> + FSharpMemberOrFunctionOrValue(cenv, M minfo, item) :> _ + + | Item.CustomBuilder (_, vref) -> + FSharpMemberOrFunctionOrValue(cenv, V vref, item) :> _ + + | Item.TypeVar (_, tp) -> + FSharpGenericParameter(cenv, tp) :> _ + + | Item.ActivePatternCase apref -> + FSharpActivePatternCase(cenv, apref.ActivePatternInfo, apref.ActivePatternVal.Type, apref.CaseIndex, Some apref.ActivePatternVal, item) :> _ + + | Item.ActivePatternResult (apinfo, typ, n, _) -> + FSharpActivePatternCase(cenv, apinfo, typ, n, None, item) :> _ + + | Item.ArgName(id, ty, _) -> + FSharpParameter(cenv, ty, {Attribs=[]; Name=Some id}, Some id.idRange, isParamArrayArg=false, isOutArg=false, isOptionalArg=false) :> _ -and FSharpEntity(cenv:cenv, entity:EntityRef) = + // TODO: the following don't currently return any interesting subtype + | Item.ImplicitOp _ + | Item.ILField _ + | Item.FakeInterfaceCtor _ + | Item.NewDef _ -> dflt() + // These cases cover unreachable cases + | Item.CustomOperation (_, _, None) + | Item.UnqualifiedType [] + | Item.ModuleOrNamespaces [] + | Item.Property (_, []) + | Item.MethodGroup (_, [], _) + | Item.CtorGroup (_, []) + // These cases cover misc. corned cases (non-symbol types) + | Item.Types _ + | Item.DelegateCtor _ -> dflt() + + static member GetAccessibility (symbol: FSharpSymbol) = + match symbol with + | :? FSharpEntity as x -> Some x.Accessibility + | :? FSharpField as x -> Some x.Accessibility + | :? FSharpUnionCase as x -> Some x.Accessibility + | :? FSharpMemberFunctionOrValue as x -> Some x.Accessibility + | _ -> None + +and FSharpEntity(cenv: SymbolEnv, entity:EntityRef) = inherit FSharpSymbol(cenv, (fun () -> checkEntityIsResolved(entity); @@ -276,6 +357,21 @@ and FSharpEntity(cenv:cenv, entity:EntityRef) = | Some (CompPath(_, [])) -> "global" | Some cp -> buildAccessPath (Some cp) + member x.DeclaringEntity = + match entity.CompilationPathOpt with + | None -> None + | Some (CompPath(_, [])) -> None + | Some cp -> + match x.Assembly.Contents.FindEntityByPath cp.MangledPath with + | Some res -> Some res + | None -> + // The declaring entity may be in this assembly, including a type possibly hidden by a signature. + match cenv.thisCcuTyp with + | Some t -> + let s = FSharpAssemblySignature(cenv, None, None, t) + s.FindEntityByPath cp.MangledPath + | None -> None + member __.Namespace = checkIsResolved() match entity.CompilationPathOpt with @@ -730,7 +826,7 @@ and FSharpFieldData = | Union (v, _) -> v.TyconRef | ILField f -> f.DeclaringTyconRef -and FSharpField(cenv: cenv, d: FSharpFieldData) = +and FSharpField(cenv: SymbolEnv, d: FSharpFieldData) = inherit FSharpSymbol (cenv, (fun () -> match d with @@ -769,6 +865,7 @@ and FSharpField(cenv: cenv, d: FSharpFieldData) = | ILField _ -> () new (cenv, ucref, n) = FSharpField(cenv, FSharpFieldData.Union(ucref, n)) + new (cenv, rfref) = FSharpField(cenv, FSharpFieldData.RecdOrClass(rfref)) member __.DeclaringEntity = @@ -891,6 +988,7 @@ and FSharpField(cenv: cenv, d: FSharpFieldData) = FSharpAccessibility(access) member private x.V = d + override x.Equals(other: obj) = box x === other || match other with @@ -902,14 +1000,15 @@ and FSharpField(cenv: cenv, d: FSharpFieldData) = | _ -> false override x.GetHashCode() = hash x.Name + override x.ToString() = "field " + x.Name and [] FSharpRecordField = FSharpField and [] FSharpAccessibilityRights(thisCcu: CcuThunk, ad:AccessorDomain) = member internal __.ThisCcu = thisCcu - member internal __.Contents = ad + member internal __.Contents = ad and FSharpActivePatternCase(cenv, apinfo: PrettyNaming.ActivePatternInfo, typ, n, valOpt: ValRef option, item) = @@ -960,13 +1059,19 @@ and FSharpGenericParameter(cenv, v:Typar) = inherit FSharpSymbol (cenv, (fun () -> Item.TypeVar(v.Name, v)), (fun _ _ _ad -> true)) + member __.Name = v.DisplayName + member __.DeclarationLocation = v.Range + member __.IsCompilerGenerated = v.IsCompilerGenerated member __.IsMeasure = (v.Kind = TyparKind.Measure) + member __.XmlDoc = v.typar_xmldoc |> makeXmlDoc + member __.IsSolveAtCompileTime = (v.StaticReq = TyparStaticReq.HeadTypeStaticReq) + member __.Attributes = // INCOMPLETENESS: If the type parameter comes from .NET then the .NET metadata for the type parameter // has been lost (it is not accessible via Typar). So we can't easily report the attributes in this @@ -1509,9 +1614,9 @@ and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = | M m | C m -> m.IsInstance | V v -> v.IsInstanceMember - member v.IsInstanceMemberInCompiledCode = + member x.IsInstanceMemberInCompiledCode = if isUnresolved() then false else - v.IsInstanceMember && + x.IsInstanceMember && match d with | E e -> match e.ArbitraryValRef with Some vref -> ValRefIsCompiledAsInstanceMember cenv.g vref | None -> true | P p -> match p.ArbitraryValRef with Some vref -> ValRefIsCompiledAsInstanceMember cenv.g vref | None -> true @@ -1527,7 +1632,8 @@ and FSharpMemberOrFunctionOrValue(cenv, d:FSharpMemberOrValData, item) = | V v -> v.IsExtensionMember | C _ -> false - member this.IsOverrideOrExplicitMember = this.IsOverrideOrExplicitInterfaceImplementation + member x.IsOverrideOrExplicitMember = x.IsOverrideOrExplicitInterfaceImplementation + member __.IsOverrideOrExplicitInterfaceImplementation = if isUnresolved() then false else match d with @@ -1863,7 +1969,7 @@ and FSharpType(cenv, typ:TType) = let isResolved() = not (isUnresolved()) - new (g, thisCcu, tcImports, typ) = FSharpType(cenv(g, thisCcu, tcImports), typ) + new (g, thisCcu, thisCcuTyp, tcImports, typ) = FSharpType(SymbolEnv(g, thisCcu, Some thisCcuTyp, tcImports), typ) member __.IsUnresolved = isUnresolved() @@ -2045,7 +2151,7 @@ and FSharpType(cenv, typ:TType) = let ps = (xs, prettyTyps) ||> List.map2 (List.map2 (fun p pty -> p.AdjustType(pty))) |> List.map makeReadOnlyCollection |> makeReadOnlyCollection ps, returnParameter.AdjustType(prettyRetTy) -and FSharpAttribute(cenv: cenv, attrib: AttribInfo) = +and FSharpAttribute(cenv: SymbolEnv, attrib: AttribInfo) = let rec resolveArgObj (arg: obj) = match arg with @@ -2128,16 +2234,26 @@ and FSharpParameter(cenv, typ:TType, topArgInfo:ArgReprInfo, mOpt, isParamArrayA let attribs = topArgInfo.Attribs let idOpt = topArgInfo.Name let m = match mOpt with Some m -> m | None -> range0 + member __.Name = match idOpt with None -> None | Some v -> Some v.idText - member __.cenv: cenv = cenv + + member __.cenv: SymbolEnv = cenv + member __.AdjustType(t) = FSharpParameter(cenv, t, topArgInfo, mOpt, isParamArrayArg, isOutArg, isOptionalArg) + member __.Type: FSharpType = FSharpType(cenv, typ) + member __.V = typ + member __.DeclarationLocation = match idOpt with None -> m | Some v -> v.idRange + member __.Attributes = attribs |> List.map (fun a -> FSharpAttribute(cenv, AttribInfo.FSAttribInfo(cenv.g, a))) |> makeReadOnlyCollection + member __.IsParamArrayArg = isParamArrayArg + member __.IsOutArg = isOutArg + member __.IsOptionalArg = isOptionalArg member private x.ValReprInfo = topArgInfo @@ -2149,16 +2265,20 @@ and FSharpParameter(cenv, typ:TType, topArgInfo:ArgReprInfo, mOpt, isParamArrayA | _ -> false override x.GetHashCode() = hash (box topArgInfo) + override x.ToString() = "parameter " + (match x.Name with None -> " s) -and FSharpAssemblySignature private (cenv, topAttribs: TypeChecker.TopAttribs option, optViewedCcu: CcuThunk option, mtyp: ModuleOrNamespaceType) = +and FSharpAssemblySignature (cenv, topAttribs: TypeChecker.TopAttribs option, optViewedCcu: CcuThunk option, mtyp: ModuleOrNamespaceType) = // Assembly signature for a referenced/linked assembly - new (cenv, ccu: CcuThunk) = FSharpAssemblySignature((if ccu.IsUnresolvedReference then cenv else (new cenv(cenv.g, ccu, cenv.tcImports))), None, Some ccu, ccu.Contents.ModuleOrNamespaceType) + new (cenv: SymbolEnv, ccu: CcuThunk) = + let cenv = if ccu.IsUnresolvedReference then cenv else SymbolEnv(cenv.g, ccu, None, cenv.tcImports) + FSharpAssemblySignature(cenv, None, Some ccu, ccu.Contents.ModuleOrNamespaceType) // Assembly signature for an assembly produced via type-checking. - new (g, thisCcu, tcImports, topAttribs, mtyp) = FSharpAssemblySignature(cenv(g, thisCcu, tcImports), topAttribs, None, mtyp) + new (g, thisCcu, thisCcuTyp, tcImports, topAttribs, mtyp) = + FSharpAssemblySignature(SymbolEnv(g, thisCcu, Some thisCcuTyp, tcImports), topAttribs, None, mtyp) member __.Entities = @@ -2194,14 +2314,15 @@ and FSharpAssemblySignature private (cenv, topAttribs: TypeChecker.TopAttribs op |> makeReadOnlyCollection member __.FindEntityByPath path = - let inline findNested name = function - | Some (e: Entity) when e.IsModuleOrNamespace -> - e.ModuleOrNamespaceType.AllEntitiesByCompiledAndLogicalMangledNames.TryFind name + let findNested name entity = + match entity with + | Some (e: Entity) ->e.ModuleOrNamespaceType.AllEntitiesByCompiledAndLogicalMangledNames.TryFind name | _ -> None match path with | hd :: tl -> - List.fold (fun a x -> findNested x a) (mtyp.AllEntitiesByCompiledAndLogicalMangledNames.TryFind hd) tl + (mtyp.AllEntitiesByCompiledAndLogicalMangledNames.TryFind hd, tl) + ||> List.fold (fun a x -> findNested x a) |> Option.map (fun e -> FSharpEntity(cenv, rescopeEntity optViewedCcu e)) | _ -> None @@ -2209,120 +2330,60 @@ and FSharpAssemblySignature private (cenv, topAttribs: TypeChecker.TopAttribs op and FSharpAssembly internal (cenv, ccu: CcuThunk) = - new (g, tcImports, ccu) = FSharpAssembly(cenv(g, ccu, tcImports), ccu) + new (g, tcImports, ccu: CcuThunk) = + FSharpAssembly(SymbolEnv(g, ccu, None, tcImports), ccu) member __.RawCcuThunk = ccu - member __.QualifiedName = match ccu.QualifiedName with None -> "" | Some s -> s - member __.CodeLocation = ccu.SourceCodeDirectory - member __.FileName = ccu.FileName - member __.SimpleName = ccu.AssemblyName - #if !NO_EXTENSIONTYPING - member __.IsProviderGenerated = ccu.IsProviderGenerated - #endif - member __.Contents = FSharpAssemblySignature(cenv, ccu) - - override x.ToString() = x.QualifiedName -type FSharpSymbol with - // TODO: there are several cases where we may need to report more interesting - // symbol information below. By default we return a vanilla symbol. - static member Create(g, thisCcu, tcImports, item): FSharpSymbol = - FSharpSymbol.Create (cenv(g, thisCcu, tcImports), item) - - static member Create(cenv, item): FSharpSymbol = - let dflt() = FSharpSymbol(cenv, (fun () -> item), (fun _ _ _ -> true)) - match item with - | Item.Value v -> FSharpMemberOrFunctionOrValue(cenv, V v, item) :> _ - | Item.UnionCase (uinfo, _) -> FSharpUnionCase(cenv, uinfo.UnionCaseRef) :> _ - | Item.ExnCase tcref -> FSharpEntity(cenv, tcref) :>_ - | Item.RecdField rfinfo -> FSharpField(cenv, RecdOrClass rfinfo.RecdFieldRef) :> _ - - | Item.ILField finfo -> FSharpField(cenv, ILField finfo) :> _ - - | Item.Event einfo -> - FSharpMemberOrFunctionOrValue(cenv, E einfo, item) :> _ - - | Item.Property(_, pinfo :: _) -> - FSharpMemberOrFunctionOrValue(cenv, P pinfo, item) :> _ - - | Item.MethodGroup(_, minfo :: _, _) -> - FSharpMemberOrFunctionOrValue(cenv, M minfo, item) :> _ - - | Item.CtorGroup(_, cinfo :: _) -> - FSharpMemberOrFunctionOrValue(cenv, C cinfo, item) :> _ - - | Item.DelegateCtor (AbbrevOrAppTy tcref) -> - FSharpEntity(cenv, tcref) :>_ - - | Item.UnqualifiedType(tcref :: _) - | Item.Types(_, AbbrevOrAppTy tcref :: _) -> - FSharpEntity(cenv, tcref) :>_ + member __.QualifiedName = match ccu.QualifiedName with None -> "" | Some s -> s - | Item.ModuleOrNamespaces(modref :: _) -> - FSharpEntity(cenv, modref) :> _ + member __.CodeLocation = ccu.SourceCodeDirectory - | Item.SetterArg (_id, item) -> FSharpSymbol.Create(cenv, item) + member __.FileName = ccu.FileName - | Item.CustomOperation (_customOpName, _, Some minfo) -> - FSharpMemberOrFunctionOrValue(cenv, M minfo, item) :> _ + member __.SimpleName = ccu.AssemblyName - | Item.CustomBuilder (_, vref) -> - FSharpMemberOrFunctionOrValue(cenv, V vref, item) :> _ +#if !NO_EXTENSIONTYPING + member __.IsProviderGenerated = ccu.IsProviderGenerated +#endif - | Item.TypeVar (_, tp) -> - FSharpGenericParameter(cenv, tp) :> _ + member __.Contents : FSharpAssemblySignature = FSharpAssemblySignature(cenv, ccu) + + override x.ToString() = ccu.ILScopeRef.QualifiedName - | Item.ActivePatternCase apref -> - FSharpActivePatternCase(cenv, apref.ActivePatternInfo, apref.ActivePatternVal.Type, apref.CaseIndex, Some apref.ActivePatternVal, item) :> _ +/// Represents open declaration in F# code. +[] +type FSharpOpenDeclaration(longId: Ident list, range: range option, modules: FSharpEntity list, appliedScope: range, isOwnNamespace: bool) = - | Item.ActivePatternResult (apinfo, typ, n, _) -> - FSharpActivePatternCase(cenv, apinfo, typ, n, None, item) :> _ + member __.LongId = longId - | Item.ArgName(id, ty, _) -> - FSharpParameter(cenv, ty, {Attribs=[]; Name=Some id}, Some id.idRange, isParamArrayArg=false, isOutArg=false, isOptionalArg=false) :> _ + member __.Range = range - // TODO: the following don't currently return any interesting subtype - | Item.ImplicitOp _ - | Item.ILField _ - | Item.FakeInterfaceCtor _ - | Item.NewDef _ -> dflt() - // These cases cover unreachable cases - | Item.CustomOperation (_, _, None) - | Item.UnqualifiedType [] - | Item.ModuleOrNamespaces [] - | Item.Property (_, []) - | Item.MethodGroup (_, [], _) - | Item.CtorGroup (_, []) - // These cases cover misc. corned cases (non-symbol types) - | Item.Types _ - | Item.DelegateCtor _ -> dflt() + member __.Modules = modules - static member GetAccessibility (symbol: FSharpSymbol) = - match symbol with - | :? FSharpEntity as x -> Some x.Accessibility - | :? FSharpField as x -> Some x.Accessibility - | :? FSharpUnionCase as x -> Some x.Accessibility - | :? FSharpMemberFunctionOrValue as x -> Some x.Accessibility - | _ -> None + member __.AppliedScope = appliedScope -/// Represents open declaration in F# code. -type FSharpOpenDeclaration = - { LongId: Ident list - Range: range option - Modules: FSharpEntity list - AppliedScope: range - IsOwnNamespace: bool } + member __.IsOwnNamespace = isOwnNamespace [] type FSharpSymbolUse(g:TcGlobals, denv: DisplayEnv, symbol:FSharpSymbol, itemOcc, range: range) = + member __.Symbol = symbol + member __.DisplayContext = FSharpDisplayContext(fun _ -> denv) + member x.IsDefinition = x.IsFromDefinition + member __.IsFromDefinition = itemOcc = ItemOccurence.Binding + member __.IsFromPattern = itemOcc = ItemOccurence.Pattern + member __.IsFromType = itemOcc = ItemOccurence.UseInType + member __.IsFromAttribute = itemOcc = ItemOccurence.UseInAttribute + member __.IsFromDispatchSlotImplementation = itemOcc = ItemOccurence.Implemented + member __.IsFromComputationExpression = match symbol.Item, itemOcc with // 'seq' in 'seq { ... }' gets colored as keywords @@ -2330,9 +2391,13 @@ type FSharpSymbolUse(g:TcGlobals, denv: DisplayEnv, symbol:FSharpSymbol, itemOcc // custom builders, custom operations get colored as keywords | (Item.CustomBuilder _ | Item.CustomOperation _), ItemOccurence.Use -> true | _ -> false + member __.IsFromOpenStatement = itemOcc = ItemOccurence.Open + member __.FileName = range.FileName + member __.Range = Range.toZ range + member __.RangeAlternate = range override __.ToString() = sprintf "%O, %O, %O" symbol itemOcc range diff --git a/src/fsharp/symbols/Symbols.fsi b/src/fsharp/symbols/Symbols.fsi index 730c60e79e..a6cf492c4d 100644 --- a/src/fsharp/symbols/Symbols.fsi +++ b/src/fsharp/symbols/Symbols.fsi @@ -13,11 +13,10 @@ open Microsoft.FSharp.Compiler.TcGlobals open Microsoft.FSharp.Compiler.NameResolution // Implementation details used by other code in the compiler -module internal Impl = - type internal cenv = - new : TcGlobals * thisCcu:CcuThunk * tcImports: TcImports -> cenv - member amap: Import.ImportMap - member g: TcGlobals +type internal SymbolEnv = + new : TcGlobals * thisCcu:CcuThunk * thisCcuTyp: ModuleOrNamespaceType option * tcImports: TcImports -> SymbolEnv + member amap: Import.ImportMap + member g: TcGlobals /// Indicates the accessibility of a symbol, as seen by the F# language type public FSharpAccessibility = @@ -52,7 +51,7 @@ type [] public FSharpDisplayContext = /// or FSharpActivePatternCase. type [] public FSharpSymbol = /// Internal use only. - static member internal Create : g:TcGlobals * thisCcu: CcuThunk * tcImports: TcImports * item:NameResolution.Item -> FSharpSymbol + static member internal Create : g:TcGlobals * thisCcu: CcuThunk * thisCcuTyp: ModuleOrNamespaceType * tcImports: TcImports * item:NameResolution.Item -> FSharpSymbol /// Computes if the symbol is accessible for the given accessibility rights member IsAccessible: FSharpAccessibilityRights -> bool @@ -121,7 +120,7 @@ and [] public FSharpAssembly = /// Represents an inferred signature of part of an assembly as seen by the F# language and [] public FSharpAssemblySignature = - internal new : tcGlobals: TcGlobals * thisCcu: CcuThunk * tcImports: TcImports * topAttribs: TypeChecker.TopAttribs option * contents: ModuleOrNamespaceType -> FSharpAssemblySignature + internal new : tcGlobals: TcGlobals * thisCcu: CcuThunk * thisCcuTyp: ModuleOrNamespaceType * tcImports: TcImports * topAttribs: TypeChecker.TopAttribs option * contents: ModuleOrNamespaceType -> FSharpAssemblySignature /// The (non-nested) module and type definitions in this signature member Entities: IList @@ -138,11 +137,11 @@ and [] public FSharpAssemblySignature = and [] public FSharpEntity = inherit FSharpSymbol - internal new : Impl.cenv * EntityRef -> FSharpEntity - - // /// Return the FSharpEntity corresponding to a .NET type - // static member FromType : System.Type -> FSharpEntity + internal new : SymbolEnv * EntityRef -> FSharpEntity + /// Get the enclosing entity for the definition + member DeclaringEntity : FSharpEntity option + /// Get the name of the type or module, possibly with `n mangling member LogicalName: string @@ -344,7 +343,7 @@ and [] public FSharpAbstractParameter = /// Represents the signature of an abstract slot of a class or interface and [] public FSharpAbstractSignature = - internal new : Impl.cenv * SlotSig -> FSharpAbstractSignature + internal new : SymbolEnv * SlotSig -> FSharpAbstractSignature /// Get the arguments of the abstract slot member AbstractArguments : IList> @@ -367,7 +366,7 @@ and [] public FSharpAbstractSignature = /// A subtype of FSharpSymbol that represents a union case as seen by the F# language and [] public FSharpUnionCase = inherit FSharpSymbol - internal new : Impl.cenv * UnionCaseRef -> FSharpUnionCase + internal new : SymbolEnv * UnionCaseRef -> FSharpUnionCase /// Get the name of the union case member Name: string @@ -405,8 +404,8 @@ and [] public FSharpUnionCase = and [] public FSharpField = inherit FSharpSymbol - internal new : Impl.cenv * RecdFieldRef -> FSharpField - internal new : Impl.cenv * UnionCaseRef * int -> FSharpField + internal new : SymbolEnv * RecdFieldRef -> FSharpField + internal new : SymbolEnv * UnionCaseRef * int -> FSharpField /// Get the declaring entity of this field member DeclaringEntity: FSharpEntity @@ -472,7 +471,7 @@ and [] public FSharpAccessibilityRights = and [] public FSharpGenericParameter = inherit FSharpSymbol - internal new : Impl.cenv * Typar -> FSharpGenericParameter + internal new : SymbolEnv * Typar -> FSharpGenericParameter /// Get the name of the generic parameter member Name: string @@ -642,8 +641,8 @@ and [] public FSharpInlineAnnotation = and [] public FSharpMemberOrFunctionOrValue = inherit FSharpSymbol - internal new : Impl.cenv * ValRef -> FSharpMemberOrFunctionOrValue - internal new : Impl.cenv * Infos.MethInfo -> FSharpMemberOrFunctionOrValue + internal new : SymbolEnv * ValRef -> FSharpMemberOrFunctionOrValue + internal new : SymbolEnv * Infos.MethInfo -> FSharpMemberOrFunctionOrValue /// Indicates if the member, function or value is in an unresolved assembly member IsUnresolved : bool @@ -896,8 +895,8 @@ and [] public FSharpActivePatternGroup = and [] public FSharpType = /// Internal use only. Create a ground type. - internal new : g:TcGlobals * thisCcu: CcuThunk * tcImports: TcImports * typ:TType -> FSharpType - internal new : Impl.cenv * typ:TType -> FSharpType + internal new : g:TcGlobals * thisCcu: CcuThunk * thisCcuTyp: ModuleOrNamespaceType * tcImports: TcImports * typ:TType -> FSharpType + internal new : SymbolEnv * typ:TType -> FSharpType /// Indicates this is a named type in an unresolved assembly member IsUnresolved : bool @@ -996,21 +995,25 @@ and [] public FSharpAttribute = member Format : context: FSharpDisplayContext -> string /// Represents open declaration in F# code. +[] type public FSharpOpenDeclaration = - { /// Idents. - LongId: Ident list + + internal new : longId: Ident list * range: range option * modules: FSharpEntity list * appliedScope: range * isOwnNamespace: bool -> FSharpOpenDeclaration + + /// Idents. + member LongId: Ident list - /// Range of the open declaration. - Range: range option + /// Range of the open declaration. + member Range: range option - /// Modules or namespaces which is opened with this declaration. - Modules: FSharpEntity list + /// Modules or namespaces which is opened with this declaration. + member Modules: FSharpEntity list - /// Scope in which open declaration is visible. - AppliedScope: range + /// Scope in which open declaration is visible. + member AppliedScope: range - /// If it's `namespace Xxx.Yyy` declaration. - IsOwnNamespace: bool } + /// If it's `namespace Xxx.Yyy` declaration. + member IsOwnNamespace: bool /// Represents the use of an F# symbol from F# source code [] diff --git a/src/fsharp/tast.fs b/src/fsharp/tast.fs index cca16b60a4..186eab895c 100755 --- a/src/fsharp/tast.fs +++ b/src/fsharp/tast.fs @@ -398,7 +398,6 @@ assert (sizeof = 8) assert (sizeof = 4) #endif - let unassignedTyparName = "?" exception UndefinedName of int * (* error func that expects identifier name *)(string -> string) * Ident * ErrorLogger.Suggestions @@ -425,6 +424,24 @@ type ModuleOrNamespaceKind = +let getNameOfScopeRef sref = + match sref with + | ILScopeRef.Local -> "" + | ILScopeRef.Module mref -> mref.Name + | ILScopeRef.Assembly aref -> aref.Name + +#if !NO_EXTENSIONTYPING +let ComputeDefinitionLocationOfProvidedItem (p : Tainted<#IProvidedCustomAttributeProvider>) = + let attrs = p.PUntaintNoFailure(fun x -> x.GetDefinitionLocationAttribute(p.TypeProvider.PUntaintNoFailure(id))) + match attrs with + | None | Some (null, _, _) -> None + | Some (filePath, line, column) -> + // Coordinates from type provider are 1-based for lines and columns + // Coordinates internally in the F# compiler are 1-based for lines and 0-based for columns + let pos = Range.mkPos line (max 0 (column - 1)) + Range.mkRange filePath pos pos |> Some + +#endif /// A public path records where a construct lives within the global namespace /// of a CCU. @@ -465,26 +482,6 @@ type CompilationPath = -let getNameOfScopeRef sref = - match sref with - | ILScopeRef.Local -> "" - | ILScopeRef.Module mref -> mref.Name - | ILScopeRef.Assembly aref -> aref.Name - - -#if !NO_EXTENSIONTYPING -let ComputeDefinitionLocationOfProvidedItem (p : Tainted<#IProvidedCustomAttributeProvider>) = - let attrs = p.PUntaintNoFailure(fun x -> x.GetDefinitionLocationAttribute(p.TypeProvider.PUntaintNoFailure(id))) - match attrs with - | None | Some (null, _, _) -> None - | Some (filePath, line, column) -> - // Coordinates from type provider are 1-based for lines and columns - // Coordinates internally in the F# compiler are 1-based for lines and 0-based for columns - let pos = Range.mkPos line (max 0 (column - 1)) - Range.mkRange filePath pos pos |> Some - -#endif - type EntityOptionalData = { /// The name of the type, possibly with `n mangling @@ -524,6 +521,9 @@ type EntityOptionalData = mutable entity_exn_info: ExceptionInfo } + override x.ToString() = "EntityOptionalData(...)" + + and /// Represents a type definition, exception definition, module definition or namespace definition. [] Entity = @@ -950,8 +950,6 @@ and /// Represents a type definition, exception definition, module definition or /// Indicates if the entity is linked to backing data. Only used during unpickling of F# metadata. member x.IsLinked = match box x.entity_attribs with null -> false | _ -> true - override x.ToString() = x.LogicalName - /// Get the blob of information associated with an F# object-model type definition, i.e. class, interface, struct etc. member x.FSharpObjectModelTypeInfo = match x.TypeReprInfo with @@ -1161,19 +1159,24 @@ and /// Represents a type definition, exception definition, module definition or /// Sets the structness of a record or union type definition member x.SetIsStructRecordOrUnion b = let flags = x.entity_flags in x.entity_flags <- EntityFlags(flags.IsPrefixDisplay, flags.IsModuleOrNamespace, flags.PreEstablishedHasDefaultConstructor, flags.HasSelfReferentialConstructor, b) + override x.ToString() = x.LogicalName + and [] MaybeLazy<'T> = | Strict of 'T | Lazy of Lazy<'T> + member this.Value : 'T = match this with | Strict x -> x | Lazy x -> x.Value + member this.Force() : 'T = match this with | Strict x -> x | Lazy x -> x.Force() and EntityData = Entity + and ParentRef = | Parent of EntityRef | ParentNone @@ -1244,6 +1247,9 @@ and tcaug_interfaces=[] tcaug_closed=false tcaug_abstract=false } + + override x.ToString() = "TyconAugmentation(...)" + and [] /// The information for the contents of a type. Also used for a provided namespace. @@ -1289,10 +1295,16 @@ and /// The information for exception definitions should be folded into here. | TNoRepr + override x.ToString() = "TyconRepresentation(...)" + and [] /// TILObjectReprData(scope, nesting, definition) - TILObjectReprData = TILObjectReprData of ILScopeRef * ILTypeDef list * ILTypeDef + TILObjectReprData = + | TILObjectReprData of ILScopeRef * ILTypeDef list * ILTypeDef + + override x.ToString() = "TILObjectReprData(...)" + #if !NO_EXTENSIONTYPING and @@ -1300,51 +1312,55 @@ and /// The information kept about a provided type TProvidedTypeInfo = - { /// The parameters given to the provider that provided to this type. - ResolutionEnvironment : ExtensionTyping.ResolutionEnvironment + { /// The parameters given to the provider that provided to this type. + ResolutionEnvironment : ExtensionTyping.ResolutionEnvironment + + /// The underlying System.Type (wrapped as a ProvidedType to make sure we don't call random things on + /// System.Type, and wrapped as Tainted to make sure we track which provider this came from, for reporting + /// error messages) + ProvidedType: Tainted - /// The underlying System.Type (wrapped as a ProvidedType to make sure we don't call random things on - /// System.Type, and wrapped as Tainted to make sure we track which provider this came from, for reporting - /// error messages) - ProvidedType: Tainted + /// The base type of the type. We use it to compute the compiled representation of the type for erased types. + /// Reading is delayed, since it does an import on the underlying type + LazyBaseType: LazyWithContext - /// The base type of the type. We use it to compute the compiled representation of the type for erased types. - /// Reading is delayed, since it does an import on the underlying type - LazyBaseType: LazyWithContext + /// A flag read eagerly from the provided type and used to compute basic properties of the type definition. + IsClass: bool - /// A flag read eagerly from the provided type and used to compute basic properties of the type definition. - IsClass: bool + /// A flag read eagerly from the provided type and used to compute basic properties of the type definition. + IsSealed: bool - /// A flag read eagerly from the provided type and used to compute basic properties of the type definition. - IsSealed: bool + /// A flag read eagerly from the provided type and used to compute basic properties of the type definition. + IsInterface: bool - /// A flag read eagerly from the provided type and used to compute basic properties of the type definition. - IsInterface: bool - /// A flag read eagerly from the provided type and used to compute basic properties of the type definition. - IsStructOrEnum: bool + /// A flag read eagerly from the provided type and used to compute basic properties of the type definition. + IsStructOrEnum: bool - /// A flag read eagerly from the provided type and used to compute basic properties of the type definition. - IsEnum: bool + /// A flag read eagerly from the provided type and used to compute basic properties of the type definition. + IsEnum: bool - /// A type read from the provided type and used to compute basic properties of the type definition. - /// Reading is delayed, since it does an import on the underlying type - UnderlyingTypeOfEnum: (unit -> TType) + /// A type read from the provided type and used to compute basic properties of the type definition. + /// Reading is delayed, since it does an import on the underlying type + UnderlyingTypeOfEnum: (unit -> TType) - /// A flag read from the provided type and used to compute basic properties of the type definition. - /// Reading is delayed, since it looks at the .BaseType - IsDelegate: (unit -> bool) + /// A flag read from the provided type and used to compute basic properties of the type definition. + /// Reading is delayed, since it looks at the .BaseType + IsDelegate: (unit -> bool) - /// Indicates the type is erased - IsErased: bool + /// Indicates the type is erased + IsErased: bool - /// Indicates the type is generated, but type-relocation is suppressed - IsSuppressRelocate : bool } + /// Indicates the type is generated, but type-relocation is suppressed + IsSuppressRelocate : bool } - member info.IsGenerated = not info.IsErased - member info.BaseTypeForErased (m,objTy) = + member info.IsGenerated = not info.IsErased + + member info.BaseTypeForErased (m,objTy) = if info.IsErased then info.LazyBaseType.Force (m,objTy) else assert false; failwith "expect erased type" + override x.ToString() = "TProvidedTypeInfo(...)" + #endif and @@ -1381,6 +1397,8 @@ and /// The fields of the class, struct or enum fsobjmodel_rfields: TyconRecdFields } + override x.ToString() = "TyconObjModelData(...)" + and [] TyconRecdFields = @@ -1395,10 +1413,15 @@ and else failwith "FieldByIndex" member x.FieldByName n = x.FieldsByName.TryFind(n) + member x.AllFieldsAsList = x.FieldsByIndex |> Array.toList + member x.TrueFieldsAsList = x.AllFieldsAsList |> List.filter (fun f -> not f.IsCompilerGenerated) + member x.TrueInstanceFieldsAsList = x.AllFieldsAsList |> List.filter (fun f -> not f.IsStatic && not f.IsCompilerGenerated) + override x.ToString() = "TyconRecdFields(...)" + and [] TyconUnionCases = @@ -1413,6 +1436,8 @@ and member x.UnionCasesAsList = x.CasesByIndex |> Array.toList + override x.ToString() = "TyconUnionCases(...)" + and [] TyconUnionData = @@ -1421,8 +1446,11 @@ and /// The ILX data structure representing the discriminated union. CompiledRepresentation: IlxUnionRef cache } + member x.UnionCasesAsList = x.CasesTable.CasesByIndex |> Array.toList + override x.ToString() = "TyconUnionData(...)" + and [] [] @@ -1470,11 +1498,17 @@ and | _ -> uc.Range member uc.DisplayName = uc.Id.idText + member uc.RecdFieldsArray = uc.FieldTable.FieldsByIndex + member uc.RecdFields = uc.FieldTable.FieldsByIndex |> Array.toList + member uc.GetFieldByName nm = uc.FieldTable.FieldByName nm + member uc.IsNullary = (uc.FieldTable.FieldsByIndex.Length = 0) + override x.ToString() = "UnionCase(" + x.DisplayName + ")" + and /// This may represent a "field" in either a struct, class, record or union /// It is normally compiled to a property. @@ -1590,6 +1624,8 @@ and | Some Const.Zero -> true | _ -> false + override x.ToString() = "RecdField(" + x.Name + ")" + and ExceptionInfo = /// Indicates that an exception is an abbreviation for the given exception | TExnAbbrevRepr of TyconRef @@ -1603,177 +1639,178 @@ and ExceptionInfo = /// Indicates that an exception is abstract, i.e. is in a signature file, and we do not know the representation | TExnNone -and - [] - ModuleOrNamespaceType(kind: ModuleOrNamespaceKind, vals: QueueList, entities: QueueList) = + override x.ToString() = "ExceptionInfo(...)" - /// Mutation used during compilation of FSharp.Core.dll - let mutable entities = entities +and [] ModuleOrNamespaceType(kind: ModuleOrNamespaceKind, vals: QueueList, entities: QueueList) = + + /// Mutation used during compilation of FSharp.Core.dll + let mutable entities = entities - // Lookup tables keyed the way various clients expect them to be keyed. - // We attach them here so we don't need to store lookup tables via any other technique. - // - // The type option ref is used because there are a few functions that treat these as first class values. - // We should probably change to 'mutable'. - // - // We do not need to lock this mutable state this it is only ever accessed from the compiler thread. - let activePatternElemRefCache : NameMap option ref = ref None - let modulesByDemangledNameCache : NameMap option ref = ref None - let exconsByDemangledNameCache : NameMap option ref = ref None - let tyconsByDemangledNameAndArityCache: LayeredMap option ref = ref None - let tyconsByAccessNamesCache : LayeredMultiMap option ref = ref None - let tyconsByMangledNameCache : NameMap option ref = ref None - let allEntitiesByMangledNameCache : NameMap option ref = ref None - let allValsAndMembersByPartialLinkageKeyCache : MultiMap option ref = ref None - let allValsByLogicalNameCache : NameMap option ref = ref None + // Lookup tables keyed the way various clients expect them to be keyed. + // We attach them here so we don't need to store lookup tables via any other technique. + // + // The type option ref is used because there are a few functions that treat these as first class values. + // We should probably change to 'mutable'. + // + // We do not need to lock this mutable state this it is only ever accessed from the compiler thread. + let activePatternElemRefCache : NameMap option ref = ref None + let modulesByDemangledNameCache : NameMap option ref = ref None + let exconsByDemangledNameCache : NameMap option ref = ref None + let tyconsByDemangledNameAndArityCache: LayeredMap option ref = ref None + let tyconsByAccessNamesCache : LayeredMultiMap option ref = ref None + let tyconsByMangledNameCache : NameMap option ref = ref None + let allEntitiesByMangledNameCache : NameMap option ref = ref None + let allValsAndMembersByPartialLinkageKeyCache : MultiMap option ref = ref None + let allValsByLogicalNameCache : NameMap option ref = ref None - /// Namespace or module-compiled-as-type? - member mtyp.ModuleOrNamespaceKind = kind + /// Namespace or module-compiled-as-type? + member mtyp.ModuleOrNamespaceKind = kind - /// Values, including members in F# types in this module-or-namespace-fragment. - member mtyp.AllValsAndMembers = vals + /// Values, including members in F# types in this module-or-namespace-fragment. + member mtyp.AllValsAndMembers = vals - /// Type, mapping mangled name to Tycon, e.g. - //// "Dictionary`2" --> Tycon - //// "ListModule" --> Tycon with module info - //// "FooException" --> Tycon with exception info - member mtyp.AllEntities = entities + /// Type, mapping mangled name to Tycon, e.g. + //// "Dictionary`2" --> Tycon + //// "ListModule" --> Tycon with module info + //// "FooException" --> Tycon with exception info + member mtyp.AllEntities = entities - /// Mutation used during compilation of FSharp.Core.dll - member mtyp.AddModuleOrNamespaceByMutation(modul:ModuleOrNamespace) = - entities <- QueueList.appendOne entities modul - modulesByDemangledNameCache := None - allEntitiesByMangledNameCache := None + /// Mutation used during compilation of FSharp.Core.dll + member mtyp.AddModuleOrNamespaceByMutation(modul:ModuleOrNamespace) = + entities <- QueueList.appendOne entities modul + modulesByDemangledNameCache := None + allEntitiesByMangledNameCache := None #if !NO_EXTENSIONTYPING - /// Mutation used in hosting scenarios to hold the hosted types in this module or namespace - member mtyp.AddProvidedTypeEntity(entity:Entity) = - entities <- QueueList.appendOne entities entity - tyconsByMangledNameCache := None - tyconsByDemangledNameAndArityCache := None - tyconsByAccessNamesCache := None - allEntitiesByMangledNameCache := None + /// Mutation used in hosting scenarios to hold the hosted types in this module or namespace + member mtyp.AddProvidedTypeEntity(entity:Entity) = + entities <- QueueList.appendOne entities entity + tyconsByMangledNameCache := None + tyconsByDemangledNameAndArityCache := None + tyconsByAccessNamesCache := None + allEntitiesByMangledNameCache := None #endif - /// Return a new module or namespace type with an entity added. - member mtyp.AddEntity(tycon:Tycon) = - ModuleOrNamespaceType(kind, vals, entities.AppendOne tycon) + /// Return a new module or namespace type with an entity added. + member mtyp.AddEntity(tycon:Tycon) = + ModuleOrNamespaceType(kind, vals, entities.AppendOne tycon) - /// Return a new module or namespace type with a value added. - member mtyp.AddVal(vspec:Val) = - ModuleOrNamespaceType(kind, vals.AppendOne vspec, entities) + /// Return a new module or namespace type with a value added. + member mtyp.AddVal(vspec:Val) = + ModuleOrNamespaceType(kind, vals.AppendOne vspec, entities) - /// Get a table of the active patterns defined in this module. - member mtyp.ActivePatternElemRefLookupTable = activePatternElemRefCache + /// Get a table of the active patterns defined in this module. + member mtyp.ActivePatternElemRefLookupTable = activePatternElemRefCache - /// Get a list of types defined within this module, namespace or type. - member mtyp.TypeDefinitions = entities |> Seq.filter (fun x -> not x.IsExceptionDecl && not x.IsModuleOrNamespace) |> Seq.toList + /// Get a list of types defined within this module, namespace or type. + member mtyp.TypeDefinitions = entities |> Seq.filter (fun x -> not x.IsExceptionDecl && not x.IsModuleOrNamespace) |> Seq.toList - /// Get a list of F# exception definitions defined within this module, namespace or type. - member mtyp.ExceptionDefinitions = entities |> Seq.filter (fun x -> x.IsExceptionDecl) |> Seq.toList + /// Get a list of F# exception definitions defined within this module, namespace or type. + member mtyp.ExceptionDefinitions = entities |> Seq.filter (fun x -> x.IsExceptionDecl) |> Seq.toList - /// Get a list of module and namespace definitions defined within this module, namespace or type. - member mtyp.ModuleAndNamespaceDefinitions = entities |> Seq.filter (fun x -> x.IsModuleOrNamespace) |> Seq.toList + /// Get a list of module and namespace definitions defined within this module, namespace or type. + member mtyp.ModuleAndNamespaceDefinitions = entities |> Seq.filter (fun x -> x.IsModuleOrNamespace) |> Seq.toList - /// Get a list of type and exception definitions defined within this module, namespace or type. - member mtyp.TypeAndExceptionDefinitions = entities |> Seq.filter (fun x -> not x.IsModuleOrNamespace) |> Seq.toList + /// Get a list of type and exception definitions defined within this module, namespace or type. + member mtyp.TypeAndExceptionDefinitions = entities |> Seq.filter (fun x -> not x.IsModuleOrNamespace) |> Seq.toList - /// Get a table of types defined within this module, namespace or type. The - /// table is indexed by both name and generic arity. This means that for generic - /// types "List`1", the entry (List,1) will be present. - member mtyp.TypesByDemangledNameAndArity m = + /// Get a table of types defined within this module, namespace or type. The + /// table is indexed by both name and generic arity. This means that for generic + /// types "List`1", the entry (List,1) will be present. + member mtyp.TypesByDemangledNameAndArity m = cacheOptRef tyconsByDemangledNameAndArityCache (fun () -> LayeredMap.Empty.AddAndMarkAsCollapsible( mtyp.TypeAndExceptionDefinitions |> List.map (fun (tc:Tycon) -> KeyTyconByDemangledNameAndArity tc.LogicalName (tc.Typars m) tc) |> List.toArray)) - /// Get a table of types defined within this module, namespace or type. The - /// table is indexed by both name and, for generic types, also by mangled name. - member mtyp.TypesByAccessNames = - cacheOptRef tyconsByAccessNamesCache (fun () -> + /// Get a table of types defined within this module, namespace or type. The + /// table is indexed by both name and, for generic types, also by mangled name. + member mtyp.TypesByAccessNames = + cacheOptRef tyconsByAccessNamesCache (fun () -> LayeredMultiMap.Empty.AddAndMarkAsCollapsible (mtyp.TypeAndExceptionDefinitions |> List.toArray |> Array.collect (fun (tc:Tycon) -> KeyTyconByAccessNames tc.LogicalName tc))) - // REVIEW: we can remove this lookup and use AllEntitiedByMangledName instead? - member mtyp.TypesByMangledName = - let addTyconByMangledName (x:Tycon) tab = NameMap.add x.LogicalName x tab - cacheOptRef tyconsByMangledNameCache (fun () -> + // REVIEW: we can remove this lookup and use AllEntitiedByMangledName instead? + member mtyp.TypesByMangledName = + let addTyconByMangledName (x:Tycon) tab = NameMap.add x.LogicalName x tab + cacheOptRef tyconsByMangledNameCache (fun () -> List.foldBack addTyconByMangledName mtyp.TypeAndExceptionDefinitions Map.empty) - /// Get a table of entities indexed by both logical and compiled names - member mtyp.AllEntitiesByCompiledAndLogicalMangledNames : NameMap = - let addEntityByMangledName (x:Entity) tab = - let name1 = x.LogicalName - let name2 = x.CompiledName - let tab = NameMap.add name1 x tab - if name1 = name2 then tab - else NameMap.add name2 x tab + /// Get a table of entities indexed by both logical and compiled names + member mtyp.AllEntitiesByCompiledAndLogicalMangledNames : NameMap = + let addEntityByMangledName (x:Entity) tab = + let name1 = x.LogicalName + let name2 = x.CompiledName + let tab = NameMap.add name1 x tab + if name1 = name2 then tab + else NameMap.add name2 x tab - cacheOptRef allEntitiesByMangledNameCache (fun () -> + cacheOptRef allEntitiesByMangledNameCache (fun () -> QueueList.foldBack addEntityByMangledName entities Map.empty) - /// Get a table of entities indexed by both logical name - member mtyp.AllEntitiesByLogicalMangledName : NameMap = - let addEntityByMangledName (x:Entity) tab = NameMap.add x.LogicalName x tab - QueueList.foldBack addEntityByMangledName entities Map.empty - - /// Get a table of values and members indexed by partial linkage key, which includes name, the mangled name of the parent type (if any), - /// and the method argument count (if any). - member mtyp.AllValsAndMembersByPartialLinkageKey = - let addValByMangledName (x:Val) tab = - if x.IsCompiledAsTopLevel then - MultiMap.add x.LinkagePartialKey x tab - else - tab - cacheOptRef allValsAndMembersByPartialLinkageKeyCache (fun () -> + /// Get a table of entities indexed by both logical name + member mtyp.AllEntitiesByLogicalMangledName : NameMap = + let addEntityByMangledName (x:Entity) tab = NameMap.add x.LogicalName x tab + QueueList.foldBack addEntityByMangledName entities Map.empty + + /// Get a table of values and members indexed by partial linkage key, which includes name, the mangled name of the parent type (if any), + /// and the method argument count (if any). + member mtyp.AllValsAndMembersByPartialLinkageKey = + let addValByMangledName (x:Val) tab = + if x.IsCompiledAsTopLevel then + MultiMap.add x.LinkagePartialKey x tab + else + tab + cacheOptRef allValsAndMembersByPartialLinkageKeyCache (fun () -> QueueList.foldBack addValByMangledName vals MultiMap.empty) - /// Try to find the member with the given linkage key in the given module. - member mtyp.TryLinkVal(ccu:CcuThunk,key:ValLinkageFullKey) = - mtyp.AllValsAndMembersByPartialLinkageKey - |> MultiMap.find key.PartialKey - |> List.tryFind (fun v -> match key.TypeForLinkage with - | None -> true - | Some keyTy -> ccu.MemberSignatureEquality(keyTy,v.Type)) - |> ValueOption.ofOption - - /// Get a table of values indexed by logical name - member mtyp.AllValsByLogicalName = - let addValByName (x:Val) tab = - // Note: names may occur twice prior to raising errors about this in PostTypeCheckSemanticChecks - // Earlier ones take precedence since we report errors about the later ones - if not x.IsMember && not x.IsCompilerGenerated then - NameMap.add x.LogicalName x tab - else - tab - cacheOptRef allValsByLogicalNameCache (fun () -> - QueueList.foldBack addValByName vals Map.empty) - - /// Compute a table of values and members indexed by logical name. - member mtyp.AllValsAndMembersByLogicalNameUncached = - let addValByName (x:Val) tab = - if not x.IsCompilerGenerated then - MultiMap.add x.LogicalName x tab - else - tab - QueueList.foldBack addValByName vals MultiMap.empty - - /// Get a table of F# exception definitions indexed by demangled name, so 'FailureException' is indexed by 'Failure' - member mtyp.ExceptionDefinitionsByDemangledName = - let add (tycon:Tycon) acc = NameMap.add tycon.LogicalName tycon acc - cacheOptRef exconsByDemangledNameCache (fun () -> - List.foldBack add mtyp.ExceptionDefinitions Map.empty) - - /// Get a table of nested module and namespace fragments indexed by demangled name (so 'ListModule' becomes 'List') - member mtyp.ModulesAndNamespacesByDemangledName = - let add (entity:Entity) acc = - if entity.IsModuleOrNamespace then - NameMap.add entity.DemangledModuleOrNamespaceName entity acc - else acc - cacheOptRef modulesByDemangledNameCache (fun () -> - QueueList.foldBack add entities Map.empty) + /// Try to find the member with the given linkage key in the given module. + member mtyp.TryLinkVal(ccu:CcuThunk,key:ValLinkageFullKey) = + mtyp.AllValsAndMembersByPartialLinkageKey + |> MultiMap.find key.PartialKey + |> List.tryFind (fun v -> match key.TypeForLinkage with + | None -> true + | Some keyTy -> ccu.MemberSignatureEquality(keyTy,v.Type)) + |> ValueOption.ofOption + + /// Get a table of values indexed by logical name + member mtyp.AllValsByLogicalName = + let addValByName (x:Val) tab = + // Note: names may occur twice prior to raising errors about this in PostTypeCheckSemanticChecks + // Earlier ones take precedence since we report errors about the later ones + if not x.IsMember && not x.IsCompilerGenerated then + NameMap.add x.LogicalName x tab + else + tab + cacheOptRef allValsByLogicalNameCache (fun () -> + QueueList.foldBack addValByName vals Map.empty) + + /// Compute a table of values and members indexed by logical name. + member mtyp.AllValsAndMembersByLogicalNameUncached = + let addValByName (x:Val) tab = + if not x.IsCompilerGenerated then + MultiMap.add x.LogicalName x tab + else + tab + QueueList.foldBack addValByName vals MultiMap.empty + + /// Get a table of F# exception definitions indexed by demangled name, so 'FailureException' is indexed by 'Failure' + member mtyp.ExceptionDefinitionsByDemangledName = + let add (tycon:Tycon) acc = NameMap.add tycon.LogicalName tycon acc + cacheOptRef exconsByDemangledNameCache (fun () -> + List.foldBack add mtyp.ExceptionDefinitions Map.empty) + + /// Get a table of nested module and namespace fragments indexed by demangled name (so 'ListModule' becomes 'List') + member mtyp.ModulesAndNamespacesByDemangledName = + let add (entity:Entity) acc = + if entity.IsModuleOrNamespace then + NameMap.add entity.DemangledModuleOrNamespaceName entity acc + else acc + cacheOptRef modulesByDemangledNameCache (fun () -> + QueueList.foldBack add entities Map.empty) + + override x.ToString() = "ModuleOrNamespaceType(...)" and ModuleOrNamespace = Entity and Tycon = Entity - /// A set of static methods for constructing types. and Construct = @@ -1900,6 +1937,8 @@ and Accessibility = /// Indicates the construct can only be accessed from any code in the given type constructor, module or assembly. [] indicates global scope. | TAccess of CompilationPath list + override x.ToString() = "Accessibility(...)" + and TyparData = Typar and [] @@ -2055,14 +2094,19 @@ and /// Sets the rigidity of a type variable member x.SetRigidity b = let flags = x.typar_flags in x.typar_flags <- TyparFlags(flags.Kind, b, flags.IsFromError, flags.IsCompilerGenerated, flags.StaticReq, flags.DynamicReq, flags.EqualityConditionalOn, flags.ComparisonConditionalOn) + /// Sets whether a type variable is compiler generated member x.SetCompilerGenerated b = let flags = x.typar_flags in x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, b, flags.StaticReq, flags.DynamicReq, flags.EqualityConditionalOn, flags.ComparisonConditionalOn) + /// Sets whether a type variable has a static requirement member x.SetStaticReq b = let flags = x.typar_flags in x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, flags.IsCompilerGenerated, b, flags.DynamicReq, flags.EqualityConditionalOn, flags.ComparisonConditionalOn) + /// Sets whether a type variable is required at runtime member x.SetDynamicReq b = let flags = x.typar_flags in x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, flags.IsCompilerGenerated, flags.StaticReq, b , flags.EqualityConditionalOn, flags.ComparisonConditionalOn) + /// Sets whether the equality constraint of a type definition depends on this type variable member x.SetEqualityDependsOn b = let flags = x.typar_flags in x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, flags.IsCompilerGenerated, flags.StaticReq, flags.DynamicReq, b , flags.ComparisonConditionalOn) + /// Sets whether the comparison constraint of a type definition depends on this type variable member x.SetComparisonDependsOn b = let flags = x.typar_flags in x.typar_flags <- TyparFlags(flags.Kind, flags.Rigidity, flags.IsFromError, flags.IsCompilerGenerated, flags.StaticReq, flags.DynamicReq, flags.EqualityConditionalOn, b) @@ -2111,6 +2155,8 @@ and /// Indicates a constraint that a type is .NET unmanaged type | IsUnmanaged of range + + override x.ToString() = "TyparConstraint(...)" /// The specification of a member constraint that must be solved and @@ -2125,12 +2171,16 @@ and /// Get the member name associated with the member constraint. member x.MemberName = (let (TTrait(_,nm,_,_,_,_)) = x in nm) + /// Get the return type recorded in the member constraint. member x.ReturnType = (let (TTrait(_,_,_,_,ty,_)) = x in ty) + /// Get or set the solution of the member constraint during inference member x.Solution with get() = (let (TTrait(_,_,_,_,_,sln)) = x in sln.Value) and set v = (let (TTrait(_,_,_,_,_,sln)) = x in sln.Value <- v) + + override x.ToString() = "TTrait(" + x.MemberName + ")" and [] @@ -2170,6 +2220,8 @@ and /// Indicates a trait is solved by a 'fake' instance of an operator, like '+' on integers | BuiltInSln + override x.ToString() = "TraitConstraintSln(...)" + /// The partial information used to index the methods of all those in a ModuleOrNamespace. and [] ValLinkagePartialKey = @@ -2185,6 +2237,8 @@ and [] /// Indicates the total argument count of the member. TotalArgCount: int } + override x.ToString() = "ValLinkagePartialKey(" + x.LogicalName + ")" + /// The full information used to identify a specific overloaded method /// amongst all those in a ModuleOrNamespace. and ValLinkageFullKey(partialKey: ValLinkagePartialKey, typeForLinkage:TType option) = @@ -2195,6 +2249,8 @@ and ValLinkageFullKey(partialKey: ValLinkagePartialKey, typeForLinkage:TType op /// The full type of the value for the purposes of linking. May be None for non-members, since they can't be overloaded. member x.TypeForLinkage = typeForLinkage + override x.ToString() = "ValLinkageFullKey(" + partialKey.LogicalName + ")" + and ValOptionalData = { /// MUTABILITY: for unpickle linkage @@ -2246,19 +2302,21 @@ and ValOptionalData = mutable val_attribs: Attribs } + override x.ToString() = "ValOptionalData(...)" + and ValData = Val and [] Val = { - /// MUTABILITY: for unpickle linkage + /// Mutable for unpickle linkage mutable val_logical_name: string - /// MUTABILITY: for unpickle linkage + /// Mutable for unpickle linkage mutable val_range: range mutable val_type: TType - /// MUTABILITY: for unpickle linkage + /// Mutable for unpickle linkage mutable val_stamp: Stamp /// See vflags section further below for encoding/decodings here @@ -2337,7 +2395,6 @@ and [] /// 'let x = let y = 1 in y + y' (NOTE: check this, don't take it as gospel) member x.IsCompiledAsTopLevel = x.ValReprInfo.IsSome - /// The partial information used to index the methods of all those in a ModuleOrNamespace. member x.LinkagePartialKey : ValLinkagePartialKey = assert x.IsCompiledAsTopLevel @@ -2606,14 +2663,13 @@ and [] else givenName - - /// - If this is a property then this is 'Foo' - /// - If this is an implementation of an abstract slot then this is the name of the property implemented by the abstract slot + /// The name of the property. + /// - If this is a property then this is 'Foo' + /// - If this is an implementation of an abstract slot then this is the name of the property implemented by the abstract slot member x.PropertyName = let logicalName = x.LogicalName ChopPropertyName logicalName - /// The name of the method. /// - If this is a property then this is 'Foo' /// - If this is an implementation of an abstract slot then this is the name of the method implemented by the abstract slot @@ -2637,32 +2693,44 @@ and [] DemangleOperatorName x.CoreDisplayName member x.SetValRec b = x.val_flags <- x.val_flags.SetRecursiveValInfo b + member x.SetIsMemberOrModuleBinding() = x.val_flags <- x.val_flags.SetIsMemberOrModuleBinding + member x.SetMakesNoCriticalTailcalls() = x.val_flags <- x.val_flags.SetMakesNoCriticalTailcalls + member x.SetHasBeenReferenced() = x.val_flags <- x.val_flags.SetHasBeenReferenced + member x.SetIsCompiledAsStaticPropertyWithoutField() = x.val_flags <- x.val_flags.SetIsCompiledAsStaticPropertyWithoutField + member x.SetIsFixed() = x.val_flags <- x.val_flags.SetIsFixed + member x.SetValReprInfo info = match x.val_opt_data with | Some optData -> optData.val_repr_info <- info | _ -> x.val_opt_data <- Some { Val.EmptyValOptData with val_repr_info = info } + member x.SetType ty = x.val_type <- ty + member x.SetOtherRange m = match x.val_opt_data with | Some optData -> optData.val_other_range <- Some m | _ -> x.val_opt_data <- Some { Val.EmptyValOptData with val_other_range = Some m } + member x.SetDeclaringEntity parent = match x.val_opt_data with | Some optData -> optData.val_declaring_entity <- parent | _ -> x.val_opt_data <- Some { Val.EmptyValOptData with val_declaring_entity = parent } + member x.SetAttribs attribs = match x.val_opt_data with | Some optData -> optData.val_attribs <- attribs | _ -> x.val_opt_data <- Some { Val.EmptyValOptData with val_attribs = attribs } + member x.SetMemberInfo member_info = match x.val_opt_data with | Some optData -> optData.val_member_info <- Some member_info | _ -> x.val_opt_data <- Some { Val.EmptyValOptData with val_member_info = Some member_info } + member x.SetValDefn val_defn = match x.val_opt_data with | Some optData -> optData.val_defn <- Some val_defn @@ -2702,6 +2770,7 @@ and [] and + /// Represents the extra information stored for a member [] ValMemberInfo = { /// The parent type. For an extension member this is the type being extended @@ -2715,6 +2784,7 @@ and MemberFlags: MemberFlags } + override x.ToString() = "ValMemberInfo(...)" and [] @@ -2725,9 +2795,16 @@ and /// The name of the value, or the full signature of the member ItemKey: ValLinkageFullKey } + /// Get the thunk for the assembly referred to member x.Ccu = x.EnclosingEntity.nlr.Ccu + + /// Get the name of the assembly referred to member x.AssemblyName = x.EnclosingEntity.nlr.AssemblyName + + /// For debugging member x.Display = x.ToString() + + /// For debugging override x.ToString() = x.EnclosingEntity.nlr.ToString() + "::" + x.ItemKey.PartialKey.LogicalName and ValPublicPath = @@ -4386,9 +4463,10 @@ and SlotParam = member x.Type = let (TSlotParam(_,ty,_,_,_,_)) = x in ty /// A type for a module-or-namespace-fragment and the actual definition of the module-or-namespace-fragment +/// The first ModuleOrNamespaceType is the signature and is a binder. However the bindings are not used in the ModuleOrNamespaceExpr: it is only referenced from the 'outside' +/// is for use by FCS only to report the "hidden" contents of the assembly prior to applying the signature. and ModuleOrNamespaceExprWithSig = | ModuleOrNamespaceExprWithSig of - /// The ModuleOrNamespaceType is a binder. However it is not used in the ModuleOrNamespaceExpr: it is only referenced from the 'outside' ModuleOrNamespaceType * ModuleOrNamespaceExpr * range @@ -4398,20 +4476,25 @@ and ModuleOrNamespaceExprWithSig = and ModuleOrNamespaceExpr = /// Indicates the module is a module with a signature | TMAbstract of ModuleOrNamespaceExprWithSig + /// Indicates the module fragment is made of several module fragments in succession | TMDefs of ModuleOrNamespaceExpr list + /// Indicates the module fragment is a 'let' definition | TMDefLet of Binding * range + /// Indicates the module fragment is an evaluation of expression for side-effects | TMDefDo of Expr * range + /// Indicates the module fragment is a 'rec' or 'non-rec' definition of types and modules | TMDefRec of isRec:bool * Tycon list * ModuleOrNamespaceBinding list * range /// A named module-or-namespace-fragment definition and [] ModuleOrNamespaceBinding = - //| Do of Expr + | Binding of Binding + | Module of /// This ModuleOrNamespace that represents the compilation of a module as a class. /// The same set of tycons etc. are bound in the ModuleOrNamespace as in the ModuleOrNamespaceExpr diff --git a/src/scripts/scriptlib.fsx b/src/scripts/scriptlib.fsx index c2ace21635..79481efb7c 100644 --- a/src/scripts/scriptlib.fsx +++ b/src/scripts/scriptlib.fsx @@ -36,7 +36,7 @@ module Scripting = #if INTERACTIVE let argv = Microsoft.FSharp.Compiler.Interactive.Settings.fsi.CommandLineArgs |> Seq.skip 1 |> Seq.toArray - let getCmdLineArgOptional switchName = + let getCmdLineArgOptional (switchName: string) = argv |> Array.filter(fun t -> t.StartsWith(switchName)) |> Array.map(fun t -> t.Remove(0, switchName.Length).Trim()) |> Array.tryHead let getCmdLineArg switchName defaultValue = diff --git a/tests/service/ProjectAnalysisTests.fs b/tests/service/ProjectAnalysisTests.fs index 15435406b9..325bc04635 100644 --- a/tests/service/ProjectAnalysisTests.fs +++ b/tests/service/ProjectAnalysisTests.fs @@ -2672,6 +2672,30 @@ let ``Test Project16 sym locations`` () = ("val x", ("file1", (11, 11), (11, 12)), ("file1", (11, 11), (11, 12)),("file1", (11, 11), (11, 12))); ("Impl", ("sig1", (2, 7), (2, 11)), ("file1", (2, 7), (2, 11)),("file1", (2, 7), (2, 11)))|] +[] +let ``Test project16 DeclaringEntity`` () = + let wholeProjectResults = + checker.ParseAndCheckProject(Project16.options) + |> Async.RunSynchronously + let allSymbolsUses = wholeProjectResults.GetAllUsesOfAllSymbols() |> Async.RunSynchronously + for sym in allSymbolsUses do + match sym.Symbol with + | :? FSharpEntity as e when not e.IsNamespace || e.AccessPath.Contains(".") -> + printfn "checking declaring type of entity '%s' --> '%s', assembly = '%s'" e.AccessPath e.CompiledName (e.Assembly.ToString()) + shouldEqual e.DeclaringEntity.IsSome (e.AccessPath <> "global") + match e.AccessPath with + | "C" | "D" | "E" | "F" | "G" -> + shouldEqual e.AccessPath "Impl" + shouldEqual e.DeclaringEntity.Value.IsFSharpModule true + shouldEqual e.DeclaringEntity.Value.IsNamespace false + | "int" -> + shouldEqual e.AccessPath "Microsoft.FSharp.Core" + shouldEqual e.DeclaringEntity.Value.AccessPath "Microsoft.FSharp" + | _ -> () + | :? FSharpMemberOrFunctionOrValue as e when e.IsModuleValueOrMember -> + printfn "checking declaring type of value '%s', assembly = '%s'" e.CompiledName (e.Assembly.ToString()) + shouldEqual e.DeclaringEntity.IsSome true + | _ -> () //----------------------------------------------------------------------------------------- @@ -4636,7 +4660,7 @@ module internal Project37 = let projFileName = Path.ChangeExtension(base2, ".fsproj") let fileSource1 = """ namespace AttrTests - +type X = int list [] type AttrTestAttribute() = inherit System.Attribute() @@ -4665,6 +4689,8 @@ module Test = let withTypeArray = 0 [] let withIntArray = 0 + module NestedModule = + type NestedRecordType = { B : int } [] do () @@ -4722,21 +4748,56 @@ let ``Test project37 typeof and arrays in attribute constructor arguments`` () = a |> shouldEqual [| 0; 1; 2 |] | _ -> () | _ -> () - wholeProjectResults.AssemblySignature.Attributes - |> Seq.map (fun a -> a.AttributeType.CompiledName) - |> Array.ofSeq |> shouldEqual [| "AttrTestAttribute"; "AttrTest2Attribute" |] - - wholeProjectResults.ProjectContext.GetReferencedAssemblies() - |> Seq.find (fun a -> a.SimpleName = "mscorlib") - |> fun a -> - printfn "Attributes found in mscorlib: %A" a.Contents.Attributes - shouldEqual (a.Contents.Attributes.Count > 0) true - - wholeProjectResults.ProjectContext.GetReferencedAssemblies() - |> Seq.find (fun a -> a.SimpleName = "FSharp.Core") - |> fun a -> - printfn "Attributes found in FSharp.Core: %A" a.Contents.Attributes - shouldEqual (a.Contents.Attributes.Count > 0) true + + let mscorlibAsm = + wholeProjectResults.ProjectContext.GetReferencedAssemblies() + |> Seq.find (fun a -> a.SimpleName = "mscorlib") + printfn "Attributes found in mscorlib: %A" mscorlibAsm.Contents.Attributes + shouldEqual (mscorlibAsm.Contents.Attributes.Count > 0) true + + let fsharpCoreAsm = + wholeProjectResults.ProjectContext.GetReferencedAssemblies() + |> Seq.find (fun a -> a.SimpleName = "FSharp.Core") + printfn "Attributes found in FSharp.Core: %A" fsharpCoreAsm.Contents.Attributes + shouldEqual (fsharpCoreAsm.Contents.Attributes.Count > 0) true + +[] +let ``Test project37 DeclaringEntity`` () = + let wholeProjectResults = + checker.ParseAndCheckProject(Project37.options) + |> Async.RunSynchronously + let allSymbolsUses = wholeProjectResults.GetAllUsesOfAllSymbols() |> Async.RunSynchronously + for sym in allSymbolsUses do + match sym.Symbol with + | :? FSharpEntity as e when not e.IsNamespace || e.AccessPath.Contains(".") -> + printfn "checking declaring type of entity '%s' --> '%s', assembly = '%s'" e.AccessPath e.CompiledName (e.Assembly.ToString()) + shouldEqual e.DeclaringEntity.IsSome true + match e.CompiledName with + | "AttrTestAttribute" -> + shouldEqual e.AccessPath "AttrTests" + | "int" -> + shouldEqual e.AccessPath "Microsoft.FSharp.Core" + shouldEqual e.DeclaringEntity.Value.AccessPath "Microsoft.FSharp" + | "list`1" -> + shouldEqual e.AccessPath "Microsoft.FSharp.Collections" + shouldEqual e.DeclaringEntity.Value.AccessPath "Microsoft.FSharp" + shouldEqual e.DeclaringEntity.Value.DeclaringEntity.IsSome true + shouldEqual e.DeclaringEntity.Value.DeclaringEntity.Value.IsNamespace true + shouldEqual e.DeclaringEntity.Value.DeclaringEntity.Value.AccessPath "Microsoft" + shouldEqual e.DeclaringEntity.Value.DeclaringEntity.Value.DeclaringEntity.Value.DeclaringEntity.IsSome false + | "Attribute" -> + shouldEqual e.AccessPath "System" + shouldEqual e.DeclaringEntity.Value.AccessPath "global" + | "NestedRecordType" -> + shouldEqual e.AccessPath "AttrTests.Test.NestedModule" + shouldEqual e.DeclaringEntity.Value.AccessPath "AttrTests.Test" + shouldEqual e.DeclaringEntity.Value.DeclaringEntity.Value.AccessPath "AttrTests" + shouldEqual e.DeclaringEntity.Value.DeclaringEntity.Value.DeclaringEntity.Value.AccessPath "global" + | _ -> () + | :? FSharpMemberOrFunctionOrValue as e when e.IsModuleValueOrMember -> + printfn "checking declaring type of value '%s', assembly = '%s'" e.CompiledName (e.Assembly.ToString()) + shouldEqual e.DeclaringEntity.IsSome true + | _ -> () //-----------------------------------------------------------