diff --git a/src/fsharp/CompileOps.fs b/src/fsharp/CompileOps.fs index 31de27365d7658890073890b410a030410105e95..4333ec0972581c672fa49a0c92ef61f7554bd293 100644 --- a/src/fsharp/CompileOps.fs +++ b/src/fsharp/CompileOps.fs @@ -3957,7 +3957,7 @@ type TcImports(tcConfigP:TcConfigProvider, initialResolutions:TcAssemblyResoluti | None -> // Build up the artificial namespace if there is not a real one. let cpath = CompPath(ILScopeRef.Local, injectedNamspace |> List.rev |> List.map (fun n -> (n,ModuleOrNamespaceKind.Namespace)) ) - let newNamespace = NewModuleOrNamespace (Some cpath) taccessPublic (ident(next,rangeStartup)) XmlDoc.Empty [] (notlazy (NewEmptyModuleOrNamespaceType Namespace)) + let newNamespace = NewModuleOrNamespace (Some cpath) taccessPublic (ident(next,rangeStartup)) XmlDoc.Empty [] (MaybeLazy.Strict (NewEmptyModuleOrNamespaceType Namespace)) entity.ModuleOrNamespaceType.AddModuleOrNamespaceByMutation(newNamespace) tcImports.InjectProvidedNamespaceOrTypeIntoEntity (typeProviderEnvironment, tcConfig, m, newNamespace, next::injectedNamspace, rest, provider, st) | [] -> diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 0cf902a2fcb590e452db7e76c4c87ccb6f7989b4..86841d43026b5ef397dd29560288dd7e8c7e5438 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -109,8 +109,9 @@ let ActivePatternElemsOfVal modref vspec = let ActivePatternElemsOfModuleOrNamespace (modref:ModuleOrNamespaceRef) : NameMap = let mtyp = modref.ModuleOrNamespaceType cacheOptRef mtyp.ActivePatternElemRefLookupTable (fun () -> - let aprefs = [ for x in mtyp.AllValsAndMembers do yield! ActivePatternElemsOfVal modref x ] - (Map.empty,aprefs) ||> List.fold (fun acc apref -> NameMap.add apref.Name apref acc) ) + mtyp.AllValsAndMembers + |> Seq.collect (ActivePatternElemsOfVal modref) + |> Seq.fold (fun acc apref -> NameMap.add apref.Name apref acc) Map.empty) //--------------------------------------------------------------------------- // Name Resolution Items @@ -1336,8 +1337,7 @@ let ItemsAreEffectivelyEqual g orig other = (id1.idText = id2.idText && id1.idRange = id2.idRange) | (Item.ArgName (id,_, _), ValUse vref) | (ValUse vref, Item.ArgName (id, _, _)) -> - (id.idText = vref.DisplayName && - (id.idRange = vref.DefinitionRange || id.idRange = vref.SigRange)) + ((id.idRange = vref.DefinitionRange || id.idRange = vref.SigRange) && id.idText = vref.DisplayName) | ILFieldUse f1, ILFieldUse f2 -> ILFieldInfo.ILFieldInfosUseIdenticalDefinitions f1 f2 @@ -1416,7 +1416,7 @@ type TcResultsSinkImpl(g, ?source: string) = let capturedNameResolutions = ResizeArray<_>() let capturedFormatSpecifierLocations = ResizeArray<_>() let capturedNameResolutionIdentifiers = - new System.Collections.Generic.Dictionary + new System.Collections.Generic.HashSet ( { new IEqualityComparer<_> with member __.GetHashCode((p:pos,i)) = p.Line + 101 * p.Column + hash i member __.Equals((p1,i1),(p2,i2)) = posEq p1 p2 && i1 = i2 } ) @@ -1451,10 +1451,7 @@ type TcResultsSinkImpl(g, ?source: string) = let alreadyDone = match keyOpt with - | Some key -> - let res = capturedNameResolutionIdentifiers.ContainsKey key - if not res then capturedNameResolutionIdentifiers.Add (key, ()) |> ignore - res + | Some key -> not (capturedNameResolutionIdentifiers.Add key) | _ -> false if replace then @@ -1758,13 +1755,17 @@ let private ResolveObjectConstructorPrim (ncenv:NameResolver) edenv resInfo m ad if isDelegateTy g typ then success (resInfo,Item.DelegateCtor typ) else - let ctorInfos = GetIntrinsicConstructorInfosOfType ncenv.InfoReader m typ - if isInterfaceTy g typ && isNil ctorInfos then + let ctorInfos = GetIntrinsicConstructorInfosOfType ncenv.InfoReader m typ + if isNil ctorInfos && isInterfaceTy g typ then success (resInfo, Item.FakeInterfaceCtor typ) else let defaultStructCtorInfo = - if (isStructTy g typ && not (isRecdTy g typ) && not (isUnionTy g typ) && not(ctorInfos |> List.exists (fun x -> x.IsNullary))) then - [DefaultStructCtor(g,typ)] + if (not (ctorInfos |> List.exists (fun x -> x.IsNullary)) && + isStructTy g typ && + not (isRecdTy g typ) && + not (isUnionTy g typ)) + then + [DefaultStructCtor(g,typ)] else [] if (isNil defaultStructCtorInfo && isNil ctorInfos) || not (isAppTy g typ) then raze (Error(FSComp.SR.nrNoConstructorsAvailableForType(NicePrint.minimalStringOfType edenv typ),m)) @@ -1935,7 +1936,7 @@ let DecodeFSharpEvent (pinfos:PropInfo list) ad g (ncenv:NameResolver) m = | _ -> // FOUND PROPERTY-AS-EVENT BUT DIDN'T FIND CORRESPONDING ADD/REMOVE METHODS Some(Item.Property (nm,pinfos)) - | pinfo::_ when not (isNil pinfos) -> + | pinfo :: _ -> let nm = CoreDisplayName(pinfo) Some(Item.Property (nm,pinfos)) | _ -> @@ -1948,8 +1949,7 @@ let GetRecordLabelsForType g nenv typ = nenv.eFieldLabels |> Seq.filter (fun kv -> kv.Value - |> List.map (fun r -> r.TyconRef.DisplayName) - |> List.exists ((=) typeName)) + |> List.exists (fun r -> r.TyconRef.DisplayName = typeName)) |> Seq.map (fun kv -> kv.Key) |> Set.ofSeq else @@ -3268,9 +3268,9 @@ let IsTyconUnseenObsoleteSpec ad g amap m (x:TyconRef) allowObsolete = let IsTyconUnseen ad g amap m (x:TyconRef) = IsTyconUnseenObsoleteSpec ad g amap m x false let IsValUnseen ad g m (v:ValRef) = - not (IsValAccessible ad v) || v.IsCompilerGenerated || v.Deref.IsClassConstructor || + not (IsValAccessible ad v) || CheckFSharpAttributesForUnseen g v.Attribs m let IsUnionCaseUnseen ad g amap m (ucref:UnionCaseRef) = @@ -3927,16 +3927,417 @@ and ResolvePartialLongIdentToClassOrRecdFieldsImpl (ncenv: NameResolver) (nenv: | _-> [] modsOrNs @ qualifiedFields -let GetVisibleNamespacesAndModulesAtPoint (ncenv: NameResolver) (nenv: NameResolutionEnv) m ad = - let ilTyconNames = - nenv.TyconsByAccessNames(FullyQualifiedFlag.OpenQualified).Values - |> List.choose (fun tyconRef -> if tyconRef.IsILTycon then Some tyconRef.DisplayName else None) - |> Set.ofList +(* Determining if an `Item` is resolvable at point by given `plid`. It's optimized by being lazy and early returning according to the given `Item` *) + +let private ResolveCompletionsInTypeForItem (ncenv: NameResolver) nenv m ad statics typ (item: Item) : seq = + seq { + let g = ncenv.g + let amap = ncenv.amap + + match item with + | Item.RecdField _ -> + yield! + ncenv.InfoReader.GetRecordOrClassFieldsOfType(None,ad,m,typ) + |> List.filter (fun rfref -> rfref.IsStatic = statics && IsFieldInfoAccessible ad rfref) + |> List.map Item.RecdField + | Item.UnionCase _ -> + if statics && isAppTy g typ then + let tc, tinst = destAppTy g typ + yield! + tc.UnionCasesAsRefList + |> List.filter (IsUnionCaseUnseen ad g ncenv.amap m >> not) + |> List.map (fun ucref -> Item.UnionCase(UnionCaseInfo(tinst,ucref),false)) + | Item.Event _ -> + yield! + ncenv.InfoReader.GetEventInfosOfType(None,ad,m,typ) + |> List.filter (fun x -> + IsStandardEventInfo ncenv.InfoReader m ad x && + x.IsStatic = statics) + |> List.map Item.Event + | Item.ILField _ -> + yield! + ncenv.InfoReader.GetILFieldInfosOfType(None,ad,m,typ) + |> List.filter (fun x -> + not x.IsSpecialName && + x.IsStatic = statics && + IsILFieldInfoAccessible g amap m ad x) + |> List.map Item.ILField + | Item.Types _ -> + if statics then + yield! typ |> GetNestedTypesOfType (ad, ncenv, None, TypeNameResolutionStaticArgsInfo.Indefinite, false, m) |> List.map (ItemOfTy g) + | _ -> + let pinfosIncludingUnseen = + AllPropInfosOfTypeInScope ncenv.InfoReader nenv (None,ad) PreferOverrides m typ + |> List.filter (fun x -> + x.IsStatic = statics && + IsPropInfoAccessible g amap m ad x) + + // Exclude get_ and set_ methods accessed by properties + let pinfoMethNames = + (pinfosIncludingUnseen + |> List.filter (fun pinfo -> pinfo.HasGetter) + |> List.map (fun pinfo -> pinfo.GetterMethod.LogicalName)) + @ + (pinfosIncludingUnseen + |> List.filter (fun pinfo -> pinfo.HasSetter) + |> List.map (fun pinfo -> pinfo.SetterMethod.LogicalName)) + + let einfoMethNames = + let einfos = + ncenv.InfoReader.GetEventInfosOfType(None,ad,m,typ) + |> List.filter (fun x -> + IsStandardEventInfo ncenv.InfoReader m ad x && + x.IsStatic = statics) + + [ for einfo in einfos do + let delegateType = einfo.GetDelegateType(amap, m) + let (SigOfFunctionForDelegate(invokeMethInfo,_,_,_)) = GetSigOfFunctionForDelegate ncenv.InfoReader delegateType m ad + // Only events with void return types are suppressed in intellisense. + if slotSigHasVoidReturnTy (invokeMethInfo.GetSlotSig(amap, m)) then + yield einfo.GetAddMethod().DisplayName + yield einfo.GetRemoveMethod().DisplayName ] + + let suppressedMethNames = Zset.ofList String.order (pinfoMethNames @ einfoMethNames) + + let pinfos = + pinfosIncludingUnseen + |> List.filter (fun x -> not (PropInfoIsUnseen m x)) + + let minfoFilter (minfo: MethInfo) = + // Only show the Finalize, MemberwiseClose etc. methods on System.Object for values whose static type really is + // System.Object. Few of these are typically used from F#. + // + // Don't show GetHashCode or Equals for F# types that admit equality as an abnormal operation + let isUnseenDueToBasicObjRules = + not (isObjTy g typ) && + not minfo.IsExtensionMember && + match minfo.LogicalName with + | "GetType" -> false + | "GetHashCode" -> isObjTy g minfo.EnclosingType && not (AugmentWithHashCompare.TypeDefinitelyHasEquality g typ) + | "ToString" -> false + | "Equals" -> + if not (isObjTy g minfo.EnclosingType) then + // declaring type is not System.Object - show it + false + elif minfo.IsInstance then + // System.Object has only one instance Equals method and we want to suppress it unless Augment.TypeDefinitelyHasEquality is true + not (AugmentWithHashCompare.TypeDefinitelyHasEquality g typ) + else + // System.Object has only one static Equals method and we always want to suppress it + true + | _ -> + // filter out self methods of obj type + isObjTy g minfo.EnclosingType + let result = + not isUnseenDueToBasicObjRules && + not minfo.IsInstance = statics && + IsMethInfoAccessible amap m ad minfo && + not (MethInfoIsUnseen g m typ minfo) && + not minfo.IsConstructor && + not minfo.IsClassConstructor && + not (minfo.LogicalName = ".cctor") && + not (minfo.LogicalName = ".ctor") && + not (suppressedMethNames.Contains minfo.LogicalName) + result + + let pinfoItems = + pinfos + |> List.choose (fun pinfo-> + let pinfoOpt = DecodeFSharpEvent [pinfo] ad g ncenv m + match pinfoOpt with + | Some(Item.Event einfo) -> if IsStandardEventInfo ncenv.InfoReader m ad einfo then pinfoOpt else None + | _ -> pinfoOpt) + + yield! pinfoItems + + match item with + | Item.MethodGroup _ -> + // REVIEW: add a name filter here in the common cases? + let minfos = + let minfos = + AllMethInfosOfTypeInScope ncenv.InfoReader nenv (None,ad) PreferOverrides m typ + |> List.filter minfoFilter + + let minfos = + let addersAndRemovers = + pinfoItems + |> List.collect (function Item.Event(FSEvent(_,_,addValRef,removeValRef)) -> [addValRef.LogicalName;removeValRef.LogicalName] | _ -> []) + |> set + + if addersAndRemovers.IsEmpty then minfos + else minfos |> List.filter (fun minfo -> not (addersAndRemovers.Contains minfo.LogicalName)) + + #if EXTENSIONTYPING + // Filter out the ones with mangled names from applying static parameters + let minfos = + let methsWithStaticParams = + minfos + |> List.filter (fun minfo -> + match minfo.ProvidedStaticParameterInfo with + | Some (_methBeforeArguments, staticParams) -> staticParams.Length <> 0 + | _ -> false) + |> List.map (fun minfo -> minfo.DisplayName) + + if methsWithStaticParams.IsEmpty then minfos + else minfos |> List.filter (fun minfo -> + let nm = minfo.LogicalName + not (nm.Contains "," && methsWithStaticParams |> List.exists (fun m -> nm.StartsWith(m)))) + #endif + + minfos + + // Partition methods into overload sets + let rec partitionl (l:MethInfo list) acc = + match l with + | [] -> acc + | h::t -> + let nm = h.LogicalName + partitionl t (NameMultiMap.add nm h acc) + + yield! List.map Item.MakeMethGroup (NameMap.toList (partitionl minfos Map.empty)) + | _ -> () + } + +let rec private ResolvePartialLongIdentInTypeForItem (ncenv: NameResolver) nenv m ad statics plid (item: Item) typ = + seq { + let g = ncenv.g + let amap = ncenv.amap + + match plid with + | [] -> yield! ResolveCompletionsInTypeForItem ncenv nenv m ad statics typ item + | id :: rest -> + + let rfinfos = + ncenv.InfoReader.GetRecordOrClassFieldsOfType(None,ad,m,typ) + |> List.filter (fun fref -> IsRecdFieldAccessible ncenv.amap m ad fref.RecdFieldRef) + |> List.filter (fun fref -> fref.RecdField.IsStatic = statics) + + let nestedTypes = typ |> GetNestedTypesOfType (ad, ncenv, Some id, TypeNameResolutionStaticArgsInfo.Indefinite, false, m) + + // e.g. .. + for rfinfo in rfinfos do + if rfinfo.Name = id then + yield! ResolvePartialLongIdentInTypeForItem ncenv nenv m ad false rest item rfinfo.FieldType + + // e.g. .. + let fullTypeOfPinfo (pinfo: PropInfo) = + let rty = pinfo.GetPropertyType(amap,m) + let rty = if pinfo.IsIndexer then mkRefTupledTy g (pinfo.GetParamTypes(amap, m)) --> rty else rty + rty + + let pinfos = + typ + |> AllPropInfosOfTypeInScope ncenv.InfoReader nenv (Some id,ad) IgnoreOverrides m + |> List.filter (fun x -> x.IsStatic = statics) + |> List.filter (IsPropInfoAccessible g amap m ad) + + for pinfo in pinfos do + yield! (fullTypeOfPinfo pinfo) |> ResolvePartialLongIdentInTypeForItem ncenv nenv m ad false rest item + + // e.g. .. + for einfo in ncenv.InfoReader.GetEventInfosOfType(Some id, ad, m, typ) do + let tyinfo = PropTypOfEventInfo ncenv.InfoReader m ad einfo + yield! ResolvePartialLongIdentInTypeForItem ncenv nenv m ad false rest item tyinfo + + // nested types! + for ty in nestedTypes do + yield! ResolvePartialLongIdentInTypeForItem ncenv nenv m ad statics rest item ty + + // e.g. .. + for finfo in ncenv.InfoReader.GetILFieldInfosOfType(Some id, ad, m, typ) do + if not finfo.IsSpecialName && finfo.IsStatic = statics && IsILFieldInfoAccessible g amap m ad finfo then + yield! finfo.FieldType(amap, m) |> ResolvePartialLongIdentInTypeForItem ncenv nenv m ad false rest item + } + +let rec private ResolvePartialLongIdentInModuleOrNamespaceForItem (ncenv: NameResolver) nenv m ad (modref: ModuleOrNamespaceRef) plid (item: Item) = + let g = ncenv.g + let mty = modref.ModuleOrNamespaceType + + seq { + match plid with + | [] -> + match item with + | Item.Value _ -> + // Collect up the accessible values in the module, excluding the members + yield! + mty.AllValsAndMembers + |> Seq.toList + |> List.choose (TryMkValRefInModRef modref) // if the assembly load set is incomplete and we get a None value here, then ignore the value + |> List.filter (fun v -> v.MemberInfo.IsNone) + |> List.filter (IsValUnseen ad g m >> not) + |> List.map Item.Value + | Item.UnionCase _ -> + // Collect up the accessible discriminated union cases in the module + yield! + UnionCaseRefsInModuleOrNamespace modref + |> List.filter (IsUnionCaseUnseen ad g ncenv.amap m >> not) + |> List.map (fun x -> Item.UnionCase(GeneralizeUnionCaseRef x, false)) + | Item.ActivePatternCase _ -> + // Collect up the accessible active patterns in the module + yield! + ActivePatternElemsOfModuleOrNamespace modref + |> NameMap.range + |> List.filter (fun apref -> apref.ActivePatternVal |> IsValUnseen ad g m |> not) + |> List.map Item.ActivePatternCase + | Item.ExnCase _ -> + // Collect up the accessible F# exception declarations in the module + yield! + mty.ExceptionDefinitionsByDemangledName + |> NameMap.range + |> List.map modref.NestedTyconRef + |> List.filter (IsTyconUnseen ad g ncenv.amap m >> not) + |> List.map Item.ExnCase + | _ -> + let ilTyconNames = + mty.TypesByAccessNames.Values + |> List.choose (fun (tycon:Tycon) -> if tycon.IsILTycon then Some tycon.DisplayName else None) + |> Set.ofList + + // Collect up the accessible sub-modules. We must yield them even though `item` is not a module or namespace, + // otherwise we would not resolve long idents which have modules and namespaces in the middle (i.e. all long idents) + yield! + mty.ModulesAndNamespacesByDemangledName + |> NameMap.range + |> List.filter (fun x -> + let demangledName = x.DemangledModuleOrNamespaceName + notFakeContainerModule ilTyconNames demangledName && IsInterestingModuleName demangledName) + |> List.map modref.NestedTyconRef + |> List.filter (IsTyconUnseen ad g ncenv.amap m >> not) + |> List.filter (EntityRefContainsSomethingAccessible ncenv m ad) + |> List.map ItemForModuleOrNamespaceRef + let tycons = + mty.TypeDefinitions + |> List.filter (fun tcref -> not (tcref.LogicalName.Contains(","))) + |> List.filter (fun tycon -> not (IsTyconUnseen ad g ncenv.amap m (modref.NestedTyconRef tycon))) + + // Get all the types and .NET constructor groups accessible from here + yield! tycons |> List.map (modref.NestedTyconRef >> ItemOfTyconRef ncenv m) + yield! tycons |> List.collect (modref.NestedTyconRef >> InfosForTyconConstructors ncenv m ad) + + | id :: rest -> + + match mty.ModulesAndNamespacesByDemangledName.TryFind(id) with + | Some mspec + when not (IsTyconUnseenObsoleteSpec ad g ncenv.amap m (modref.NestedTyconRef mspec) true) -> + yield! ResolvePartialLongIdentInModuleOrNamespaceForItem ncenv nenv m ad (modref.NestedTyconRef mspec) rest item + | _ -> () + + for tycon in LookupTypeNameInEntityNoArity m id modref.ModuleOrNamespaceType do + let tcref = modref.NestedTyconRef tycon + if not (IsTyconUnseenObsoleteSpec ad g ncenv.amap m tcref true) then + yield! tcref |> generalizedTyconRef |> ResolvePartialLongIdentInTypeForItem ncenv nenv m ad true rest item + } + +let rec private PartialResolveLookupInModuleOrNamespaceAsModuleOrNamespaceThenLazy f plid (modref: ModuleOrNamespaceRef) = + let mty = modref.ModuleOrNamespaceType + match plid with + | [] -> f modref + | id :: rest -> + match mty.ModulesAndNamespacesByDemangledName.TryFind id with + | Some mty -> + PartialResolveLookupInModuleOrNamespaceAsModuleOrNamespaceThenLazy f rest (modref.NestedTyconRef mty) + | None -> Seq.empty + +let private PartialResolveLongIndentAsModuleOrNamespaceThenLazy (nenv:NameResolutionEnv) plid f = + seq { + match plid with + | id :: rest -> + match Map.tryFind id nenv.eModulesAndNamespaces with + | Some modrefs -> + for modref in modrefs do + yield! PartialResolveLookupInModuleOrNamespaceAsModuleOrNamespaceThenLazy f rest modref + | None -> () + | [] -> () + } + +let rec private GetCompletionForItem (ncenv: NameResolver) (nenv: NameResolutionEnv) m ad plid (item: Item) : seq = + seq { + let g = ncenv.g + + match plid with + | "global" :: plid -> // this is deliberately not the mangled name + + yield! GetCompletionForItem ncenv nenv m ad plid item + + | [] -> + + /// Include all the entries in the eUnqualifiedItems table. + for uitem in nenv.eUnqualifiedItems.Values do + match uitem with + | Item.UnqualifiedType _ -> () + | _ when not (ItemIsUnseen ad g ncenv.amap m uitem) -> + yield uitem + | _ -> () + + match item with + | Item.ModuleOrNamespaces _ -> + let ilTyconNames = + nenv.TyconsByAccessNames(OpenQualified).Values + |> List.choose (fun tyconRef -> if tyconRef.IsILTycon then Some tyconRef.DisplayName else None) + |> Set.ofList + + for ns in NameMultiMap.range (nenv.ModulesAndNamespaces(OpenQualified)) do + let demangledName = ns.DemangledModuleOrNamespaceName + if IsInterestingModuleName demangledName && notFakeContainerModule ilTyconNames demangledName + && EntityRefContainsSomethingAccessible ncenv m ad ns + && not (IsTyconUnseen ad g ncenv.amap m ns) + then yield ItemForModuleOrNamespaceRef ns + + | Item.Types _ -> + for tcref in nenv.TyconsByDemangledNameAndArity(OpenQualified).Values do + if not tcref.IsExceptionDecl + && not (tcref.LogicalName.Contains ",") + && not (IsTyconUnseen ad g ncenv.amap m tcref) + then yield ItemOfTyconRef ncenv m tcref + + | Item.ActivePatternCase _ -> + for pitem in NameMap.range nenv.ePatItems do + match pitem with + | Item.ActivePatternCase _ -> + yield pitem + | _ -> () + + | Item.DelegateCtor _ + | Item.FakeInterfaceCtor _ + | Item.CtorGroup _ + | Item.UnqualifiedType _ -> + for tcref in nenv.TyconsByDemangledNameAndArity(OpenQualified).Values do + if not (IsTyconUnseen ad g ncenv.amap m tcref) + then yield! InfosForTyconConstructors ncenv m ad tcref + + | _ -> () + + | id :: rest -> + + // Look in the namespaces 'id' + yield! + PartialResolveLongIndentAsModuleOrNamespaceThenLazy nenv [id] (fun modref -> + if EntityRefContainsSomethingAccessible ncenv m ad modref then + ResolvePartialLongIdentInModuleOrNamespaceForItem ncenv nenv m ad modref rest item + else Seq.empty) + + // Look for values called 'id' that accept the dot-notation + let values, isItemVal = + (if nenv.eUnqualifiedItems.ContainsKey(id) then + // v.lookup : member of a value + let v = nenv.eUnqualifiedItems.[id] + match v with + | Item.Value x -> + let typ = x.Type + let typ = if x.BaseOrThisInfo = CtorThisVal && isRefCellTy g typ then destRefCellTy g typ else typ + (ResolvePartialLongIdentInTypeForItem ncenv nenv m ad false rest item typ), true + | _ -> Seq.empty, false + else Seq.empty, false) + + yield! values + + if not isItemVal then + // type.lookup : lookup a static something in a type + for tcref in LookupTypeNameInEnvNoArity OpenQualified id nenv do + let tcref = ResolveNestedTypeThroughAbbreviation ncenv tcref m + let typ = FreshenTycon ncenv m tcref + yield! ResolvePartialLongIdentInTypeForItem ncenv nenv m ad true rest item typ + } - nenv.ModulesAndNamespaces(FullyQualifiedFlag.OpenQualified) - |> NameMultiMap.range - |> List.filter (fun x -> - let demangledName = x.DemangledModuleOrNamespaceName - IsInterestingModuleName demangledName && notFakeContainerModule ilTyconNames demangledName - && EntityRefContainsSomethingAccessible ncenv m ad x - && not (IsTyconUnseen ad ncenv.g ncenv.amap m x)) +let IsItemResolvable (ncenv: NameResolver) (nenv: NameResolutionEnv) m ad plid (item: Item) : bool = + GetCompletionForItem ncenv nenv m ad plid item |> Seq.exists (ItemsAreEffectivelyEqual ncenv.g item) diff --git a/src/fsharp/NameResolution.fsi b/src/fsharp/NameResolution.fsi index db3409e99ed8682b9a85ba6411a0e5c0f855a525..f35feaf24dd3615b475a30ade919f68cd77a488c 100755 --- a/src/fsharp/NameResolution.fsi +++ b/src/fsharp/NameResolution.fsi @@ -418,4 +418,5 @@ type ResolveCompletionTargets = /// Resolve a (possibly incomplete) long identifier to a set of possible resolutions, qualified by type. val ResolveCompletionsInType : NameResolver -> NameResolutionEnv -> ResolveCompletionTargets -> Range.range -> AccessorDomain -> bool -> TType -> Item list -val GetVisibleNamespacesAndModulesAtPoint : NameResolver -> NameResolutionEnv -> range -> AccessorDomain -> ModuleOrNamespaceRef list \ No newline at end of file + +val IsItemResolvable : NameResolver -> NameResolutionEnv -> range -> AccessorDomain -> string list -> Item -> bool \ No newline at end of file diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index ee2c88c1b070efce2149f6c64e08bd7f894a414d..82c166a620d34917ebc0a7250d88ba3fec3e8206 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -3087,7 +3087,7 @@ and OptimizeModuleExpr cenv env x = mty and elimModSpec (mspec:ModuleOrNamespace) = let mtyp = elimModTy mspec.ModuleOrNamespaceType - mspec.Data.entity_modul_contents <- notlazy mtyp + mspec.Data.entity_modul_contents <- MaybeLazy.Strict mtyp let rec elimModDef x = match x with diff --git a/src/fsharp/TastOps.fs b/src/fsharp/TastOps.fs index e35a67a220172d984a566db818b01d2d0a5ff653..e2cb30246b7d366bf7662c9ce02f9206bf762dcd 100644 --- a/src/fsharp/TastOps.fs +++ b/src/fsharp/TastOps.fs @@ -980,7 +980,7 @@ let ensureCcuHasModuleOrNamespaceAtPath (ccu:CcuThunk) path (CompPath(_,cpath)) | (hpath::tpath),((_,mkind)::tcpath) -> let modName = hpath.idText if not (Map.containsKey modName mtype.AllEntitiesByCompiledAndLogicalMangledNames) then - let smodul = NewModuleOrNamespace (Some(CompPath(scoref,prior_cpath))) taccessPublic hpath xml [] (notlazy (NewEmptyModuleOrNamespaceType mkind)) + let smodul = NewModuleOrNamespace (Some(CompPath(scoref,prior_cpath))) taccessPublic hpath xml [] (MaybeLazy.Strict (NewEmptyModuleOrNamespaceType mkind)) mtype.AddModuleOrNamespaceByMutation(smodul); let modul = Map.find modName mtype.AllEntitiesByCompiledAndLogicalMangledNames loop (prior_cpath@[(modName,Namespace)]) tpath tcpath modul @@ -3566,7 +3566,7 @@ end //-------------------------------------------------------------------------- let wrapModuleOrNamespaceType id cpath mtyp = - NewModuleOrNamespace (Some cpath) taccessPublic id XmlDoc.Empty [] (notlazy mtyp) + NewModuleOrNamespace (Some cpath) taccessPublic id XmlDoc.Empty [] (MaybeLazy.Strict mtyp) let wrapModuleOrNamespaceTypeInNamespace id cpath mtyp = let mspec = wrapModuleOrNamespaceType id cpath mtyp @@ -4972,9 +4972,8 @@ and copyAndRemapAndBindTyconsAndVals g compgen tmenv tycons vs = tcd'.entity_tycon_repr <- tcd.entity_tycon_repr |> remapTyconRepr g tmenvinner2; tcd'.entity_tycon_abbrev <- tcd.entity_tycon_abbrev |> Option.map (remapType tmenvinner2) ; tcd'.entity_tycon_tcaug <- tcd.entity_tycon_tcaug |> remapTyconAug tmenvinner2 ; - tcd'.entity_modul_contents <- notlazy (tcd.entity_modul_contents - |> Lazy.force - |> mapImmediateValsAndTycons lookupTycon lookupVal); + tcd'.entity_modul_contents <- MaybeLazy.Strict (tcd.entity_modul_contents.Value + |> mapImmediateValsAndTycons lookupTycon lookupVal); tcd'.entity_exn_info <- tcd.entity_exn_info |> remapTyconExnInfo g tmenvinner2) ; tycons',vs', tmenvinner @@ -7637,10 +7636,8 @@ let rec remapEntityDataToNonLocal g tmenv (d: EntityData) = entity_tycon_abbrev = d.entity_tycon_abbrev |> Option.map (remapType tmenvinner) ; entity_tycon_tcaug = d.entity_tycon_tcaug |> remapTyconAug tmenvinner ; entity_modul_contents = - notlazy (d.entity_modul_contents - |> Lazy.force - |> mapImmediateValsAndTycons (remapTyconToNonLocal g tmenv) - (remapValToNonLocal g tmenv)); + MaybeLazy.Strict (d.entity_modul_contents.Value + |> mapImmediateValsAndTycons (remapTyconToNonLocal g tmenv) (remapValToNonLocal g tmenv)); entity_exn_info = d.entity_exn_info |> remapTyconExnInfo g tmenvinner} and remapTyconToNonLocal g tmenv x = diff --git a/src/fsharp/TastPickle.fs b/src/fsharp/TastPickle.fs index 0392ea8c292f9b94381db89e948df34867f4ab91..84da20687cadaab213ec405127458a049a4bc539 100755 --- a/src/fsharp/TastPickle.fs +++ b/src/fsharp/TastPickle.fs @@ -436,8 +436,7 @@ let p_option f x st = // Pickle lazy values in such a way that they can, in some future F# compiler version, be read back // lazily. However, a lazy reader is not used in this version because the value may contain the definitions of some // OSGN nodes. -let p_lazy p x st = - let v = Lazy.force x +let private p_lazy_impl p v st = let fixupPos1 = st.os.Position // We fix these up after prim_p_int32 0 st; @@ -473,6 +472,12 @@ let p_lazy p x st = st.os.FixupInt32 fixupPos6 ovalsIdx1; st.os.FixupInt32 fixupPos7 ovalsIdx2 +let p_lazy p x st = + p_lazy_impl p (Lazy.force x) st + +let p_maybe_lazy p (x: MaybeLazy<_>) st = + p_lazy_impl p x.Value st + let p_hole () = let h = ref (None : 'T pickler option) (fun f -> h := Some f),(fun x st -> match !h with Some f -> f x st | None -> pfailwith st "p_hole: unfilled hole") @@ -1727,7 +1732,7 @@ and p_entity_spec_data (x:EntityData) st = p_kind x.entity_kind st p_int64 (x.entity_flags.PickledBits ||| (if flagBit then EntityFlags.ReservedBitForPickleFormatTyconReprFlag else 0L)) st p_option p_cpath x.entity_cpath st - p_lazy p_modul_typ x.entity_modul_contents st + p_maybe_lazy p_modul_typ x.entity_modul_contents st p_exnc_repr x.entity_exn_info st p_space 1 space st @@ -2012,7 +2017,7 @@ and u_entity_spec_data st : EntityData = entity_kind=x10b; entity_flags=EntityFlags(x11); entity_cpath=x12; - entity_modul_contents= x13; + entity_modul_contents=MaybeLazy.Lazy x13; entity_exn_info=x14; entity_il_repr_cache=newCache(); } diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index 767ff5b056c065f322f4556a6170ddc8edf4e0bb..effcb58451cdf9c3eb01b5e6a1ab616fd419d31e 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -1315,7 +1315,7 @@ let UpdateAccModuleOrNamespaceType cenv env f = if cenv.compilingCanonicalFslibModuleType then let nleref = mkNonLocalEntityRef cenv.topCcu (arrPathOfLid env.ePath) let modul = nleref.Deref - modul.Data.entity_modul_contents <- notlazy (f true modul.ModuleOrNamespaceType) + modul.Data.entity_modul_contents <- MaybeLazy.Strict (f true modul.ModuleOrNamespaceType) SetCurrAccumulatedModuleOrNamespaceType env (f false (GetCurrAccumulatedModuleOrNamespaceType env)) let PublishModuleDefn cenv env mspec = @@ -13385,13 +13385,13 @@ module MutRecBindingChecking = let TcMutRecDefns_UpdateNSContents mutRecNSInfo = match mutRecNSInfo with | Some (Some (mspecNS: ModuleOrNamespace), mtypeAcc) -> - mspecNS.Data.entity_modul_contents <- notlazy !mtypeAcc + mspecNS.Data.entity_modul_contents <- MaybeLazy.Strict !mtypeAcc | _ -> () /// Updates the types of the modules to contain the contents so far let TcMutRecDefns_UpdateModuleContents mutRecNSInfo defns = defns |> MutRecShapes.iterModules (fun (MutRecDefnsPhase2DataForModule (mtypeAcc, mspec), _) -> - mspec.Data.entity_modul_contents <- notlazy !mtypeAcc) + mspec.Data.entity_modul_contents <- MaybeLazy.Strict !mtypeAcc) TcMutRecDefns_UpdateNSContents mutRecNSInfo @@ -14344,7 +14344,7 @@ module EstablishTypeDefinitionCores = CheckNamespaceModuleOrTypeName cenv.g id let envForDecls, mtypeAcc = MakeInnerEnv envInitial id modKind - let mspec = NewModuleOrNamespace (Some envInitial.eCompPath) vis id (xml.ToXmlDoc()) modAttrs (notlazy (NewEmptyModuleOrNamespaceType modKind)) + let mspec = NewModuleOrNamespace (Some envInitial.eCompPath) vis id (xml.ToXmlDoc()) modAttrs (MaybeLazy.Strict (NewEmptyModuleOrNamespaceType modKind)) let innerParent = Parent (mkLocalModRef mspec) let typeNames = TypeNamesInMutRecDecls compDecls MutRecDefnsPhase2DataForModule (mtypeAcc, mspec), (innerParent, typeNames, envForDecls) @@ -14385,7 +14385,7 @@ module EstablishTypeDefinitionCores = let visOfRepr,_ = ComputeAccessAndCompPath env None id.idRange synVisOfRepr None parent let visOfRepr = combineAccess vis visOfRepr // If we supported nested types and modules then additions would be needed here - let lmtyp = notlazy (NewEmptyModuleOrNamespaceType ModuleOrType) + let lmtyp = MaybeLazy.Strict (NewEmptyModuleOrNamespaceType ModuleOrType) NewTycon(cpath, id.idText, id.idRange, vis, visOfRepr, TyparKind.Type, LazyWithContext.NotLazy checkedTypars, doc.ToXmlDoc(), preferPostfix, preEstablishedHasDefaultCtor, hasSelfReferentialCtor, lmtyp) @@ -16101,11 +16101,11 @@ let rec TcSignatureElementNonMutRec cenv parent typeNames endm (env: TcEnv) synS // Now typecheck the signature, accumulating and then recording the submodule description. let id = ident (modName, id.idRange) - let mspec = NewModuleOrNamespace (Some env.eCompPath) vis id (xml.ToXmlDoc()) attribs (notlazy (NewEmptyModuleOrNamespaceType modKind)) + let mspec = NewModuleOrNamespace (Some env.eCompPath) vis id (xml.ToXmlDoc()) attribs (MaybeLazy.Strict (NewEmptyModuleOrNamespaceType modKind)) let! (mtyp,_) = TcModuleOrNamespaceSignatureElementsNonMutRec cenv (Parent (mkLocalModRef mspec)) env (id,modKind,mdefs,m,xml) - mspec.Data.entity_modul_contents <- notlazy mtyp + mspec.Data.entity_modul_contents <- MaybeLazy.Strict mtyp let scopem = unionRanges m endm PublishModuleDefn cenv env mspec let env = AddLocalSubModuleAndReport cenv.tcSink scopem cenv.g cenv.amap m env mspec @@ -16421,13 +16421,13 @@ let rec TcModuleOrNamespaceElementNonMutRec (cenv:cenv) parent typeNames scopem // Create the new module specification to hold the accumulated results of the type of the module // Also record this in the environment as the accumulator - let mspec = NewModuleOrNamespace (Some env.eCompPath) vis id (xml.ToXmlDoc()) modAttrs (notlazy (NewEmptyModuleOrNamespaceType modKind)) + let mspec = NewModuleOrNamespace (Some env.eCompPath) vis id (xml.ToXmlDoc()) modAttrs (MaybeLazy.Strict (NewEmptyModuleOrNamespaceType modKind)) // Now typecheck. let! mexpr, topAttrsNew, envAtEnd = TcModuleOrNamespaceElements cenv (Parent (mkLocalModRef mspec)) endm envForModule xml None mdefs // Get the inferred type of the decls and record it in the mspec. - mspec.Data.entity_modul_contents <- notlazy !mtypeAcc + mspec.Data.entity_modul_contents <- MaybeLazy.Strict !mtypeAcc let modDefn = TMDefRec(false,[],[ModuleOrNamespaceBinding.Module(mspec,mexpr)],m) PublishModuleDefn cenv env mspec let env = AddLocalSubModuleAndReport cenv.tcSink scopem cenv.g cenv.amap m env mspec @@ -16614,7 +16614,7 @@ and TcMutRecDefsFinish cenv defs m = binds |> List.map ModuleOrNamespaceBinding.Binding | MutRecShape.Module ((MutRecDefnsPhase2DataForModule(mtypeAcc, mspec), _),mdefs) -> let mexpr = TcMutRecDefsFinish cenv mdefs m - mspec.Data.entity_modul_contents <- notlazy !mtypeAcc + mspec.Data.entity_modul_contents <- MaybeLazy.Strict !mtypeAcc [ ModuleOrNamespaceBinding.Module(mspec,mexpr) ]) TMDefRec(true,tycons,binds,m) diff --git a/src/fsharp/ast.fs b/src/fsharp/ast.fs index ad60c302d5bc6101097e71c12e8b9071501715e2..83501a69a6aade2b22d824a39644ba52695910f4 100644 --- a/src/fsharp/ast.fs +++ b/src/fsharp/ast.fs @@ -135,9 +135,9 @@ type ParserDetail = // PERFORMANCE: consider making this a struct. [] -[] +[] [] -type Ident (text,range) = +type Ident (text: string, range: range) = member x.idText = text member x.idRange = range override x.ToString() = text diff --git a/src/fsharp/import.fs b/src/fsharp/import.fs index feed9f416cfceaeb62fc91d87399e33c12064f10..8b0a8534a85bdd6d00debbc9e7bfccd2dc1b095d 100644 --- a/src/fsharp/import.fs +++ b/src/fsharp/import.fs @@ -455,7 +455,7 @@ let rec ImportILTypeDef amap m scoref (cpath:CompilationPath) enc nm (tdef:ILTyp // Make sure we reraise the original exception one occurs - see findOriginalException. (LazyWithContext.Create((fun m -> ImportILGenericParameters amap m scoref [] tdef.GenericParams), ErrorLogger.findOriginalException)) (scoref,enc,tdef) - lazyModuleOrNamespaceTypeForNestedTypes + (MaybeLazy.Lazy lazyModuleOrNamespaceTypeForNestedTypes) /// Import a list of (possibly nested) IL types as a new ModuleOrNamespaceType node @@ -474,7 +474,7 @@ and ImportILTypeDefList amap m (cpath:CompilationPath) enc items = |> multisetDiscriminateAndMap (fun n tgs -> let modty = lazy (ImportILTypeDefList amap m (cpath.NestedCompPath n Namespace) enc tgs) - NewModuleOrNamespace (Some cpath) taccessPublic (mkSynId m n) XmlDoc.Empty [] modty) + NewModuleOrNamespace (Some cpath) taccessPublic (mkSynId m n) XmlDoc.Empty [] (MaybeLazy.Lazy modty)) (fun (n,info:Lazy<_>) -> let (scoref2,_,lazyTypeDef:Lazy) = info.Force() ImportILTypeDef amap m scoref2 cpath enc n (lazyTypeDef.Force())) diff --git a/src/fsharp/tast.fs b/src/fsharp/tast.fs index 74e6e6115ad6afae2519f7a2d9c0ee8d279e0658..7eaf64d0a9721a66510616301cfc068dfcf59fbe 100755 --- a/src/fsharp/tast.fs +++ b/src/fsharp/tast.fs @@ -970,6 +970,17 @@ type Entity = /// Sets the structness of a record or union type definition member x.SetIsStructRecordOrUnion b = let x = x.Data in let flags = x.entity_flags in x.entity_flags <- EntityFlags(flags.IsPrefixDisplay, flags.IsModuleOrNamespace, flags.PreEstablishedHasDefaultConstructor, flags.HasSelfReferentialConstructor, b) +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 [] @@ -1033,7 +1044,7 @@ and // // MUTABILITY: only used during creation and remapping of tycons and // when compiling fslib to fixup compiler forward references to internal items - mutable entity_modul_contents: Lazy + mutable entity_modul_contents: MaybeLazy /// The declared documentation for the type or module entity_xmldoc : XmlDoc @@ -1745,7 +1756,7 @@ and Construct = entity_tycon_repr_accessibility = TAccess([]) entity_exn_info=TExnNone entity_tycon_tcaug=TyconAugmentation.Create() - entity_modul_contents = lazy new ModuleOrNamespaceType(Namespace, QueueList.ofList [], QueueList.ofList []) + entity_modul_contents = MaybeLazy.Lazy (lazy new ModuleOrNamespaceType(Namespace, QueueList.ofList [], QueueList.ofList [])) // Generated types get internal accessibility entity_accessiblity= access entity_xmldoc = XmlDoc [||] // fetched on demand via est.fs API @@ -2596,7 +2607,7 @@ and NonLocalEntityRef = Construct.NewModuleOrNamespace (Some cpath) (TAccess []) (ident(path.[k],m)) XmlDoc.Empty [] - (notlazy (Construct.NewEmptyModuleOrNamespaceType Namespace)) + (MaybeLazy.Strict (Construct.NewEmptyModuleOrNamespaceType Namespace)) entity.ModuleOrNamespaceType.AddModuleOrNamespaceByMutation(newEntity) injectNamespacesFromIToJ newEntity (k+1) let newEntity = injectNamespacesFromIToJ entity i @@ -3020,15 +3031,14 @@ and mutable binding: NonNullSlot /// Indicates a reference to something bound in another CCU nlr: NonLocalValOrMemberRef } - member x.IsLocalRef = match box x.nlr with null -> true | _ -> false - member x.IsResolved = match box x.binding with null -> false | _ -> true + member x.IsLocalRef = obj.ReferenceEquals(x.nlr, null) + member x.IsResolved = not (obj.ReferenceEquals(x.binding, null)) member x.PrivateTarget = x.binding member x.ResolvedTarget = x.binding /// Dereference the ValRef to a Val. member vr.Deref = - match box vr.binding with - | null -> + if obj.ReferenceEquals(vr.binding, null) then let res = let nlr = vr.nlr let e = nlr.EnclosingEntity.Deref @@ -3038,12 +3048,11 @@ and | Some h -> h vr.binding <- nullableSlotFull res res - | _ -> vr.binding + else vr.binding /// Dereference the ValRef to a Val option. member vr.TryDeref = - match box vr.binding with - | null -> + if obj.ReferenceEquals(vr.binding, null) then let resOpt = vr.nlr.EnclosingEntity.TryDeref |> Option.bind (fun e -> e.ModuleOrNamespaceType.TryLinkVal(vr.nlr.EnclosingEntity.nlr.Ccu, vr.nlr.ItemKey)) @@ -3052,8 +3061,7 @@ and | Some res -> vr.binding <- nullableSlotFull res resOpt - | _ -> - Some vr.binding + else Some vr.binding /// The type of the value. May be a TType_forall for a generic value. /// May be a type variable or type containing type variables during type inference. @@ -4511,7 +4519,7 @@ let fullCompPathOfModuleOrNamespace (m:ModuleOrNamespace) = CompPath(scoref,cpath@[(m.LogicalName, m.ModuleOrNamespaceType.ModuleOrNamespaceKind)]) // Can cpath2 be accessed given a right to access cpath1. That is, is cpath2 a nested type or namespace of cpath1. Note order of arguments. -let canAccessCompPathFrom (CompPath(scoref1,cpath1)) (CompPath(scoref2,cpath2)) = +let inline canAccessCompPathFrom (CompPath(scoref1,cpath1)) (CompPath(scoref2,cpath2)) = let rec loop p1 p2 = match p1,p2 with | (a1,k1)::rest1, (a2,k2)::rest2 -> (a1=a2) && (k1=k2) && loop rest1 rest2 @@ -4609,7 +4617,7 @@ let NewExn cpath (id:Ident) access repr attribs doc = entity_pubpath=cpath |> Option.map (fun (cp:CompilationPath) -> cp.NestedPublicPath id) entity_accessiblity=access entity_tycon_repr_accessibility=access - entity_modul_contents = notlazy (NewEmptyModuleOrNamespaceType ModuleOrType) + entity_modul_contents = MaybeLazy.Strict (NewEmptyModuleOrNamespaceType ModuleOrType) entity_cpath= cpath entity_typars=LazyWithContext.NotLazy [] entity_tycon_abbrev = None @@ -4697,7 +4705,7 @@ let NewVal (logicalName:string,m:range,compiledName,ty,isMutable,isCompGen,arity let NewCcuContents sref m nm mty = - NewModuleOrNamespace (Some(CompPath(sref,[]))) taccessPublic (ident(nm,m)) XmlDoc.Empty [] (notlazy mty) + NewModuleOrNamespace (Some(CompPath(sref,[]))) taccessPublic (ident(nm,m)) XmlDoc.Empty [] (MaybeLazy.Strict mty) //-------------------------------------------------------------------------- @@ -4719,7 +4727,7 @@ let NewModifiedTycon f (orig:Tycon) = /// contents of the module. let NewModifiedModuleOrNamespace f orig = orig |> NewModifiedTycon (fun d -> - { d with entity_modul_contents = notlazy (f (d.entity_modul_contents.Force())) }) + { d with entity_modul_contents = MaybeLazy.Strict (f (d.entity_modul_contents.Force())) }) /// Create a Val based on an existing one using the function 'f'. /// We require that we be given the parent for the new Val. @@ -4774,7 +4782,7 @@ let CombineCcuContentFragments m l = { data1 with entity_xmldoc = XmlDoc.Merge entity1.XmlDoc entity2.XmlDoc entity_attribs = entity1.Attribs @ entity2.Attribs - entity_modul_contents=lazy (CombineModuleOrNamespaceTypes (path@[entity2.DemangledModuleOrNamespaceName]) entity2.Range entity1.ModuleOrNamespaceType entity2.ModuleOrNamespaceType) }) + entity_modul_contents = MaybeLazy.Lazy (lazy (CombineModuleOrNamespaceTypes (path@[entity2.DemangledModuleOrNamespaceName]) entity2.Range entity1.ModuleOrNamespaceType entity2.ModuleOrNamespaceType)) }) | false,false -> error(Error(FSComp.SR.tastDuplicateTypeDefinitionInAssembly(entity2.LogicalName, textOfPath path),entity2.Range)) | _,_ -> diff --git a/src/fsharp/vs/service.fs b/src/fsharp/vs/service.fs index 50601932982360553a6fffa6a3affd5f84c6d9f1..a99509e567ffeb33a747d50713ce5ccb4a78cde5 100644 --- a/src/fsharp/vs/service.fs +++ b/src/fsharp/vs/service.fs @@ -544,19 +544,19 @@ type TypeCheckInfo /// Find the most precise naming environment for the given line and column let GetBestEnvForPos cursorPos = - let bestSoFar = ref None + let mutable bestSoFar = None // Find the most deeply nested enclosing scope that contains given position sResolutions.CapturedEnvs |> ResizeArray.iter (fun (possm,env,ad) -> if rangeContainsPos possm cursorPos then - match !bestSoFar with + match bestSoFar with | Some (bestm,_,_) -> if rangeContainsRange bestm possm then - bestSoFar := Some (possm,env,ad) + bestSoFar <- Some (possm,env,ad) | None -> - bestSoFar := Some (possm,env,ad)) + bestSoFar <- Some (possm,env,ad)) - let mostDeeplyNestedEnclosingScope = !bestSoFar + let mostDeeplyNestedEnclosingScope = bestSoFar // Look for better subtrees on the r.h.s. of the subtree to the left of where we are // Should really go all the way down the r.h.s. of the subtree to the left of where we are @@ -1140,13 +1140,18 @@ type TypeCheckInfo static let keywordTypes = Lexhelp.Keywords.keywordTypes - member x.GetVisibleNamespacesAndModulesAtPosition(cursorPos: pos) : ModuleOrNamespaceRef list = - let (nenv, ad), m = GetBestEnvForPos cursorPos - NameResolution.GetVisibleNamespacesAndModulesAtPoint ncenv nenv m ad - member x.IsRelativeNameResolvable(cursorPos: pos, plid: string list, item: Item) : bool = - let items, _, _ = GetEnvironmentLookupResolutions(cursorPos, plid, TypeNameResolutionFlag.ResolveTypeNamesToTypeRefs, true) - items |> List.exists (ItemsAreEffectivelyEqual g item) + /// Determines if a long ident is resolvable at a specific point. + ErrorScope.Protect + Range.range0 + (fun () -> + /// Find items in the best naming environment. + let (nenv, ad), m = GetBestEnvForPos cursorPos + NameResolution.IsItemResolvable ncenv nenv m ad plid item) + (fun _ -> false) + + //let items = NameResolution.ResolvePartialLongIdent ncenv nenv (fun _ _ -> true) m ad plid true + //items |> List.exists (ItemsAreEffectivelyEqual g item) /// Get the auto-complete items at a location member x.GetDeclarations (ctok, parseResultsOpt, line, lineStr, colAtEndOfNamesAndResidue, qualifyingNames, partialName, hasTextChangedSinceLastTypecheck) = @@ -2133,18 +2138,9 @@ type FSharpCheckFileResults(errors: FSharpErrorInfo[], scopeOptX: TypeCheckInfo if itemOcc <> ItemOccurence.RelatedText then yield FSharpSymbolUse(scope.TcGlobals, denv, symbol, itemOcc, m) |]) - member info.GetVisibleNamespacesAndModulesAtPoint(pos: pos) : Async = - reactorOp "GetVisibleNamespacesAndModulesAtPoint" [| |] (fun ctok scope -> - - DoesNotRequireCompilerThreadTokenAndCouldPossiblyBeMadeConcurrent ctok - - scope.GetVisibleNamespacesAndModulesAtPosition(pos) |> List.toArray) - member info.IsRelativeNameResolvable(pos: pos, plid: string list, item: Item) : Async = reactorOp "IsRelativeNameResolvable" true (fun ctok scope -> - DoesNotRequireCompilerThreadTokenAndCouldPossiblyBeMadeConcurrent ctok - scope.IsRelativeNameResolvable(pos, plid, item)) //---------------------------------------------------------------------------- diff --git a/src/fsharp/vs/service.fsi b/src/fsharp/vs/service.fsi index b3b0c684ca285ee5e4423620bb099e822e519a84..60a307dac270ba8d898d6f3c7a7b54949b4cce7f 100755 --- a/src/fsharp/vs/service.fsi +++ b/src/fsharp/vs/service.fsi @@ -298,10 +298,8 @@ type internal FSharpCheckFileResults = /// Get the textual usages that resolved to the given symbol throughout the file member GetUsesOfSymbolInFile : symbol:FSharpSymbol -> Async - member GetVisibleNamespacesAndModulesAtPoint : pos -> Async - + /// Determines if a long ident is resolvable at a specific point. member IsRelativeNameResolvable: cursorPos : pos * plid : string list * item: Item -> Async - /// A handle to the results of CheckFileInProject. [] type internal FSharpCheckProjectResults = diff --git a/vsintegration/src/FSharp.Editor/Diagnostics/SimplifyNameDiagnosticAnalyzer.fs b/vsintegration/src/FSharp.Editor/Diagnostics/SimplifyNameDiagnosticAnalyzer.fs index 0f6b571b3091a87f4518ff923f1d656860fb2294..b9c006dd4715e492abbc07c859c19c54c5079366 100644 --- a/vsintegration/src/FSharp.Editor/Diagnostics/SimplifyNameDiagnosticAnalyzer.fs +++ b/vsintegration/src/FSharp.Editor/Diagnostics/SimplifyNameDiagnosticAnalyzer.fs @@ -17,15 +17,18 @@ open Microsoft.FSharp.Compiler.SourceCodeServices open Microsoft.VisualStudio.FSharp.LanguageService -type private LineHash = int +type private TextVersionHash = int -//[] +// TODO Turn it on when user settings dialog is ready to switch it on and off. +// [] type internal SimplifyNameDiagnosticAnalyzer() = inherit DocumentDiagnosticAnalyzer() let getProjectInfoManager (document: Document) = document.Project.Solution.Workspace.Services.GetService().ProjectInfoManager let getChecker (document: Document) = document.Project.Solution.Workspace.Services.GetService().Checker let getPlidLength (plid: string list) = (plid |> List.sumBy String.length) + plid.Length + static let cache = ConditionalWeakTable>() + static let guard = new SemaphoreSlim(1) static let Descriptor = DiagnosticDescriptor( @@ -42,75 +45,85 @@ type internal SimplifyNameDiagnosticAnalyzer() = static member LongIdentPropertyKey = "FullName" override __.SupportedDiagnostics = ImmutableArray.Create Descriptor + override this.AnalyzeSyntaxAsync(_, _) = Task.FromResult ImmutableArray.Empty - override this.AnalyzeSyntaxAsync(document: Document, cancellationToken: CancellationToken) = + override this.AnalyzeSemanticsAsync(document: Document, cancellationToken: CancellationToken) = asyncMaybe { match getProjectInfoManager(document).TryGetOptionsForEditingDocumentOrProject(document) with | Some options -> - let! sourceText = document.GetTextAsync() - let checker = getChecker document - let! _, _, checkResults = checker.ParseAndCheckDocument(document, options, sourceText = sourceText, allowStaleResults = true) - let! symbolUses = checkResults.GetAllUsesOfAllSymbolsInFile() |> liftAsync - let mutable result = ResizeArray() - let symbolUses = - symbolUses - |> Array.Parallel.map (fun symbolUse -> - let lineStr = sourceText.Lines.[Line.toZ symbolUse.RangeAlternate.StartLine].ToString() - // for `System.DateTime.Now` it returns ([|"System"; "DateTime"|], "Now") - let plid, name = QuickParse.GetPartialLongNameEx(lineStr, symbolUse.RangeAlternate.EndColumn - 1) - // `symbolUse.RangeAlternate.Start` does not point to the start of plid, it points to start of `name`, - // so we have to calculate plid's start ourselves. - let plidStartCol = symbolUse.RangeAlternate.EndColumn - name.Length - (getPlidLength plid) - symbolUse, plid, plidStartCol, name) - |> Array.filter (fun (_, plid, _, _) -> not (List.isEmpty plid)) - |> Array.groupBy (fun (symbolUse, _, plidStartCol, _) -> symbolUse.RangeAlternate.StartLine, plidStartCol) - |> Array.map (fun (_, xs) -> xs |> Array.maxBy (fun (symbolUse, _, _, _) -> symbolUse.RangeAlternate.EndColumn)) - - for symbolUse, plid, plidStartCol, name in symbolUses do - if not symbolUse.IsFromDefinition then - let posAtStartOfName = - let r = symbolUse.RangeAlternate - if r.StartLine = r.EndLine then Range.mkPos r.StartLine (r.EndColumn - name.Length) - else r.Start - - let getNecessaryPlid (plid: string list) : Async = - let rec loop (rest: string list) (current: string list) = - async { - match rest with - | [] -> return current - | headIdent :: restPlid -> - let! res = checkResults.IsRelativeNameResolvable(posAtStartOfName, current, symbolUse.Symbol.Item) - if res then return current - else return! loop restPlid (headIdent :: current) - } - loop (List.rev plid) [] - - let! necessaryPlid = getNecessaryPlid plid |> liftAsync - - match necessaryPlid with - | necessaryPlid when necessaryPlid = plid -> () - | necessaryPlid -> - let r = symbolUse.RangeAlternate - let necessaryPlidStartCol = r.EndColumn - name.Length - (getPlidLength necessaryPlid) - - let unnecessaryRange = - Range.mkRange r.FileName (Range.mkPos r.StartLine plidStartCol) (Range.mkPos r.EndLine necessaryPlidStartCol) - - let relativeName = (String.concat "." plid) + "." + name - result.Add( - Diagnostic.Create( - Descriptor, - CommonRoslynHelpers.RangeToLocation(unnecessaryRange, sourceText, document.FilePath), - properties = (dict [SimplifyNameDiagnosticAnalyzer.LongIdentPropertyKey, relativeName]).ToImmutableDictionary())) - - return result.ToImmutableArray() + let! textVersion = document.GetTextVersionAsync(cancellationToken) + let textVersionHash = textVersion.GetHashCode() + let! _ = guard.WaitAsync(cancellationToken) |> Async.AwaitTask |> liftAsync + try + match cache.TryGetValue document.Id with + | true, (oldTextVersionHash, diagnostics) when oldTextVersionHash = textVersionHash -> return diagnostics + | _ -> + let! sourceText = document.GetTextAsync() + let checker = getChecker document + let! _, _, checkResults = checker.ParseAndCheckDocument(document, options, sourceText = sourceText, allowStaleResults = true) + let! symbolUses = checkResults.GetAllUsesOfAllSymbolsInFile() |> liftAsync + let mutable result = ResizeArray() + let symbolUses = + symbolUses + |> Array.Parallel.map (fun symbolUse -> + let lineStr = sourceText.Lines.[Line.toZ symbolUse.RangeAlternate.StartLine].ToString() + // for `System.DateTime.Now` it returns ([|"System"; "DateTime"|], "Now") + let plid, name = QuickParse.GetPartialLongNameEx(lineStr, symbolUse.RangeAlternate.EndColumn - 1) + // `symbolUse.RangeAlternate.Start` does not point to the start of plid, it points to start of `name`, + // so we have to calculate plid's start ourselves. + let plidStartCol = symbolUse.RangeAlternate.EndColumn - name.Length - (getPlidLength plid) + symbolUse, plid, plidStartCol, name) + |> Array.filter (fun (_, plid, _, _) -> not (List.isEmpty plid)) + |> Array.groupBy (fun (symbolUse, _, plidStartCol, _) -> symbolUse.RangeAlternate.StartLine, plidStartCol) + |> Array.map (fun (_, xs) -> xs |> Array.maxBy (fun (symbolUse, _, _, _) -> symbolUse.RangeAlternate.EndColumn)) + + for symbolUse, plid, plidStartCol, name in symbolUses do + if not symbolUse.IsFromDefinition then + let posAtStartOfName = + let r = symbolUse.RangeAlternate + if r.StartLine = r.EndLine then Range.mkPos r.StartLine (r.EndColumn - name.Length) + else r.Start + + let getNecessaryPlid (plid: string list) : Async = + let rec loop (rest: string list) (current: string list) = + async { + match rest with + | [] -> return current + | headIdent :: restPlid -> + let! res = checkResults.IsRelativeNameResolvable(posAtStartOfName, current, symbolUse.Symbol.Item) + if res then return current + else return! loop restPlid (headIdent :: current) + } + loop (List.rev plid) [] + + let! necessaryPlid = getNecessaryPlid plid |> liftAsync + + match necessaryPlid with + | necessaryPlid when necessaryPlid = plid -> () + | necessaryPlid -> + let r = symbolUse.RangeAlternate + let necessaryPlidStartCol = r.EndColumn - name.Length - (getPlidLength necessaryPlid) + + let unnecessaryRange = + Range.mkRange r.FileName (Range.mkPos r.StartLine plidStartCol) (Range.mkPos r.EndLine necessaryPlidStartCol) + + let relativeName = (String.concat "." plid) + "." + name + result.Add( + Diagnostic.Create( + Descriptor, + CommonRoslynHelpers.RangeToLocation(unnecessaryRange, sourceText, document.FilePath), + properties = (dict [SimplifyNameDiagnosticAnalyzer.LongIdentPropertyKey, relativeName]).ToImmutableDictionary())) + + let diagnostics = result.ToImmutableArray() + cache.Remove(document.Id) |> ignore + cache.Add(document.Id, (textVersionHash, diagnostics)) + return diagnostics + finally guard.Release() |> ignore | None -> return ImmutableArray.Empty } |> Async.map (Option.defaultValue ImmutableArray.Empty) |> CommonRoslynHelpers.StartAsyncAsTask cancellationToken - override this.AnalyzeSemanticsAsync(_, _) = Task.FromResult ImmutableArray.Empty - interface IBuiltInAnalyzer with member __.OpenFileOnly _ = true member __.GetAnalyzerCategory() = DiagnosticAnalyzerCategory.SemanticDocumentAnalysis \ No newline at end of file