Skip to content

Commit

Permalink
Improve perf on CollectResults (#2018)
Browse files Browse the repository at this point in the history 
* CollectAtMostOneResult

* couple more simple cases

* More places

* yet another place

* yet another place

* yet another place

* Another case

* Made another decision - we can't optimize this case

* cleanup

* Use enum
  • Loading branch information
@forki @KevinRansom
forki authored and KevinRansom committed Dec 15, 2016
1 parent 86410d7 commit 9b4c4aa
Show file tree
Hide file tree
Showing 3 changed files with 70 additions and 48 deletions.
96 changes: 56 additions & 40 deletions src/fsharp/NameResolution.fs
View file
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
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

0 comments on commit 9b4c4aa

Please sign in to comment.