From dd40a551041565eb0338bf66beba2325c661c99d Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Mon, 1 Oct 2018 10:41:50 +0200 Subject: [PATCH 1/7] Remove old TryGetValue --- src/absil/illib.fs | 5 ----- src/fsharp/tast.fs | 12 ++++++------ 2 files changed, 6 insertions(+), 11 deletions(-) diff --git a/src/absil/illib.fs b/src/absil/illib.fs index c628700af21..e2c535a5786 100644 --- a/src/absil/illib.fs +++ b/src/absil/illib.fs @@ -1158,11 +1158,6 @@ type LayeredMap<'Key,'Value when 'Key : comparison> = Map<'Key,'Value> type Map<'Key,'Value when 'Key : comparison> with static member Empty : Map<'Key,'Value> = Map.empty - member m.TryGetValue (key,res:byref<'Value>) = - match m.TryFind key with - | None -> false - | Some r -> res <- r; true - member x.Values = [ for (KeyValue(_,v)) in x -> v ] member x.AddAndMarkAsCollapsible (kvs: _[]) = (x,kvs) ||> Array.fold (fun x (KeyValue(k,v)) -> x.Add(k,v)) member x.LinearTryModifyThenLaterFlatten (key, f: 'Value option -> 'Value) = x.Add (key, f (x.TryFind key)) diff --git a/src/fsharp/tast.fs b/src/fsharp/tast.fs index 53b253b1ab7..c82252ffdf7 100644 --- a/src/fsharp/tast.fs +++ b/src/fsharp/tast.fs @@ -5718,13 +5718,13 @@ let CombineCcuContentFragments m l = let tab2 = mty2.AllEntitiesByLogicalMangledName let entities = [ for e1 in mty1.AllEntities do - match tab2.TryFind e1.LogicalName with - | Some e2 -> yield CombineEntites path e1 e2 - | None -> yield e1 + match tab2.TryGetValue e1.LogicalName with + | true, e2 -> yield CombineEntites path e1 e2 + | _ -> yield e1 for e2 in mty2.AllEntities do - match tab1.TryFind e2.LogicalName with - | Some _ -> () - | None -> yield e2 ] + match tab1.TryGetValue e2.LogicalName with + | true, _ -> () + | _ -> yield e2 ] let vals = QueueList.append mty1.AllValsAndMembers mty2.AllValsAndMembers From 0eb2f9f3bbca11124700e220c50e345f4c03f62f Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Mon, 1 Oct 2018 11:57:10 +0200 Subject: [PATCH 2/7] Reduce use of TryFind --- src/fsharp/tast.fs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/src/fsharp/tast.fs b/src/fsharp/tast.fs index c82252ffdf7..bdc75bff101 100644 --- a/src/fsharp/tast.fs +++ b/src/fsharp/tast.fs @@ -3045,13 +3045,12 @@ and static member TryDerefEntityPath(ccu: CcuThunk, path:string[], i:int, entity:Entity) = if i >= path.Length then ValueSome entity else - let next = entity.ModuleOrNamespaceType.AllEntitiesByCompiledAndLogicalMangledNames.TryFind(path.[i]) - match next with - | Some res -> NonLocalEntityRef.TryDerefEntityPath(ccu, path, (i+1), res) + match entity.ModuleOrNamespaceType.AllEntitiesByCompiledAndLogicalMangledNames.TryGetValue path.[i] with + | true, res -> NonLocalEntityRef.TryDerefEntityPath(ccu, path, (i+1), res) #if !NO_EXTENSIONTYPING - | None -> NonLocalEntityRef.TryDerefEntityPathViaProvidedType(ccu, path, i, entity) + | _ -> NonLocalEntityRef.TryDerefEntityPathViaProvidedType(ccu, path, i, entity) #else - | None -> ValueNone + | _ -> ValueNone #endif #if !NO_EXTENSIONTYPING @@ -4198,9 +4197,10 @@ and /// Try to resolve a path into the CCU by referencing the .NET/CLI type forwarder table of the CCU member ccu.TryForward(nlpath:string[],item:string) : EntityRef option = ccu.EnsureDerefable(nlpath) - match ccu.TypeForwarders.TryFind(nlpath,item) with - | Some entity -> Some(entity.Force()) - | None -> None + let key = nlpath,item + match ccu.TypeForwarders.TryGetValue key with + | true, entity -> Some(entity.Force()) + | _ -> None //printfn "trying to forward %A::%s from ccu '%s', res = '%A'" p n ccu.AssemblyName res.IsSome /// Used to make forward calls into the type/assembly loader when comparing member signatures during linking From 6ca1079ab38239f22f11e93fdc6b3b56914a9e05 Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Mon, 1 Oct 2018 12:01:49 +0200 Subject: [PATCH 3/7] Reduce allocations in TcPatBindingName --- src/fsharp/NameResolution.fs | 3 --- src/fsharp/NameResolution.fsi | 3 --- src/fsharp/TypeChecker.fs | 6 +++--- 3 files changed, 3 insertions(+), 9 deletions(-) diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index a4cbd0279de..65982032f17 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -693,9 +693,6 @@ let private AddPartsOfTyconRefToNameEnv bulkAddMode ownDefinition (g:TcGlobals) eIndexedExtensionMembers = eIndexedExtensionMembers eUnindexedExtensionMembers = eUnindexedExtensionMembers } -let TryFindPatternByName name {ePatItems = patternMap} = - NameMap.tryFind name patternMap - /// Add a set of type definitions to the name resolution environment let AddTyconRefsToNameEnv bulkAddMode ownDefinition g amap m root nenv tcrefs = if isNil tcrefs then nenv else diff --git a/src/fsharp/NameResolution.fsi b/src/fsharp/NameResolution.fsi index 8a1ae97f009..f381d1088dc 100755 --- a/src/fsharp/NameResolution.fsi +++ b/src/fsharp/NameResolution.fsi @@ -166,9 +166,6 @@ type FullyQualifiedFlag = [] type BulkAdd = Yes | No -/// Lookup patterns in name resolution environment -val internal TryFindPatternByName : string -> NameResolutionEnv -> Item option - /// Add extra items to the environment for Visual Studio, e.g. static members val internal AddFakeNamedValRefToNameEnv : string -> NameResolutionEnv -> ValRef -> NameResolutionEnv diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index ecbeaf06b46..4da594ed27f 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -5106,10 +5106,10 @@ and TcPatBindingName cenv env id ty isMemberThis vis1 topValData (inlineFlag, de | Some value -> let name = id.idText if not (String.IsNullOrEmpty name) && Char.IsLower(name.[0]) then - match TryFindPatternByName name env.eNameResEnv with - | Some (Item.Value vref) when vref.LiteralValue.IsSome -> + match env.eNameResEnv.ePatItems.TryGetValue name with + | true, Item.Value vref when vref.LiteralValue.IsSome -> warning(Error(FSComp.SR.checkLowercaseLiteralBindingInPattern(id.idText), id.idRange)) - | Some _ | None -> () + | _ -> () value | None -> error(Error(FSComp.SR.tcNameNotBoundInPattern(id.idText), id.idRange)) From 13aa9e9eeb5e805244e2e68506046abe8085ee13 Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Mon, 1 Oct 2018 12:08:10 +0200 Subject: [PATCH 4/7] Reduce some allocations in NameResolution --- src/absil/illib.fs | 1 + src/fsharp/NameResolution.fs | 156 +++++++++++++++++------------------ 2 files changed, 79 insertions(+), 78 deletions(-) diff --git a/src/absil/illib.fs b/src/absil/illib.fs index e2c535a5786..8b87779a75d 100644 --- a/src/absil/illib.fs +++ b/src/absil/illib.fs @@ -1173,6 +1173,7 @@ type LayeredMultiMap<'Key,'Value when 'Key : equality and 'Key : comparison>(con x.MarkAsCollapsible() member x.MarkAsCollapsible() = LayeredMultiMap(contents.MarkAsCollapsible()) member x.TryFind k = contents.TryFind k + member x.TryGetValue k = contents.TryGetValue k member x.Values = contents.Values |> List.concat static member Empty : LayeredMultiMap<'Key,'Value> = LayeredMultiMap LayeredMap.Empty diff --git a/src/fsharp/NameResolution.fs b/src/fsharp/NameResolution.fs index 65982032f17..b8227a1b840 100644 --- a/src/fsharp/NameResolution.fs +++ b/src/fsharp/NameResolution.fs @@ -1008,17 +1008,17 @@ type TypeNameResolutionInfo = /// be used to qualify access if needed let LookupTypeNameInEntityHaveArity nm (staticResInfo: TypeNameResolutionStaticArgsInfo) (mty:ModuleOrNamespaceType) = let attempt1 = mty.TypesByMangledName.TryFind (staticResInfo.MangledNameForType nm) - match attempt1 with - | Some _ as r -> r + match attempt1 with | None -> mty.TypesByMangledName.TryFind nm + | _ -> attempt1 /// Unqualified lookups of type names where the number of generic arguments is known /// from context, e.g. List. Rebindings due to 'open' may have rebound identifiers. let LookupTypeNameInEnvHaveArity fq nm numTyArgs (nenv:NameResolutionEnv) = let key = if IsMangledGenericName nm then DecodeGenericTypeName nm else NameArityPair(nm,numTyArgs) - match nenv.TyconsByDemangledNameAndArity(fq).TryFind(key) with - | Some res -> Some res + match nenv.TyconsByDemangledNameAndArity(fq).TryFind key with | None -> nenv.TyconsByAccessNames(fq).TryFind nm |> Option.map List.head + | res -> res /// Implements unqualified lookups of type names where the number of generic arguments is NOT known /// from context. @@ -1039,14 +1039,14 @@ let LookupTypeNameInEnvHaveArity fq nm numTyArgs (nenv:NameResolutionEnv) = let LookupTypeNameNoArity nm (byDemangledNameAndArity: LayeredMap) (byAccessNames: LayeredMultiMap) = if IsMangledGenericName nm then - match byDemangledNameAndArity.TryFind (DecodeGenericTypeName nm) with - | Some res -> [res] - | None -> - match byAccessNames.TryFind nm with - | Some res -> res - | None -> [] + match byDemangledNameAndArity.TryGetValue (DecodeGenericTypeName nm) with + | true, res -> [res] + | _ -> + match byAccessNames.TryGetValue nm with + | true, res -> res + | _ -> [] else - byAccessNames.[nm] + byAccessNames.[nm] /// Qualified lookup of type names in the environment let LookupTypeNameInEnvNoArity fq nm (nenv: NameResolutionEnv) = @@ -1843,15 +1843,15 @@ let rec ResolveLongIndentAsModuleOrNamespace sink atMostOne amap m first fullyQu let occurence = if isOpenDecl then ItemOccurence.Open else ItemOccurence.Use CallNameResolutionSink sink (m, nenv, item, item, emptyTyparInst, occurence, nenv.DisplayEnv, ad) - match moduleOrNamespaces.TryFind id.idText with - | Some modrefs -> + match moduleOrNamespaces.TryGetValue id.idText with + | true, modrefs -> /// Look through the sub-namespaces and/or modules let rec look depth (modref: ModuleOrNamespaceRef) (mty:ModuleOrNamespaceType) (lid:Ident list) = match lid with | [] -> success (depth,modref,mty) | id :: rest -> - match mty.ModulesAndNamespacesByDemangledName.TryFind id.idText with - | Some mspec -> + match mty.ModulesAndNamespacesByDemangledName.TryGetValue id.idText with + | true, mspec -> let subref = modref.NestedTyconRef mspec if IsEntityAccessible amap m ad subref then notifyNameResolution subref id.idRange @@ -1867,7 +1867,7 @@ let rec ResolveLongIndentAsModuleOrNamespace sink atMostOne amap m first fullyQu look 1 modref modref.ModuleOrNamespaceType rest else raze (namespaceNotFound.Force())) - | None -> raze (namespaceNotFound.Force()) + | _ -> raze (namespaceNotFound.Force()) let ResolveLongIndentAsModuleOrNamespaceThen sink atMostOne amap m fullyQualified (nenv:NameResolutionEnv) ad id rest isOpenDecl f = @@ -2254,12 +2254,12 @@ let (|AccessibleEntityRef|_|) amap m ad (modref: ModuleOrNamespaceRef) mspec = let rec ResolveExprLongIdentInModuleOrNamespace (ncenv:NameResolver) nenv (typeNameResInfo: TypeNameResolutionInfo) ad resInfo depth m modref (mty:ModuleOrNamespaceType) (id:Ident) (rest :Ident list) = // resInfo records the modules or namespaces actually relevant to a resolution let m = unionRanges m id.idRange - match mty.AllValsByLogicalName.TryFind(id.idText) with - | Some vspec when IsValAccessible ad (mkNestedValRef modref vspec) -> + match mty.AllValsByLogicalName.TryGetValue id.idText with + | true, vspec when IsValAccessible ad (mkNestedValRef modref vspec) -> success(resInfo,Item.Value (mkNestedValRef modref vspec),rest) | _-> - match mty.ExceptionDefinitionsByDemangledName.TryFind(id.idText) with - | Some excon when IsTyconReprAccessible ncenv.amap m ad (modref.NestedTyconRef excon) -> + match mty.ExceptionDefinitionsByDemangledName.TryGetValue id.idText with + | true, excon when IsTyconReprAccessible ncenv.amap m ad (modref.NestedTyconRef excon) -> success (resInfo,Item.ExnCase (modref.NestedTyconRef excon),rest) | _ -> // Something in a discriminated union without RequireQualifiedAccess attribute? @@ -2305,8 +2305,8 @@ let rec ResolveExprLongIdentInModuleOrNamespace (ncenv:NameResolver) nenv (typeN let moduleSearch() = match rest with | id2::rest2 -> - match mty.ModulesAndNamespacesByDemangledName.TryFind(id.idText) with - | Some(AccessibleEntityRef ncenv.amap m ad modref submodref) -> + match mty.ModulesAndNamespacesByDemangledName.TryGetValue id.idText with + | true, AccessibleEntityRef ncenv.amap m ad modref submodref -> let resInfo = resInfo.AddEntity(id.idRange,submodref) OneResult (ResolveExprLongIdentInModuleOrNamespace ncenv nenv typeNameResInfo ad resInfo (depth+1) m submodref submodref.ModuleOrNamespaceType id2 rest2) @@ -2391,10 +2391,10 @@ let rec ResolveExprLongIdentPrim sink (ncenv:NameResolver) first fullyQualified let typeError = ref None // Single identifier. Lookup the unqualified names in the environment let envSearch = - match nenv.eUnqualifiedItems.TryFind(id.idText) with + match nenv.eUnqualifiedItems.TryGetValue id.idText with // The name is a type name and it has not been clobbered by some other name - | Some (Item.UnqualifiedType tcrefs) -> + | true, Item.UnqualifiedType tcrefs -> // Do not use type names from the environment if an explicit type instantiation is // given and the number of type parameters do not match @@ -2411,9 +2411,9 @@ let rec ResolveExprLongIdentPrim sink (ncenv:NameResolver) first fullyQualified Some(item,rest) | Exception e -> typeError := Some e; None - | Some res -> + | true, res -> Some (FreshenUnqualifiedItem ncenv m res, []) - | None -> + | _ -> None match envSearch with @@ -2495,8 +2495,8 @@ let rec ResolveExprLongIdentPrim sink (ncenv:NameResolver) first fullyQualified match fullyQualified with | FullyQualified -> false | _ -> - match nenv.eUnqualifiedItems.TryFind(nm) with - | Some(Item.Value _) -> true + match nenv.eUnqualifiedItems.TryGetValue nm with + | true, Item.Value _ -> true | _ -> false if ValIsInEnv id.idText then @@ -2527,10 +2527,10 @@ let rec ResolveExprLongIdentPrim sink (ncenv:NameResolver) first fullyQualified | FullyQualified -> NoResultsOrUsefulErrors | OpenQualified -> - match nenv.eUnqualifiedItems.TryFind id.idText with - | Some (Item.UnqualifiedType _) - | None -> NoResultsOrUsefulErrors - | Some res -> OneSuccess (resInfo,FreshenUnqualifiedItem ncenv m res,rest) + match nenv.eUnqualifiedItems.TryGetValue id.idText with + | true, Item.UnqualifiedType _ + | false, _ -> NoResultsOrUsefulErrors + | true, res -> OneSuccess (resInfo,FreshenUnqualifiedItem ncenv m res,rest) moduleSearch ad () +++ tyconSearch ad +++ envSearch @@ -2594,17 +2594,17 @@ let rec ResolvePatternLongIdentInModuleOrNamespace (ncenv:NameResolver) nenv num let ucinfo = FreshenUnionCaseRef ncenv m ucref success (resInfo,Item.UnionCase(ucinfo,showDeprecated),rest) | _ -> - match mty.ExceptionDefinitionsByDemangledName.TryFind(id.idText) with - | Some exnc when IsEntityAccessible ncenv.amap m ad (modref.NestedTyconRef exnc) -> + match mty.ExceptionDefinitionsByDemangledName.TryGetValue id.idText with + | true, exnc when IsEntityAccessible ncenv.amap m ad (modref.NestedTyconRef exnc) -> success (resInfo,Item.ExnCase (modref.NestedTyconRef exnc),rest) | _ -> // An active pattern constructor in a module - match (ActivePatternElemsOfModuleOrNamespace modref).TryFind(id.idText) with - | Some ( APElemRef(_,vref,_) as apref) when IsValAccessible ad vref -> + match (ActivePatternElemsOfModuleOrNamespace modref).TryGetValue id.idText with + | true, (APElemRef(_,vref,_) as apref) when IsValAccessible ad vref -> success (resInfo,Item.ActivePatternCase apref,rest) | _ -> - match mty.AllValsByLogicalName.TryFind(id.idText) with - | Some vspec when IsValAccessible ad (mkNestedValRef modref vspec) -> + match mty.AllValsByLogicalName.TryGetValue id.idText with + | true, vspec when IsValAccessible ad (mkNestedValRef modref vspec) -> success(resInfo,Item.Value (mkNestedValRef modref vspec),rest) | _ -> let tcrefs = lazy ( @@ -2634,8 +2634,8 @@ let rec ResolvePatternLongIdentInModuleOrNamespace (ncenv:NameResolver) nenv num let moduleSearch() = match rest with | id2::rest2 -> - match mty.ModulesAndNamespacesByDemangledName.TryFind(id.idText) with - | Some(AccessibleEntityRef ncenv.amap m ad modref submodref) -> + match mty.ModulesAndNamespacesByDemangledName.TryGetValue id.idText with + | true, AccessibleEntityRef ncenv.amap m ad modref submodref -> let resInfo = resInfo.AddEntity(id.idRange,submodref) OneResult (ResolvePatternLongIdentInModuleOrNamespace ncenv nenv numTyArgsOpt ad resInfo (depth+1) m submodref submodref.ModuleOrNamespaceType id2 rest2) | _ -> @@ -2682,8 +2682,8 @@ let rec ResolvePatternLongIdentPrim sink (ncenv:NameResolver) fullyQualified war // Single identifiers in patterns - bind to constructors and active patterns // For the special case of // let C = x - match nenv.ePatItems.TryFind(id.idText) with - | Some res when not newDef -> FreshenUnqualifiedItem ncenv m res + match nenv.ePatItems.TryGetValue id.idText with + | true, res when not newDef -> FreshenUnqualifiedItem ncenv m res | _ -> // Single identifiers in patterns - variable bindings if not newDef && @@ -2829,8 +2829,8 @@ let rec private ResolveTypeLongIdentInModuleOrNamespace sink nenv (ncenv:NameRes | id2::rest2 -> let m = unionRanges m id.idRange let modulSearch = - match modref.ModuleOrNamespaceType.ModulesAndNamespacesByDemangledName.TryFind(id.idText) with - | Some(AccessibleEntityRef ncenv.amap m ad modref submodref) -> + match modref.ModuleOrNamespaceType.ModulesAndNamespacesByDemangledName.TryGetValue id.idText with + | true, AccessibleEntityRef ncenv.amap m ad modref submodref -> let item = Item.ModuleOrNamespaces [submodref] CallNameResolutionSink sink (id.idRange, nenv, item, item, emptyTyparInst, ItemOccurence.Use, nenv.DisplayEnv, ad) let resInfo = resInfo.AddEntity(id.idRange,submodref) @@ -2995,8 +2995,8 @@ let rec ResolveFieldInModuleOrNamespace (ncenv:NameResolver) nenv ad (resInfo:Re let modulSearch() = match rest with | id2::rest2 -> - match modref.ModuleOrNamespaceType.ModulesAndNamespacesByDemangledName.TryFind(id.idText) with - | Some(AccessibleEntityRef ncenv.amap m ad modref submodref) -> + match modref.ModuleOrNamespaceType.ModulesAndNamespacesByDemangledName.TryGetValue id.idText with + | true, AccessibleEntityRef ncenv.amap m ad modref submodref -> let resInfo = resInfo.AddEntity(id.idRange,submodref) ResolveFieldInModuleOrNamespace ncenv nenv ad resInfo (depth+1) m submodref submodref.ModuleOrNamespaceType id2 rest2 |> OneResult @@ -3030,9 +3030,9 @@ let SuggestLabelsOfRelatedRecords g (nenv:NameResolutionEnv) (id:Ident) (allFiel else let possibleRecords = [for fld in givenFields do - match Map.tryFind fld nenv.eFieldLabels with - | None -> () - | Some recordTypes -> yield! (recordTypes |> List.map (fun r -> r.TyconRef.DisplayName, fld)) ] + match nenv.eFieldLabels.TryGetValue fld with + | true, recordTypes -> yield! (recordTypes |> List.map (fun r -> r.TyconRef.DisplayName, fld)) + | _ -> () ] |> List.groupBy fst |> List.map (fun (r,fields) -> r, fields |> List.map snd) |> List.filter (fun (_,fields) -> givenFields.IsSubsetOf fields) @@ -3170,8 +3170,8 @@ let private ResolveExprDotLongIdent (ncenv:NameResolver) m ad nenv ty (id:Ident) if isAppTy ncenv.g ty then NoResultsOrUsefulErrors else - match nenv.eFieldLabels |> Map.tryFind id.idText with - | Some(rfref :: _) -> + match nenv.eFieldLabels.TryGetValue id.idText with + | true, rfref :: _ -> // NOTE (instantiationGenerator cleanup): we need to freshen here because we don't know the type. // But perhaps the caller should freshen?? let item = FreshenRecdFieldRef ncenv m rfref @@ -3408,17 +3408,17 @@ let rec PartialResolveLookupInModuleOrNamespaceAsModuleOrNamespaceThen f plid (m match plid with | [] -> f modref | id:: rest -> - match mty.ModulesAndNamespacesByDemangledName.TryFind(id) with - | Some mty -> PartialResolveLookupInModuleOrNamespaceAsModuleOrNamespaceThen f rest (modref.NestedTyconRef mty) - | None -> [] + match mty.ModulesAndNamespacesByDemangledName.TryGetValue id with + | true, mty -> PartialResolveLookupInModuleOrNamespaceAsModuleOrNamespaceThen f rest (modref.NestedTyconRef mty) + | _ -> [] let PartialResolveLongIndentAsModuleOrNamespaceThen (nenv:NameResolutionEnv) plid f = - match plid with + match plid with | id:: rest -> - match Map.tryFind id nenv.eModulesAndNamespaces with - | Some modrefs -> + match nenv.eModulesAndNamespaces.TryGetValue id with + | true, modrefs -> List.collect (PartialResolveLookupInModuleOrNamespaceAsModuleOrNamespaceThen f rest) modrefs - | None -> + | _ -> [] | [] -> [] @@ -3827,8 +3827,8 @@ let rec ResolvePartialLongIdentInModuleOrNamespace (ncenv: NameResolver) nenv is | id :: rest -> - (match mty.ModulesAndNamespacesByDemangledName.TryFind(id) with - | Some mspec -> + (match mty.ModulesAndNamespacesByDemangledName.TryGetValue id with + | true, mspec -> let nested = modref.NestedTyconRef mspec if IsTyconUnseenObsoleteSpec ad g ncenv.amap m nested allowObsolete then [] else let allowObsolete = allowObsolete && not (isNil rest) @@ -3852,16 +3852,16 @@ let TryToResolveLongIdentAsType (ncenv: NameResolver) (nenv: NameResolutionEnv) | Some id -> // Look for values called 'id' that accept the dot-notation let ty = - match nenv.eUnqualifiedItems |> Map.tryFind id with + match nenv.eUnqualifiedItems.TryGetValue id with // v.lookup : member of a value - | Some v -> + | true, v -> match v with | Item.Value x -> let ty = x.Type let ty = if x.BaseOrThisInfo = CtorThisVal && isRefCellTy g ty then destRefCellTy g ty else ty Some ty | _ -> None - | None -> None + | _ -> None match ty with | Some _ -> ty @@ -3951,16 +3951,16 @@ let rec ResolvePartialLongIdentPrim (ncenv: NameResolver) (nenv: NameResolutionE []) // Look for values called 'id' that accept the dot-notation let values, isItemVal = - (match nenv.eUnqualifiedItems |> Map.tryFind id with + (match nenv.eUnqualifiedItems.TryGetValue id with // v.lookup : member of a value - | Some v -> + | true, v -> match v with | Item.Value x -> let ty = x.Type let ty = if x.BaseOrThisInfo = CtorThisVal && isRefCellTy g ty then destRefCellTy g ty else ty (ResolvePartialLongIdentInType ncenv nenv isApplicableMeth m ad false rest ty), true | _ -> [], false - | None -> [], false) + | _ -> [], false) let staticSometingInType = [ if not isItemVal then @@ -4026,8 +4026,8 @@ let rec ResolvePartialLongIdentInModuleOrNamespaceForRecordFields (ncenv: NameRe ] | id :: rest -> - (match mty.ModulesAndNamespacesByDemangledName.TryFind(id) with - | Some mspec -> + (match mty.ModulesAndNamespacesByDemangledName.TryGetValue id with + | true, mspec -> let nested = modref.NestedTyconRef mspec if IsTyconUnseenObsoleteSpec ad g ncenv.amap m nested allowObsolete then [] else let allowObsolete = allowObsolete && not (isNil rest) @@ -4422,8 +4422,8 @@ let rec ResolvePartialLongIdentInModuleOrNamespaceForItem (ncenv: NameResolver) | id :: rest -> - match mty.ModulesAndNamespacesByDemangledName.TryFind id with - | Some mspec -> + match mty.ModulesAndNamespacesByDemangledName.TryGetValue id with + | true, mspec -> let nested = modref.NestedTyconRef mspec if not (IsTyconUnseenObsoleteSpec ad g ncenv.amap m nested true) then yield! ResolvePartialLongIdentInModuleOrNamespaceForItem ncenv nenv m ad nested rest item @@ -4440,20 +4440,20 @@ let rec PartialResolveLookupInModuleOrNamespaceAsModuleOrNamespaceThenLazy f pli match plid with | [] -> f modref | id :: rest -> - match mty.ModulesAndNamespacesByDemangledName.TryFind id with - | Some mty -> + match mty.ModulesAndNamespacesByDemangledName.TryGetValue id with + | true, mty -> PartialResolveLookupInModuleOrNamespaceAsModuleOrNamespaceThenLazy f rest (modref.NestedTyconRef mty) - | None -> Seq.empty + | _ -> Seq.empty let PartialResolveLongIndentAsModuleOrNamespaceThenLazy (nenv:NameResolutionEnv) plid f = seq { match plid with | id :: rest -> - match Map.tryFind id nenv.eModulesAndNamespaces with - | Some modrefs -> + match nenv.eModulesAndNamespaces.TryGetValue id with + | true, modrefs -> for modref in modrefs do yield! PartialResolveLookupInModuleOrNamespaceAsModuleOrNamespaceThenLazy f rest modref - | None -> () + | _ -> () | [] -> () } @@ -4526,8 +4526,8 @@ let rec GetCompletionForItem (ncenv: NameResolver) (nenv: NameResolutionEnv) m a else Seq.empty) // Look for values called 'id' that accept the dot-notation - match Map.tryFind id nenv.eUnqualifiedItems with - | Some (Item.Value x) -> + match nenv.eUnqualifiedItems.TryGetValue id with + | true, Item.Value x -> let ty = x.Type let ty = if x.BaseOrThisInfo = CtorThisVal && isRefCellTy g ty then destRefCellTy g ty else ty yield! ResolvePartialLongIdentInTypeForItem ncenv nenv m ad false rest item ty From a64629b91d8e1cc22509c31a93a6760cb18ceba4 Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Mon, 1 Oct 2018 12:56:24 +0200 Subject: [PATCH 5/7] Reduce some allocations in TypeChecker --- src/absil/illib.fs | 6 ++--- src/fsharp/TypeChecker.fs | 48 +++++++++++++++++++-------------------- 2 files changed, 27 insertions(+), 27 deletions(-) diff --git a/src/absil/illib.fs b/src/absil/illib.fs index 8b87779a75d..bef3fc4f4c8 100644 --- a/src/absil/illib.fs +++ b/src/absil/illib.fs @@ -1133,7 +1133,7 @@ module NameMap = [] module NameMultiMap = let existsInRange f (m: NameMultiMap<'T>) = NameMap.exists (fun _ l -> List.exists f l) m - let find v (m: NameMultiMap<'T>) = match Map.tryFind v m with None -> [] | Some r -> r + let find v (m: NameMultiMap<'T>) = match m.TryGetValue v with true, r -> r | _ -> [] let add v x (m: NameMultiMap<'T>) = NameMap.add v (x :: find v m) m let range (m: NameMultiMap<'T>) = Map.foldBack (fun _ x sofar -> x @ sofar) m [] let rangeReversingEachBucket (m: NameMultiMap<'T>) = Map.foldBack (fun _ x sofar -> List.rev x @ sofar) m [] @@ -1147,7 +1147,7 @@ module NameMultiMap = [] module MultiMap = let existsInRange f (m: MultiMap<_,_>) = Map.exists (fun _ l -> List.exists f l) m - let find v (m: MultiMap<_,_>) = match Map.tryFind v m with None -> [] | Some r -> r + let find v (m: MultiMap<_,_>) = match m.TryGetValue v with true, r -> r | _ -> [] let add v x (m: MultiMap<_,_>) = Map.add v (x :: find v m) m let range (m: MultiMap<_,_>) = Map.foldBack (fun _ x sofar -> x @ sofar) m [] let empty : MultiMap<_,_> = Map.empty @@ -1167,7 +1167,7 @@ type Map<'Key,'Value when 'Key : comparison> with [] type LayeredMultiMap<'Key,'Value when 'Key : equality and 'Key : comparison>(contents : LayeredMap<'Key,'Value list>) = member x.Add (k,v) = LayeredMultiMap(contents.Add(k,v :: x.[k])) - member x.Item with get k = match contents.TryFind k with None -> [] | Some l -> l + member x.Item with get k = match contents.TryGetValue k with true, l -> l | _ -> [] member x.AddAndMarkAsCollapsible (kvs: _[]) = let x = (x,kvs) ||> Array.fold (fun x (KeyValue(k,v)) -> x.Add(k,v)) x.MarkAsCollapsible() diff --git a/src/fsharp/TypeChecker.fs b/src/fsharp/TypeChecker.fs index 4da594ed27f..61cf1098cf6 100755 --- a/src/fsharp/TypeChecker.fs +++ b/src/fsharp/TypeChecker.fs @@ -4470,9 +4470,9 @@ and TcTyparOrMeasurePar optKind cenv (env:TcEnv) newOk tpenv (Typar(id, _, _) as // CallNameResolutionSink cenv.tcSink (tp.Range.StartRange, env.NameEnv, item, item, ItemOccurence.UseInType, env.DisplayEnv, env.eAccessRights) res, tpenv let key = id.idText - match env.eNameResEnv.eTypars.TryFind key with - | Some res -> checkRes res - | None -> + match env.eNameResEnv.eTypars.TryGetValue key with + | true, res -> checkRes res + | _ -> match TryFindUnscopedTypar key tpenv with | Some res -> checkRes res | None -> @@ -5101,17 +5101,17 @@ and TcPatBindingName cenv env id ty isMemberThis vis1 topValData (inlineFlag, de let names = Map.add id.idText (PrelimValScheme1(id, declaredTypars, ty, topValData, None, isMutable, inlineFlag, baseOrThis, argAttribs, vis, compgen)) names let takenNames = Set.add id.idText takenNames (fun (TcPatPhase2Input (values, isLeftMost)) -> - let (vspec, typeScheme) = - match values.TryFind id.idText with - | Some value -> - let name = id.idText + let (vspec, typeScheme) = + let name = id.idText + match values.TryGetValue name with + | true, value -> if not (String.IsNullOrEmpty name) && Char.IsLower(name.[0]) then match env.eNameResEnv.ePatItems.TryGetValue name with | true, Item.Value vref when vref.LiteralValue.IsSome -> - warning(Error(FSComp.SR.checkLowercaseLiteralBindingInPattern(id.idText), id.idRange)) + warning(Error(FSComp.SR.checkLowercaseLiteralBindingInPattern name, id.idRange)) | _ -> () value - | None -> error(Error(FSComp.SR.tcNameNotBoundInPattern(id.idText), id.idRange)) + | _ -> error(Error(FSComp.SR.tcNameNotBoundInPattern name, id.idRange)) // isLeftMost indicates we are processing the left-most path through a disjunctive or pattern. // For those binding locations, CallNameResolutionSink is called in MakeAndPublishValue, like all other bindings @@ -5198,10 +5198,10 @@ and TcPat warnOnUpper cenv env topValInfo vFlags (tpenv, names, takenNames) ty p // matching error (UnionPatternsBindDifferentNames m) names1 |> Map.iter (fun _ (PrelimValScheme1(id1, _, ty1, _, _, _, _, _, _, _, _)) -> - match Map.tryFind id1.idText names2 with - | None -> () - | Some (PrelimValScheme1(_, _, ty2, _, _, _, _, _, _, _, _)) -> - UnifyTypes cenv env m ty1 ty2) + match names2.TryGetValue id1.idText with + | true, PrelimValScheme1(_, _, ty2, _, _, _, _, _, _, _, _) -> + UnifyTypes cenv env m ty1 ty2 + | _ -> ()) (fun values -> TPat_disjs ([pat1' values;pat2' values.RightPath], m)), (tpenv, names1, takenNames1) | SynPat.Ands (pats, m) -> @@ -5442,9 +5442,9 @@ and TcPat warnOnUpper cenv env topValInfo vFlags (tpenv, names, takenNames) ty p let ftys = fields |> List.map (fun fsp -> actualTyOfRecdField inst fsp, fsp) let fldsmap', acc = ((tpenv, names, takenNames), ftys) ||> List.mapFold (fun s (ty, fsp) -> - match Map.tryFind fsp.rfield_id.idText fldsmap with - | Some v -> TcPat warnOnUpper cenv env None vFlags s ty v - | None -> (fun _ -> TPat_wild m), s) + match fldsmap.TryGetValue fsp.rfield_id.idText with + | true, v -> TcPat warnOnUpper cenv env None vFlags s ty v + | _ -> (fun _ -> TPat_wild m), s) (fun values -> TPat_recd (tcref, tinst, List.map (fun f -> f values) fldsmap', m)), acc @@ -11598,10 +11598,10 @@ and TcIncrementalLetRecGeneralization cenv scopem // pathological situations let freeInUncheckedRecBinds = lazy ((emptyFreeTyvars, cenv.recUses.Contents) ||> Map.fold (fun acc vStamp _ -> - match Map.tryFind vStamp uncheckedRecBindsTable with - | Some fwdBind -> - accFreeInType CollectAllNoCaching fwdBind.RecBindingInfo.Val.Type acc - | None -> + match uncheckedRecBindsTable.TryGetValue vStamp with + | true, fwdBind -> + accFreeInType CollectAllNoCaching fwdBind.RecBindingInfo.Val.Type acc + | _ -> acc)) let rec loop (preGeneralizationRecBinds: PreGeneralizationRecursiveBinding list, @@ -16024,12 +16024,12 @@ module TcDeclarations = else let isInSameModuleOrNamespace = - match envForDecls.eModuleOrNamespaceTypeAccumulator.Value.TypesByMangledName.TryFind(tcref.LogicalName) with - | Some tycon -> (tyconOrder.Compare(tcref.Deref, tycon) = 0) - | None -> + match envForDecls.eModuleOrNamespaceTypeAccumulator.Value.TypesByMangledName.TryGetValue tcref.LogicalName with + | true, tycon -> tyconOrder.Compare(tcref.Deref, tycon) = 0 + | _ -> //false // There is a special case we allow when compiling FSharp.Core.dll which permits interface implementations across namespace fragments - (cenv.g.compilingFslib && tcref.LogicalName.StartsWithOrdinal("Tuple`")) + cenv.g.compilingFslib && tcref.LogicalName.StartsWithOrdinal("Tuple`") let nReqTypars = reqTypars.Length From f2b67c15b4c7a169f75ed7c2cfaf98c428c946cc Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Mon, 1 Oct 2018 19:24:46 +0200 Subject: [PATCH 6/7] Use latest FSharp.Core in FCS --- fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj b/fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj index 54ca43c2cf4..a16f39b084c 100644 --- a/fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj +++ b/fcs/FSharp.Compiler.Service/FSharp.Compiler.Service.fsproj @@ -1,4 +1,4 @@ - + $(MSBuildProjectDirectory)\..\..\src @@ -635,7 +635,7 @@ - + From 9a33b3e427a311a3de95f30b179109fb72532776 Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Mon, 1 Oct 2018 19:27:54 +0200 Subject: [PATCH 7/7] Update FSharp.Core in FCS --- .../FSharp.Compiler.Service.Tests.fsproj | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/fcs/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj b/fcs/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj index 55283b0065d..8d09c3a26f1 100644 --- a/fcs/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj +++ b/fcs/FSharp.Compiler.Service.Tests/FSharp.Compiler.Service.Tests.fsproj @@ -72,7 +72,7 @@ - +