From ff078e94deff66e548efb668465fcdd601cc158d Mon Sep 17 00:00:00 2001 From: Don Syme Date: Wed, 28 Mar 2018 15:49:03 +0100 Subject: [PATCH] Add entity.DeclaringEntity to F# Compiler Service (#4633) * Add DeclaringEntity * extend tests to cover namespaces * extend tests to cover namespaces * build on Mono 5.10 * bump FCS version * various comments and debugging improvements * code review --- fcs/README.md | 6 +- fcs/RELEASE_NOTES.md | 3 + fcs/fcs.props | 2 +- src/absil/il.fs | 55 ++- src/absil/il.fsi | 42 +- src/fsharp/CompileOps.fs | 234 +++++------ src/fsharp/CompileOps.fsi | 12 +- src/fsharp/FSharp.Core/list.fs | 2 +- src/fsharp/FindUnsolved.fs | 2 +- src/fsharp/IlxGen.fs | 7 +- src/fsharp/InnerLambdasToTopLevelFuncs.fs | 4 +- src/fsharp/NicePrint.fs | 6 +- src/fsharp/Optimizer.fs | 4 +- src/fsharp/PostInferenceChecks.fs | 2 +- src/fsharp/TastOps.fs | 10 +- src/fsharp/TypeChecker.fs | 2 +- src/fsharp/TypeChecker.fsi | 2 +- src/fsharp/fsi/fsi.fs | 12 +- src/fsharp/service/IncrementalBuild.fs | 32 +- src/fsharp/service/IncrementalBuild.fsi | 5 +- src/fsharp/service/service.fs | 135 +++--- src/fsharp/symbols/Exprs.fs | 20 +- src/fsharp/symbols/Exprs.fsi | 4 +- src/fsharp/symbols/Symbols.fs | 303 ++++++++------ src/fsharp/symbols/Symbols.fsi | 63 +-- src/fsharp/tast.fs | 489 +++++++++++++--------- src/scripts/scriptlib.fsx | 2 +- tests/service/ProjectAnalysisTests.fs | 93 +++- 28 files changed, 906 insertions(+), 647 deletions(-) diff --git a/fcs/README.md b/fcs/README.md index ff53ba8cc..8f8634273 100644 --- a/fcs/README.md +++ b/fcs/README.md @@ -60,9 +60,9 @@ which does things like: 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 diff --git a/fcs/RELEASE_NOTES.md b/fcs/RELEASE_NOTES.md index df8f86645..67ac7bcc6 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 4a4dfbc00..8c9869c4f 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 ce8ee4065..32e1812c5 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 33b077e19..621bfb1ef 100644 --- 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 7c0c6220f..144fd3a65 100644 --- 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 0b4047126..50f2add51 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/FSharp.Core/list.fs b/src/fsharp/FSharp.Core/list.fs index 3e9a75e3c..aea7ef55e 100644 --- a/src/fsharp/FSharp.Core/list.fs +++ b/src/fsharp/FSharp.Core/list.fs @@ -415,7 +415,7 @@ namespace Microsoft.FSharp.Collections let filter predicate list = Microsoft.FSharp.Primitives.Basics.List.filter predicate list [] - let except itemsToExclude list = + let except (itemsToExclude: seq<'T>) list = checkNonNull "itemsToExclude" itemsToExclude match list with | [] -> list diff --git a/src/fsharp/FindUnsolved.fs b/src/fsharp/FindUnsolved.fs index f207262e9..aa144dc49 100644 --- 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 493b9c3c9..56325f5a6 100644 --- 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 f8fc13544..0828e1cd0 100644 --- 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 e3ad74ad0..f31fc657c 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 7ce763fed..308736ddb 100644 --- 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 c22fb3f40..1d722b3e4 100644 --- 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 31f0b9790..25a2ac7b9 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 eb3e39783..a18f6f5f7 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 448ba2cd6..045c1e843 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 6b662c12a..bc40ac47a 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 f1977599a..494ad478f 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 0f41ce105..b6b64a7ff 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 f5f4a6402..44a1d6b6a 100644 --- 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 d818cf956..ecbcea101 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 7e0e17ac8..c9049b33c 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 a21b26650..f24fed090 100644 --- 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 730c60e79..a6cf492c4 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 cca16b60a..186eab895 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 c2ace2163..79481efb7 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 15435406b..325bc0463 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 + | _ -> () //----------------------------------------------------------- -- GitLab