From 0708d2fce432972983bcfbd66558d49e0c8ef4dc Mon Sep 17 00:00:00 2001 From: kerams Date: Wed, 25 Jan 2023 20:06:54 +0100 Subject: [PATCH 1/2] Refactor ResolveLongIdentAsModuleOrNamespace --- src/Compiler/Checking/NameResolution.fs | 55 ++++++++++--------------- 1 file changed, 21 insertions(+), 34 deletions(-) diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index 6bc0b3e73b7..ee1700094cb 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -2385,7 +2385,7 @@ let rec ResolveLongIdentAsModuleOrNamespace sink (atMostOne: ResultCollectionSet UndefinedName(depth, error, id, suggestNames) let moduleOrNamespaces = nenv.ModulesAndNamespaces fullyQualified - let namespaceNotFound = + let namespaceOrModuleNotFound = lazy seq { for kv in moduleOrNamespaces do for modref in kv.Value do @@ -2394,9 +2394,9 @@ let rec ResolveLongIdentAsModuleOrNamespace sink (atMostOne: ResultCollectionSet // Avoid generating the same error and name suggestion thunk twice It's not clear this is necessary // since it's just saving an allocation. - let mutable moduleNotFoundErrorCache = None - let moduleNotFound (modref: ModuleOrNamespaceRef) (mty: ModuleOrNamespaceType) (id: Ident) depth = - match moduleNotFoundErrorCache with + let mutable namespaceNotFoundErrorCache = None + let namespaceNotFound (modref: ModuleOrNamespaceRef) (mty: ModuleOrNamespaceType) (id: Ident) depth = + match namespaceNotFoundErrorCache with | Some (oldId, error) when equals oldId id.idRange -> error | _ -> let error = @@ -2404,7 +2404,7 @@ let rec ResolveLongIdentAsModuleOrNamespace sink (atMostOne: ResultCollectionSet modref.NestedTyconRef kv.Value } |> notFoundAux id depth FSComp.SR.undefinedNameNamespace let error = raze error - moduleNotFoundErrorCache <- Some(id.idRange, error) + namespaceNotFoundErrorCache <- Some(id.idRange, error) error let notifyNameResolution (modref: ModuleOrNamespaceRef) m = @@ -2412,48 +2412,35 @@ let rec ResolveLongIdentAsModuleOrNamespace sink (atMostOne: ResultCollectionSet let occurence = if isOpenDecl then ItemOccurence.Open else ItemOccurence.Use CallNameResolutionSink sink (m, nenv, item, emptyTyparInst, occurence, ad) - let modrefs = - match moduleOrNamespaces.TryGetValue id.idText with - | true, modrefs -> modrefs - | _ -> [] - - if not modrefs.IsEmpty then + match moduleOrNamespaces.TryGetValue id.idText with + | true, modrefs when not modrefs.IsEmpty -> /// Look through the sub-namespaces and/or modules let rec look depth (modref: ModuleOrNamespaceRef) (lid: Ident list) = let mty = modref.ModuleOrNamespaceType - match lid with - | [] -> - success [ (depth, modref, mty) ] + match lid with + | [] -> success [ (depth, modref, mty) ] | id :: rest -> - let modrefs = - match mty.ModulesAndNamespacesByDemangledName.TryGetValue id.idText with - | true, res -> [res] - | _ -> [] - - if not modrefs.IsEmpty then - modrefs - |> List.map (fun espec -> - let subref = modref.NestedTyconRef espec - if IsEntityAccessible amap m ad subref then - notifyNameResolution subref id.idRange - look (depth+1) subref rest - else - moduleNotFound modref mty id depth) - |> List.reduce AddResults - else - moduleNotFound modref mty id depth + match mty.ModulesAndNamespacesByDemangledName.TryGetValue id.idText with + | true, res -> + let subref = modref.NestedTyconRef res + if IsEntityAccessible amap m ad subref then + notifyNameResolution subref id.idRange + look (depth + 1) subref rest + else + namespaceNotFound modref mty id depth + | _ -> namespaceNotFound modref mty id depth + modrefs |> List.map (fun modref -> if IsEntityAccessible amap m ad modref then notifyNameResolution modref id.idRange look 1 modref rest else - raze (namespaceNotFound.Force())) + raze (namespaceOrModuleNotFound.Force())) |> List.reduce AddResults - else - raze (namespaceNotFound.Force()) + | _ -> raze (namespaceOrModuleNotFound.Force()) // Note - 'rest' is annotated due to a bug currently in Unity (see: https://github.com/dotnet/fsharp/pull/7427) let ResolveLongIdentAsModuleOrNamespaceThen sink atMostOne amap m fullyQualified (nenv: NameResolutionEnv) ad id (rest: Ident list) isOpenDecl f = From 91b091960555c98bb118af864ce9f232904138bf Mon Sep 17 00:00:00 2001 From: kerams Date: Thu, 26 Jan 2023 15:16:34 +0100 Subject: [PATCH 2/2] Remove unused parameter --- src/Compiler/Checking/CheckDeclarations.fs | 8 ++++---- src/Compiler/Checking/CheckExpressions.fs | 4 ++-- src/Compiler/Checking/NameResolution.fs | 6 +++--- src/Compiler/Checking/NameResolution.fsi | 1 - 4 files changed, 9 insertions(+), 10 deletions(-) diff --git a/src/Compiler/Checking/CheckDeclarations.fs b/src/Compiler/Checking/CheckDeclarations.fs index d858368cd60..7f11c895550 100644 --- a/src/Compiler/Checking/CheckDeclarations.fs +++ b/src/Compiler/Checking/CheckDeclarations.fs @@ -362,7 +362,7 @@ let ImplicitlyOpenOwnNamespace tcSink g amap scopem enclosingNamespacePath (env: match enclosingNamespacePathToOpen with | id :: rest -> let ad = env.AccessRights - match ResolveLongIdentAsModuleOrNamespace tcSink ResultCollectionSettings.AllResults amap scopem true OpenQualified env.eNameResEnv ad id rest true with + match ResolveLongIdentAsModuleOrNamespace tcSink amap scopem true OpenQualified env.eNameResEnv ad id rest true with | Result modrefs -> let modrefs = List.map p23 modrefs let lid = SynLongIdent(enclosingNamespacePathToOpen, [] , []) @@ -637,7 +637,7 @@ let TcOpenLidAndPermitAutoResolve tcSink (env: TcEnv) amap (longId : Ident list) | [] -> [] | id :: rest -> let m = longId |> List.map (fun id -> id.idRange) |> List.reduce unionRanges - match ResolveLongIdentAsModuleOrNamespace tcSink ResultCollectionSettings.AllResults amap m true OpenQualified env.NameEnv ad id rest true with + match ResolveLongIdentAsModuleOrNamespace tcSink amap m true OpenQualified env.NameEnv ad id rest true with | Result res -> res | Exception err -> errorR(err); [] @@ -1440,7 +1440,7 @@ module MutRecBindingChecking = let resolved = match p with | [] -> Result [] - | id :: rest -> ResolveLongIdentAsModuleOrNamespace cenv.tcSink ResultCollectionSettings.AllResults cenv.amap m true OpenQualified env.NameEnv ad id rest false + | id :: rest -> ResolveLongIdentAsModuleOrNamespace cenv.tcSink cenv.amap m true OpenQualified env.NameEnv ad id rest false let mvvs = ForceRaise resolved @@ -4564,7 +4564,7 @@ let rec TcSignatureElementNonMutRec (cenv: cenv) parent typeNames endm (env: TcE let resolved = match p with | [] -> Result [] - | id :: rest -> ResolveLongIdentAsModuleOrNamespace cenv.tcSink ResultCollectionSettings.AllResults cenv.amap m true OpenQualified env.NameEnv ad id rest false + | id :: rest -> ResolveLongIdentAsModuleOrNamespace cenv.tcSink cenv.amap m true OpenQualified env.NameEnv ad id rest false let mvvs = ForceRaise resolved let scopem = unionRanges m endm let unfilteredModrefs = mvvs |> List.map p23 diff --git a/src/Compiler/Checking/CheckExpressions.fs b/src/Compiler/Checking/CheckExpressions.fs index 4c1c47f53b0..f260336cd48 100644 --- a/src/Compiler/Checking/CheckExpressions.fs +++ b/src/Compiler/Checking/CheckExpressions.fs @@ -7218,7 +7218,7 @@ and TcConstExpr cenv (overallTy: OverallTy) env m tpenv c = let expr = let modName = "NumericLiteral" + suffix let ad = env.eAccessRights - match ResolveLongIdentAsModuleOrNamespace cenv.tcSink ResultCollectionSettings.AtMostOneResult cenv.amap m true OpenQualified env.eNameResEnv ad (ident (modName, m)) [] false with + match ResolveLongIdentAsModuleOrNamespace cenv.tcSink cenv.amap m true OpenQualified env.eNameResEnv ad (ident (modName, m)) [] false with | Result [] | Exception _ -> error(Error(FSComp.SR.tcNumericLiteralRequiresModule modName, m)) | Result ((_, mref, _) :: _) -> @@ -7958,7 +7958,7 @@ and TcNameOfExpr (cenv: cenv) env tpenv (synArg: SynExpr) = let resolvedToModuleOrNamespaceName = if delayed.IsEmpty then let id,rest = List.headAndTail longId - match ResolveLongIdentAsModuleOrNamespace cenv.tcSink ResultCollectionSettings.AllResults cenv.amap m true OpenQualified env.eNameResEnv ad id rest true with + match ResolveLongIdentAsModuleOrNamespace cenv.tcSink cenv.amap m true OpenQualified env.eNameResEnv ad id rest true with | Result modref when delayed.IsEmpty && modref |> List.exists (p23 >> IsEntityAccessible cenv.amap m ad) -> true // resolved to a module or namespace, done with checks | _ -> diff --git a/src/Compiler/Checking/NameResolution.fs b/src/Compiler/Checking/NameResolution.fs index ee1700094cb..6f9e2865e8c 100644 --- a/src/Compiler/Checking/NameResolution.fs +++ b/src/Compiler/Checking/NameResolution.fs @@ -2368,13 +2368,13 @@ let CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities //------------------------------------------------------------------------- /// Perform name resolution for an identifier which must resolve to be a module or namespace. -let rec ResolveLongIdentAsModuleOrNamespace sink (atMostOne: ResultCollectionSettings) (amap: Import.ImportMap) m first fullyQualified (nenv: NameResolutionEnv) ad (id:Ident) (rest: Ident list) isOpenDecl = +let rec ResolveLongIdentAsModuleOrNamespace sink (amap: Import.ImportMap) m first fullyQualified (nenv: NameResolutionEnv) ad (id:Ident) (rest: Ident list) isOpenDecl = if first && id.idText = MangledGlobalName then match rest with | [] -> error (Error(FSComp.SR.nrGlobalUsedOnlyAsFirstName(), id.idRange)) | id2 :: rest2 -> - ResolveLongIdentAsModuleOrNamespace sink atMostOne amap m false FullyQualified nenv ad id2 rest2 isOpenDecl + ResolveLongIdentAsModuleOrNamespace sink amap m false FullyQualified nenv ad id2 rest2 isOpenDecl else let notFoundAux (id: Ident) depth error (tcrefs: TyconRef seq) = let suggestNames (addToBuffer: string -> unit) = @@ -2444,7 +2444,7 @@ let rec ResolveLongIdentAsModuleOrNamespace sink (atMostOne: ResultCollectionSet // Note - 'rest' is annotated due to a bug currently in Unity (see: https://github.com/dotnet/fsharp/pull/7427) let ResolveLongIdentAsModuleOrNamespaceThen sink atMostOne amap m fullyQualified (nenv: NameResolutionEnv) ad id (rest: Ident list) isOpenDecl f = - match ResolveLongIdentAsModuleOrNamespace sink ResultCollectionSettings.AllResults amap m true fullyQualified nenv ad id [] isOpenDecl with + match ResolveLongIdentAsModuleOrNamespace sink amap m true fullyQualified nenv ad id [] isOpenDecl with | Result modrefs -> match rest with | [] -> error(Error(FSComp.SR.nrUnexpectedEmptyLongId(), id.idRange)) diff --git a/src/Compiler/Checking/NameResolution.fsi b/src/Compiler/Checking/NameResolution.fsi index c93881d7712..edef121ed5a 100755 --- a/src/Compiler/Checking/NameResolution.fsi +++ b/src/Compiler/Checking/NameResolution.fsi @@ -663,7 +663,6 @@ val FreshenRecdFieldRef: NameResolver -> range -> RecdFieldRef -> RecdFieldInfo /// Resolve a long identifier to a namespace, module. val internal ResolveLongIdentAsModuleOrNamespace: sink: TcResultsSink -> - atMostOne: ResultCollectionSettings -> amap: ImportMap -> m: range -> first: bool ->