Skip to content

Improve perf on CollectResults #2018

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.

Sign up for GitHub

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

Merged
merged 10 commits into from
Dec 15, 2016
Merged

Improve perf on CollectResults #2018

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
10 commits
Select commit Hold shift + click to select a range
cdc2cc9
CollectAtMostOneResult
forki Dec 15, 2016
2437fd4
couple more simple cases
forki Dec 15, 2016
4d81e5b
More places
forki Dec 15, 2016
0612035
yet another place
forki Dec 15, 2016
16531fd
yet another place
forki Dec 15, 2016
b1cfc88
yet another place
forki Dec 15, 2016
5b5ccc9
Another case
forki Dec 15, 2016
3243836
Made another decision - we can't optimize this case
forki Dec 15, 2016
293b69b
cleanup
forki Dec 15, 2016
d0cb6f7
Use enum
forki Dec 15, 2016
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
96 changes: 56 additions & 40 deletions src/fsharp/NameResolution.fs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -855,11 +855,30 @@ let AddResults res1 res2 =
let (+++) x y = AddResults x y
let NoResultsOrUsefulErrors = Result []

/// Indicates if we only need one result or all possible results from a resolution.
[<RequireQualifiedAccess>]
type ResultCollectionSettings =
| AllResults
| AtMostOneResult

let rec CollectResults f = function
| [] -> NoResultsOrUsefulErrors
| [h] -> OneResult (f h)
| h :: t -> AddResults (OneResult (f h)) (CollectResults f t)

let rec CollectAtMostOneResult f = function
| [] -> NoResultsOrUsefulErrors
| [h] -> OneResult (f h)
| h :: t ->
match f h with
| Result r -> Result [r]
| Exception e -> AddResults (Exception e) (CollectAtMostOneResult f t)

let CollectResults2 resultCollectionSettings f =
match resultCollectionSettings with
| ResultCollectionSettings.AtMostOneResult -> CollectAtMostOneResult f
| _ -> CollectResults f

let MapResults f = function
| Result xs -> Result (List.map f xs)
| Exception err -> Exception err
Expand Down Expand Up @@ -1629,16 +1648,15 @@ let CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities
//-------------------------------------------------------------------------

/// Perform name resolution for an identifier which must resolve to be a namespace or module.
let rec ResolveLongIndentAsModuleOrNamespace amap m fullyQualified (nenv:NameResolutionEnv) ad (lid:Ident list) =
let rec ResolveLongIndentAsModuleOrNamespace atMostOne amap m fullyQualified (nenv:NameResolutionEnv) ad (lid:Ident list) =
match lid with
| [] -> NoResultsOrUsefulErrors

| [id] when id.idText = MangledGlobalName ->
error (Error(FSComp.SR.nrGlobalUsedOnlyAsFirstName(), id.idRange))


| id :: lid when id.idText = MangledGlobalName ->
ResolveLongIndentAsModuleOrNamespace amap m FullyQualified nenv ad lid
ResolveLongIndentAsModuleOrNamespace atMostOne amap m FullyQualified nenv ad lid

