Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Refactor ResolveLongIdentAsModuleOrNamespace #14661

Merged
merged 3 commits into from
Feb 13, 2023
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
8 changes: 4 additions & 4 deletions src/Compiler/Checking/CheckDeclarations.fs
Original file line number Diff line number Diff line change
Expand Up @@ -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, [] , [])
Expand Down Expand Up @@ -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); []
Expand Down Expand Up @@ -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

Expand Down Expand Up @@ -4575,7 +4575,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
Expand Down
4 changes: 2 additions & 2 deletions src/Compiler/Checking/CheckExpressions.fs
Original file line number Diff line number Diff line change
Expand Up @@ -7225,7 +7225,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, _) :: _) ->
Expand Down Expand Up @@ -7965,7 +7965,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
| _ ->
Expand Down
61 changes: 24 additions & 37 deletions src/Compiler/Checking/NameResolution.fs
Original file line number Diff line number Diff line change
Expand Up @@ -2373,13 +2373,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) =
Expand All @@ -2390,7 +2390,7 @@ let rec ResolveLongIdentAsModuleOrNamespace sink (atMostOne: ResultCollectionSet
UndefinedName(depth, error, id, suggestNames)

let moduleOrNamespaces = nenv.ModulesAndNamespaces fullyQualified
let namespaceNotFound =
let namespaceOrModuleNotFound =
kerams marked this conversation as resolved.
Show resolved Hide resolved
lazy
seq { for kv in moduleOrNamespaces do
for modref in kv.Value do
Expand All @@ -2399,70 +2399,57 @@ 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
kerams marked this conversation as resolved.
Show resolved Hide resolved
| Some (oldId, error) when equals oldId id.idRange -> error
| _ ->
let error =
seq { for kv in mty.ModulesAndNamespacesByDemangledName do
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 =
let item = Item.ModuleOrNamespaces [modref]
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 =
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))
Expand Down
1 change: 0 additions & 1 deletion src/Compiler/Checking/NameResolution.fsi
Original file line number Diff line number Diff line change
Expand Up @@ -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 ->
Expand Down