| id:: rest ->
match nenv.ModulesAndNamespaces(fullyQualified).TryFind(id.idText) with
Expand All @@ -1655,7 +1673,7 @@ let rec ResolveLongIndentAsModuleOrNamespace amap m fullyQualified (nenv:NameRes
look (depth+1) subref mspec.ModuleOrNamespaceType rest
| _ -> raze (UndefinedName(depth,FSComp.SR.undefinedNameNamespace,id,NoPredictions))

modrefs |> CollectResults (fun modref ->
modrefs |> CollectResults2 atMostOne (fun modref ->
if IsEntityAccessible amap m ad modref then
look 1 modref modref.ModuleOrNamespaceType rest
else
Expand All @@ -1664,13 +1682,13 @@ let rec ResolveLongIndentAsModuleOrNamespace amap m fullyQualified (nenv:NameRes
raze (UndefinedName(0,FSComp.SR.undefinedNameNamespaceOrModule,id,NoPredictions))


let ResolveLongIndentAsModuleOrNamespaceThen amap m fullyQualified (nenv:NameResolutionEnv) ad lid f =
let ResolveLongIndentAsModuleOrNamespaceThen atMostOne amap m fullyQualified (nenv:NameResolutionEnv) ad lid f =
match lid with
| [] -> NoResultsOrUsefulErrors
| id :: rest ->
match ResolveLongIndentAsModuleOrNamespace amap m fullyQualified nenv ad [id] with
match ResolveLongIndentAsModuleOrNamespace ResultCollectionSettings.AllResults amap m fullyQualified nenv ad [id] with
| Result modrefs ->
modrefs |> CollectResults (fun (depth,modref,mty) ->
modrefs |> CollectResults2 atMostOne (fun (depth,modref,mty) ->
let resInfo = ResolutionInfo.Empty.AddEntity(id.idRange,modref)
f resInfo (depth+1) id.idRange modref mty rest)
| Exception err -> Exception err
Expand Down Expand Up @@ -1943,7 +1961,7 @@ let rec ResolveLongIdentInTypePrim (ncenv:NameResolver) nenv lookupKind (resInfo
match typeNameResInfo.ResolutionFlag with
| ResolveTypeNamesToCtors ->
nestedTypes
|> CollectResults (ResolveObjectConstructorPrim ncenv nenv.eDisplayEnv resInfo m ad)
|> CollectAtMostOneResult (ResolveObjectConstructorPrim ncenv nenv.eDisplayEnv resInfo m ad)
|> MapResults (fun (resInfo,item) -> (resInfo,item,[]))
| ResolveTypeNamesToTypeRefs ->
OneSuccess (resInfo,Item.Types (nm,nestedTypes),rest)
Expand All @@ -1953,7 +1971,7 @@ let rec ResolveLongIdentInTypePrim (ncenv:NameResolver) nenv lookupKind (resInfo
contentsSearchAccessible +++ nestedSearchAccessible

and ResolveLongIdentInNestedTypes (ncenv:NameResolver) nenv lookupKind resInfo depth id m ad lid findFlag typeNameResInfo typs =
typs |> CollectResults (fun typ ->
typs |> CollectAtMostOneResult (fun typ ->
let resInfo = if isAppTy ncenv.g typ then resInfo.AddEntity(id.idRange,tcrefOfAppTy ncenv.g typ) else resInfo
ResolveLongIdentInTypePrim ncenv nenv lookupKind resInfo depth m ad lid findFlag typeNameResInfo typ
|> AtMostOneResult m)
Expand All @@ -1975,8 +1993,8 @@ let private ResolveLongIdentInTyconRef (ncenv:NameResolver) nenv lookupKind resI
let typ = FreshenTycon ncenv m tcref
typ |> ResolveLongIdentInTypePrim ncenv nenv lookupKind resInfo depth m ad lid IgnoreOverrides typeNameResInfo

let private ResolveLongIdentInTyconRefs (ncenv:NameResolver) nenv lookupKind depth m ad lid typeNameResInfo idRange tcrefs =
tcrefs |> CollectResults (fun (resInfo:ResolutionInfo,tcref) ->
let private ResolveLongIdentInTyconRefs atMostOne (ncenv:NameResolver) nenv lookupKind depth m ad lid typeNameResInfo idRange tcrefs =
tcrefs |> CollectResults2 atMostOne (fun (resInfo:ResolutionInfo,tcref) ->
let resInfo = resInfo.AddEntity(idRange,tcref)
tcref |> ResolveLongIdentInTyconRef ncenv nenv lookupKind resInfo depth m ad lid typeNameResInfo |> AtMostOneResult m)

Expand Down Expand Up @@ -2023,7 +2041,7 @@ let rec ResolveExprLongIdentInModuleOrNamespace (ncenv:NameResolver) nenv (typeN
let tcrefs = tcrefs |> List.map (fun tcref -> (resInfo,tcref))
if not (isNil rest) then
let tcrefs = CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities (tcrefs, TypeNameResolutionInfo (ResolveTypeNamesToTypeRefs,TypeNameResolutionStaticArgsInfo.Indefinite), PermitDirectReferenceToGeneratedType.No, unionRanges m id.idRange)
ResolveLongIdentInTyconRefs ncenv nenv LookupKind.Expr (depth+1) m ad rest typeNameResInfo id.idRange tcrefs
ResolveLongIdentInTyconRefs ResultCollectionSettings.AtMostOneResult ncenv nenv LookupKind.Expr (depth+1) m ad rest typeNameResInfo id.idRange tcrefs
// Check if we've got some explicit type arguments
else
let tcrefs = CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities (tcrefs, typeNameResInfo, PermitDirectReferenceToGeneratedType.No, unionRanges m id.idRange)
Expand All @@ -2036,7 +2054,7 @@ let rec ResolveExprLongIdentInModuleOrNamespace (ncenv:NameResolver) nenv (typeN
| ResolveTypeNamesToCtors ->
tcrefs
|> List.map (fun (resInfo, tcref) -> resInfo, FreshenTycon ncenv m tcref)
|> CollectResults (fun (resInfo,typ) -> ResolveObjectConstructorPrim ncenv nenv.eDisplayEnv resInfo id.idRange ad typ)
|> CollectAtMostOneResult (fun (resInfo,typ) -> ResolveObjectConstructorPrim ncenv nenv.eDisplayEnv resInfo id.idRange ad typ)
|> MapResults (fun (resInfo,item) -> (resInfo,item,[]))

match tyconSearch with
Expand Down Expand Up @@ -2073,20 +2091,17 @@ let rec ResolveExprLongIdentInModuleOrNamespace (ncenv:NameResolver) nenv (typeN
/// An identifier has resolved to a type name in an expression (corresponding to one or more TyconRefs).
/// Return either a set of constructors (later refined by overload resolution), or a set of TyconRefs.
let ChooseTyconRefInExpr (ncenv:NameResolver, m, ad, nenv, id:Ident, typeNameResInfo:TypeNameResolutionInfo, resInfo:ResolutionInfo, tcrefs) =

let tcrefs = tcrefs |> List.map (fun tcref -> (resInfo,tcref))
let tcrefs = CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities (tcrefs, typeNameResInfo, PermitDirectReferenceToGeneratedType.No, m)
match typeNameResInfo.ResolutionFlag with
| ResolveTypeNamesToCtors ->
let typs = tcrefs |> List.map (fun (resInfo,tcref) -> (resInfo,FreshenTycon ncenv m tcref))
typs
|> CollectResults (fun (resInfo,typ) -> ResolveObjectConstructorPrim ncenv nenv.eDisplayEnv resInfo id.idRange ad typ)
|> MapResults (fun (resInfo,item) -> (resInfo,item,[]))
| ResolveTypeNamesToTypeRefs ->
let typs = tcrefs |> List.map (fun (resInfo,tcref) -> (resInfo,FreshenTycon ncenv m tcref))
success (typs |> List.map (fun (resInfo,typ) -> (resInfo,Item.Types(id.idText,[typ]),[])))


let tcrefs = tcrefs |> List.map (fun tcref -> (resInfo,tcref))
let tcrefs = CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities (tcrefs, typeNameResInfo, PermitDirectReferenceToGeneratedType.No, m)
match typeNameResInfo.ResolutionFlag with
| ResolveTypeNamesToCtors ->
let typs = tcrefs |> List.map (fun (resInfo,tcref) -> (resInfo,FreshenTycon ncenv m tcref))
typs
|> CollectAtMostOneResult (fun (resInfo,typ) -> ResolveObjectConstructorPrim ncenv nenv.eDisplayEnv resInfo id.idRange ad typ)
|> MapResults (fun (resInfo,item) -> (resInfo,item,[]))
| ResolveTypeNamesToTypeRefs ->
let typs = tcrefs |> List.map (fun (resInfo,tcref) -> (resInfo,FreshenTycon ncenv m tcref))
success (typs |> List.map (fun (resInfo,typ) -> (resInfo,Item.Types(id.idText,[typ]),[])))

/// Resolve F# "A.B.C" syntax in expressions
/// Not all of the sequence will necessarily be swallowed, i.e. we return some identifiers
Expand Down Expand Up @@ -2183,7 +2198,7 @@ let rec ResolveExprLongIdentPrim sink (ncenv:NameResolver) fullyQualified m ad n
// Otherwise modules are searched first. REVIEW: modules and types should be searched together.
// For each module referenced by 'id', search the module as if it were an F# module and/or a .NET namespace.
let moduleSearch ad =
ResolveLongIndentAsModuleOrNamespaceThen ncenv.amap m fullyQualified nenv ad lid
ResolveLongIndentAsModuleOrNamespaceThen ResultCollectionSettings.AtMostOneResult ncenv.amap m fullyQualified nenv ad lid
(ResolveExprLongIdentInModuleOrNamespace ncenv nenv typeNameResInfo ad)

// REVIEW: somewhat surprisingly, this shows up on performance traces, with tcrefs non-nil.
Expand All @@ -2193,7 +2208,7 @@ let rec ResolveExprLongIdentPrim sink (ncenv:NameResolver) fullyQualified m ad n
if List.isEmpty tcrefs then NoResultsOrUsefulErrors else
let tcrefs = tcrefs |> List.map (fun tcref -> (resInfo,tcref))
let tcrefs = CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities (tcrefs, TypeNameResolutionInfo.ResolveToTypeRefs (TypeNameResolutionStaticArgsInfo.Indefinite), PermitDirectReferenceToGeneratedType.No, unionRanges m id.idRange)
ResolveLongIdentInTyconRefs ncenv nenv LookupKind.Expr 1 m ad rest typeNameResInfo id.idRange tcrefs
ResolveLongIdentInTyconRefs ResultCollectionSettings.AtMostOneResult ncenv nenv LookupKind.Expr 1 m ad rest typeNameResInfo id.idRange tcrefs

let search =
let moduleSearch = moduleSearch ad
Expand Down Expand Up @@ -2285,7 +2300,7 @@ let rec ResolvePatternLongIdentInModuleOrNamespace (ncenv:NameResolver) nenv num
let tyconSearch =
match lid with
| _tn:: rest when not (isNil rest) ->
ResolveLongIdentInTyconRefs (ncenv:NameResolver) nenv LookupKind.Pattern (depth+1) m ad rest numTyArgsOpt id.idRange tcrefs
ResolveLongIdentInTyconRefs ResultCollectionSettings.AtMostOneResult (ncenv:NameResolver) nenv LookupKind.Pattern (depth+1) m ad rest numTyArgsOpt id.idRange tcrefs
| _ ->
NoResultsOrUsefulErrors

Expand All @@ -2298,7 +2313,7 @@ let rec ResolvePatternLongIdentInModuleOrNamespace (ncenv:NameResolver) nenv num
if isNil rest then
tcrefs
|> List.map (fun (resInfo,tcref) -> (resInfo,FreshenTycon ncenv m tcref))
|> CollectResults (fun (resInfo,typ) -> ResolveObjectConstructorPrim ncenv nenv.eDisplayEnv resInfo id.idRange ad typ)
|> CollectAtMostOneResult (fun (resInfo,typ) -> ResolveObjectConstructorPrim ncenv nenv.eDisplayEnv resInfo id.idRange ad typ)
|> MapResults (fun (resInfo,item) -> (resInfo,item,[]))
else
NoResultsOrUsefulErrors
Expand Down Expand Up @@ -2357,19 +2372,19 @@ let rec ResolvePatternLongIdentPrim sink (ncenv:NameResolver) fullyQualified war
// Long identifiers in patterns
| _ ->
let moduleSearch ad =
ResolveLongIndentAsModuleOrNamespaceThen ncenv.amap m fullyQualified nenv ad lid
ResolveLongIndentAsModuleOrNamespaceThen ResultCollectionSettings.AtMostOneResult ncenv.amap m fullyQualified nenv ad lid
(ResolvePatternLongIdentInModuleOrNamespace ncenv nenv numTyArgsOpt ad)
let tyconSearch ad =
match lid with
| tn :: rest when not (isNil rest) ->
let tcrefs = LookupTypeNameInEnvNoArity fullyQualified tn.idText nenv
if List.isEmpty tcrefs then NoResultsOrUsefulErrors else
let tcrefs = tcrefs |> List.map (fun tcref -> (ResolutionInfo.Empty,tcref))
ResolveLongIdentInTyconRefs ncenv nenv LookupKind.Pattern 1 tn.idRange ad rest numTyArgsOpt tn.idRange tcrefs
ResolveLongIdentInTyconRefs ResultCollectionSettings.AtMostOneResult ncenv nenv LookupKind.Pattern 1 tn.idRange ad rest numTyArgsOpt tn.idRange tcrefs
| _ ->
NoResultsOrUsefulErrors
let resInfo,res,rest =
match AtMostOneResult m (tyconSearch ad +++ moduleSearch ad) with
match AtMostOneResult m (tyconSearch ad +++ moduleSearch ad) with
| Result _ as res -> ForceRaise res
| _ ->
ForceRaise (AtMostOneResult m (tyconSearch AccessibleFromSomeFSharpCode +++ moduleSearch AccessibleFromSomeFSharpCode))
Expand Down Expand Up @@ -2430,7 +2445,7 @@ let rec ResolveTypeLongIdentInTyconRefPrim (ncenv:NameResolver) (typeNameResInfo
let tcrefs = tcrefs |> List.map (fun tcref -> (resInfo,tcref))
let tcrefs = CheckForTypeLegitimacyAndMultipleGenericTypeAmbiguities (tcrefs, typeNameResInfo.DropStaticArgsInfo, genOk, m)
match tcrefs with
| _ :: _ -> tcrefs |> CollectResults (fun (resInfo,tcref) -> ResolveTypeLongIdentInTyconRefPrim ncenv typeNameResInfo ad resInfo genOk (depth+1) m tcref rest)
| _ :: _ -> tcrefs |> CollectAtMostOneResult (fun (resInfo,tcref) -> ResolveTypeLongIdentInTyconRefPrim ncenv typeNameResInfo ad resInfo genOk (depth+1) m tcref rest)
| [] -> raze (UndefinedName(depth,FSComp.SR.undefinedNameType,id,NoPredictions))

AtMostOneResult m tyconSearch
Expand Down Expand Up @@ -2525,13 +2540,14 @@ let rec ResolveTypeLongIdentPrim (ncenv:NameResolver) fullyQualified m nenv ad (
OneResult (ResolveTypeLongIdentInTyconRefPrim ncenv typeNameResInfo ad ResolutionInfo.Empty genOk 1 m tcref rest)
| _ ->
NoResultsOrUsefulErrors

let modulSearch =
ResolveLongIndentAsModuleOrNamespaceThen ncenv.amap m fullyQualified nenv ad lid
ResolveLongIndentAsModuleOrNamespaceThen ResultCollectionSettings.AllResults ncenv.amap m fullyQualified nenv ad lid
(ResolveTypeLongIdentInModuleOrNamespace ncenv typeNameResInfo ad genOk)
|?> List.concat

let modulSearchFailed() =
ResolveLongIndentAsModuleOrNamespaceThen ncenv.amap m fullyQualified nenv AccessibleFromSomeFSharpCode lid
ResolveLongIndentAsModuleOrNamespaceThen ResultCollectionSettings.AllResults ncenv.amap m fullyQualified nenv AccessibleFromSomeFSharpCode lid
(ResolveTypeLongIdentInModuleOrNamespace ncenv typeNameResInfo.DropStaticArgsInfo AccessibleFromSomeFSharpCode genOk)
|?> List.concat

Expand Down Expand Up @@ -2597,7 +2613,7 @@ let rec ResolveFieldInModuleOrNamespace (ncenv:NameResolver) nenv ad (resInfo:Re
let tcrefs = LookupTypeNameInEntityMaybeHaveArity (ncenv.amap, id.idRange, ad, id.idText, TypeNameResolutionStaticArgsInfo.Indefinite, modref)
if List.isEmpty tcrefs then NoResultsOrUsefulErrors else
let tcrefs = tcrefs |> List.map (fun tcref -> (ResolutionInfo.Empty,tcref))
let tyconSearch = ResolveLongIdentInTyconRefs ncenv nenv LookupKind.RecdField (depth+1) m ad rest typeNameResInfo id.idRange tcrefs
let tyconSearch = ResolveLongIdentInTyconRefs ResultCollectionSettings.AllResults ncenv nenv LookupKind.RecdField (depth+1) m ad rest typeNameResInfo id.idRange tcrefs
// choose only fields
let tyconSearch = tyconSearch |?> List.choose (function (resInfo,Item.RecdField(RecdFieldInfo(_,rfref)),rest) -> Some(resInfo,FieldResolution(rfref,false),rest) | _ -> None)
tyconSearch
Expand Down Expand Up @@ -2718,14 +2734,14 @@ let ResolveFieldPrim (ncenv:NameResolver) nenv ad typ (mp,id:Ident) allFields =
let tcrefs = LookupTypeNameInEnvNoArity OpenQualified tn.idText nenv
if List.isEmpty tcrefs then NoResultsOrUsefulErrors else
let tcrefs = tcrefs |> List.map (fun tcref -> (ResolutionInfo.Empty,tcref))
let tyconSearch = ResolveLongIdentInTyconRefs ncenv nenv LookupKind.RecdField 1 m ad rest typeNameResInfo tn.idRange tcrefs
let tyconSearch = ResolveLongIdentInTyconRefs ResultCollectionSettings.AllResults ncenv nenv LookupKind.RecdField 1 m ad rest typeNameResInfo tn.idRange tcrefs
// choose only fields
let tyconSearch = tyconSearch |?> List.choose (function (resInfo,Item.RecdField(RecdFieldInfo(_,rfref)),rest) -> Some(resInfo,FieldResolution(rfref,false),rest) | _ -> None)
tyconSearch
| _ -> NoResultsOrUsefulErrors

let modulSearch ad =
ResolveLongIndentAsModuleOrNamespaceThen ncenv.amap m OpenQualified nenv ad lid
ResolveLongIndentAsModuleOrNamespaceThen ResultCollectionSettings.AtMostOneResult ncenv.amap m OpenQualified nenv ad lid
(ResolveFieldInModuleOrNamespace ncenv nenv ad)

let search =
Expand Down
8 changes: 7 additions & 1 deletion src/fsharp/NameResolution.fsi
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -347,8 +347,14 @@ type PermitDirectReferenceToGeneratedType =
| Yes
| No

/// Indicates if we only need one result or all possible results from a resolution.
[<RequireQualifiedAccess>]
type ResultCollectionSettings =
| AllResults
| AtMostOneResult

/// Resolve a long identifier to a namespace or module.
val internal ResolveLongIndentAsModuleOrNamespace : Import.ImportMap -> range -> FullyQualifiedFlag -> NameResolutionEnv -> AccessorDomain -> Ident list -> ResultOrException<(int * ModuleOrNamespaceRef * ModuleOrNamespaceType) list >
val internal ResolveLongIndentAsModuleOrNamespace : ResultCollectionSettings -> Import.ImportMap -> range -> FullyQualifiedFlag -> NameResolutionEnv -> AccessorDomain -> Ident list -> ResultOrException<(int * ModuleOrNamespaceRef * ModuleOrNamespaceType) list >

/// Resolve a long identifier to an object constructor.
val internal ResolveObjectConstructor : NameResolver -> DisplayEnv -> range -> AccessorDomain -> TType -> ResultOrException<Item>
Expand Down
Loading