Skip to content

F
fsharp

dotNET Platform / fsharp
11 个月 前同步成功

通知 0
Star 1
Fork 0
F
fsharp

体验新版 GitCode，发现更多精彩内容 >>

提交 03a3733e 编写于 作者: S Steffen Forkmann 提交者： Kevin Ransom (msft)
浏览文件
操作

Use Dictionary instead of Map in ValInfos (#2725) 

* Make ValInfos use a dictionary instead of a map

* Simplify ValHash collection

* Look locally before we go down recursively

* cleanup

* Don't do 2 dictionary lookups

* Cleanup

* Do not do 2 lookups in map

* Cleanup

* cleanup

* Add feedback
上级 f6e160a2
隐藏空白更改
内联 并排
Showing with 88 addition and 52 deletion
src/fsharp/Optimizer.fs
浏览文件 @ 03a3733e
......@@ -15,7 +15,6 @@ open Microsoft.FSharp.Compiler.AbstractIL.Diagnostics
open Microsoft.FSharp.Compiler.AbstractIL.IL
open Microsoft.FSharp.Compiler.AbstractIL.Internal
open Microsoft.FSharp.Compiler.AbstractIL.Internal.Library
open Microsoft.FSharp.Compiler.AbstractIL.Extensions.ILX
open Microsoft.FSharp.Compiler
open Microsoft.FSharp.Compiler.Lib
......@@ -23,7 +22,6 @@ open Microsoft.FSharp.Compiler.Range
open Microsoft.FSharp.Compiler.Ast
open Microsoft.FSharp.Compiler.ErrorLogger
open Microsoft.FSharp.Compiler.Infos
open Microsoft.FSharp.Compiler.PrettyNaming
open Microsoft.FSharp.Compiler.Tast
open Microsoft.FSharp.Compiler.TastPickle
open Microsoft.FSharp.Compiler.Tastops
......@@ -129,16 +127,22 @@ type ValInfos(entries) =
for (vref:ValRef,x) in entries do
t.Add (vref.Deref,(vref,x))
t)
// The compiler ValRef's into fslib stored in env.fs break certain invariants that hold elsewhere,
// because they dereference to point to Val's from signatures rather than Val's from implementations.
// Thus a backup alternative resolution technique is needed for these.
let valInfosForFslib =
lazy (Map.ofList [ for (vref,_x) as p in entries do yield (vref.Deref.LinkagePartialKey,p) ])
member x.Entries = valInfoTable.Force().Values
member x.Map f = new ValInfos(Seq.map f x.Entries)
member x.Filter f = new ValInfos(Seq.filter f x.Entries)
lazy (
let dict = Dictionary<_,_>()
for (vref,_x) as p in entries do
dict.Add(vref.Deref.LinkagePartialKey,p) |> ignore
dict)
member x.Entries = valInfoTable.Force().Values
member x.Map f = ValInfos(Seq.map f x.Entries)
member x.Filter f = ValInfos(Seq.filter f x.Entries)
member x.TryFind (v:ValRef) = valInfoTable.Force().TryFind v.Deref
member x.TryFindForFslib (v:ValRef) = valInfosForFslib.Force().TryFind(v.Deref.LinkagePartialKey)
member x.TryFindForFslib (v:ValRef) = valInfosForFslib.Force().TryGetValue(v.Deref.LinkagePartialKey)
type ModuleInfo =
{ ValInfos: ValInfos
......@@ -197,6 +201,7 @@ let rec SizeOfValueInfos (arr:_[]) =
let n = arr.Length
let rec go i acc = if i >= n then acc else max acc (SizeOfValueInfo arr.[i])
go 0 0
and SizeOfValueInfo x =
match x with
| SizeValue (vdepth,_v) -> vdepth (* terminate recursion at CACHED size nodes *)
......@@ -209,11 +214,12 @@ and SizeOfValueInfo x =
| CurriedLambdaValue(_lambdaId,_arities,_bsize,_expr',_ety) -> 1
| ConstExprValue (_size,_) -> 1
let [<Literal>] minDepthForASizeNode = 5 (* for small vinfos do not record size info, save space *)
let rec MakeValueInfoWithCachedSize vdepth v =
match v with
| SizeValue(_,v) -> MakeValueInfoWithCachedSize vdepth v
| _ -> let minDepthForASizeNode = 5 in (* for small vinfos do not record size info, save space *)
if vdepth > minDepthForASizeNode then SizeValue(vdepth,v) else v (* add nodes to stop recursion *)
| SizeValue(_,v) -> MakeValueInfoWithCachedSize vdepth v
| _ -> if vdepth > minDepthForASizeNode then SizeValue(vdepth,v) else v (* add nodes to stop recursion *)
let MakeSizedValueInfo v =
let vdepth = SizeOfValueInfo v
......@@ -221,17 +227,19 @@ let MakeSizedValueInfo v =
let BoundValueInfoBySize vinfo =
let rec bound depth x =
if depth<0 then UnknownValue else
match x with
| SizeValue (vdepth,vinfo) -> if vdepth < depth then x else MakeSizedValueInfo (bound depth vinfo)
| ValValue (vr,vinfo) -> ValValue (vr,bound (depth-1) vinfo)
| TupleValue vinfos -> TupleValue (Array.map (bound (depth-1)) vinfos)
| RecdValue (tcref,vinfos) -> RecdValue (tcref,Array.map (bound (depth-1)) vinfos)
| UnionCaseValue (ucr,vinfos) -> UnionCaseValue (ucr,Array.map (bound (depth-1)) vinfos)
| ConstValue _ -> x
| UnknownValue -> x
| CurriedLambdaValue(_lambdaId,_arities,_bsize,_expr',_ety) -> x
| ConstExprValue (_size,_) -> x
if depth < 0 then
UnknownValue
else
match x with
| SizeValue (vdepth,vinfo) -> if vdepth < depth then x else MakeSizedValueInfo (bound depth vinfo)
| ValValue (vr,vinfo) -> ValValue (vr,bound (depth-1) vinfo)
| TupleValue vinfos -> TupleValue (Array.map (bound (depth-1)) vinfos)
| RecdValue (tcref,vinfos) -> RecdValue (tcref,Array.map (bound (depth-1)) vinfos)
| UnionCaseValue (ucr,vinfos) -> UnionCaseValue (ucr,Array.map (bound (depth-1)) vinfos)
| ConstValue _ -> x
| UnknownValue -> x
| CurriedLambdaValue(_lambdaId,_arities,_bsize,_expr',_ety) -> x
| ConstExprValue (_size,_) -> x
let maxDepth = 6 (* beware huge constants! *)
let trimDepth = 3
let vdepth = SizeOfValueInfo vinfo
......@@ -283,8 +291,8 @@ type OptimizationSettings =
reportTotalSizes = false
}
member x.jitOpt() = (match x.jitOptUser with Some f -> f | None -> jitOptDefault)
member x.localOpt () = (match x.localOptUser with Some f -> f | None -> localOptDefault)
member x.jitOpt() = match x.jitOptUser with Some f -> f | None -> jitOptDefault
member x.localOpt () = match x.localOptUser with Some f -> f | None -> localOptDefault
member x.crossModuleOpt () = x.localOpt () && (match x.crossModuleOptUser with Some f -> f | None -> crossModuleOptDefault)
member x.KeepOptimizationValues() = x.crossModuleOpt ()
......@@ -550,9 +558,8 @@ let GetInfoForNonLocalVal cenv env (vref:ValRef) =
//System.Diagnostics.Debug.Assert(false,sprintf "Break for module %s, value %s" (full_name_of_nlpath smv) n)
if cenv.g.compilingFslib then
match structInfo.ValInfos.TryFindForFslib(vref) with
| Some ninfo -> snd ninfo
| None ->
UnknownValInfo
| true, ninfo -> snd ninfo
| _ -> UnknownValInfo
else
UnknownValInfo
| None ->
......
src/fsharp/TastOps.fs
浏览文件 @ 03a3733e
......@@ -33,9 +33,19 @@ open Microsoft.FSharp.Compiler.ExtensionTyping
[<NoEquality; NoComparison>]
type TyparMap<'T> =
| TPMap of StampMap<'T>
member tm.Item with get (v: Typar) = let (TPMap m) = tm in m.[v.Stamp]
member tm.ContainsKey (v: Typar) = let (TPMap m) = tm in m.ContainsKey(v.Stamp)
member tm.Add (v: Typar, x) = let (TPMap m) = tm in TPMap (m.Add(v.Stamp,x))
member tm.Item
with get (v: Typar) =
let (TPMap m) = tm
m.[v.Stamp]
member tm.ContainsKey (v: Typar) =
let (TPMap m) = tm
m.ContainsKey(v.Stamp)
member tm.Add (v: Typar, x) =
let (TPMap m) = tm
TPMap (m.Add(v.Stamp,x))
static member Empty : TyparMap<'T> = TPMap Map.empty
[<NoEquality; NoComparison; Sealed>]
......@@ -78,15 +88,15 @@ let emptyTyparInst = ([] : TyparInst)
[<NoEquality; NoComparison>]
type Remap =
{ tpinst : TyparInst;
valRemap: ValRemap;
tyconRefRemap : TyconRefRemap;
{ tpinst : TyparInst
valRemap: ValRemap
tyconRefRemap : TyconRefRemap
removeTraitSolutions: bool }
let emptyRemap =
{ tpinst = emptyTyparInst;
tyconRefRemap = emptyTyconRefRemap;
valRemap = ValMap.Empty;
{ tpinst = emptyTyparInst;
tyconRefRemap = emptyTyconRefRemap
valRemap = ValMap.Empty
removeTraitSolutions = false }
type Remap with
......@@ -97,7 +107,7 @@ type Remap with
//--------------------------------------------------------------------------
let addTyconRefRemap tcref1 tcref2 tmenv =
{tmenv with tyconRefRemap=tmenv.tyconRefRemap.Add tcref1 tcref2 }
{ tmenv with tyconRefRemap = tmenv.tyconRefRemap.Add tcref1 tcref2 }
let isRemapEmpty remap =
isNil remap.tpinst &&
......@@ -121,7 +131,7 @@ let instMeasureTyparRef tpinst unt (tp:Typar) =
if typarEq tp tp' then
match ty' with
| TType_measure unt -> unt
| _ -> failwith "instMeasureTyparRef incorrect kind";
| _ -> failwith "instMeasureTyparRef incorrect kind"
else
loop t
loop tpinst
......@@ -262,7 +272,6 @@ and remapTraitAux tyenv (TTrait(typs,nm,mf,argtys,rty,slnCell)) =
// in the same way as types
TTrait(remapTypesAux tyenv typs,nm,mf,remapTypesAux tyenv argtys, Option.map (remapTypeAux tyenv) rty,ref slnCell)
and bindTypars tps tyargs tpinst =
match tps with
| [] -> tpinst
......@@ -277,8 +286,8 @@ and copyAndRemapAndBindTyparsFull remapAttrib tyenv tps =
let tps' = copyTypars tps
let tyenv = { tyenv with tpinst = bindTypars tps (generalizeTypars tps') tyenv.tpinst }
(tps,tps') ||> List.iter2 (fun tporig tp ->
tp.FixupConstraints (remapTyparConstraintsAux tyenv tporig.Constraints);
tp.typar_attribs <- tporig.typar_attribs |> remapAttrib) ;
tp.FixupConstraints (remapTyparConstraintsAux tyenv tporig.Constraints)
tp.typar_attribs <- tporig.typar_attribs |> remapAttrib)
tps',tyenv
// copies bound typars, extends tpinst
......@@ -432,7 +441,7 @@ let rec MeasureVarExponent tp unt =
let ListMeasureVarOccs unt =
let rec gather acc unt =
match stripUnitEqnsFromMeasure unt with
Measure.Var tp -> if List.exists (typarEq tp) acc then acc else tp::acc
| Measure.Var tp -> if List.exists (typarEq tp) acc then acc else tp::acc
| Measure.Prod(unt1,unt2) -> gather (gather acc unt1) unt2
| Measure.RationalPower(unt',_) -> gather acc unt'
| Measure.Inv unt' -> gather acc unt'
......@@ -766,19 +775,19 @@ let rangeOfFunTy g ty = snd(destFunTy g ty)
[<NoEquality; NoComparison>]
type TypeEquivEnv =
{ EquivTypars: TyparMap<TType>;
{ EquivTypars: TyparMap<TType>
EquivTycons: TyconRefRemap}
// allocate a singleton
let typeEquivEnvEmpty =
{ EquivTypars = TyparMap.Empty;
{ EquivTypars = TyparMap.Empty
EquivTycons = emptyTyconRefRemap }
type TypeEquivEnv with
static member Empty = typeEquivEnvEmpty
member aenv.BindTyparsToTypes tps1 tys2 =
{aenv with EquivTypars= (tps1,tys2,aenv.EquivTypars) |||> List.foldBack2 (fun tp ty tpmap -> tpmap.Add(tp,ty)) }
{ aenv with EquivTypars = (tps1,tys2,aenv.EquivTypars) |||> List.foldBack2 (fun tp ty tpmap -> tpmap.Add(tp,ty)) }
member aenv.BindEquivTypars tps1 tps2 =
aenv.BindTyparsToTypes tps1 (List.map mkTyparTy tps2)
......@@ -1036,7 +1045,7 @@ type MatchBuilder(spBind,inpRange: Range.range) =
let targets = new ResizeArray<_>(10)
member x.AddTarget(tg) =
let n = targets.Count
targets.Add(tg);
targets.Add tg
n
member x.AddResultTarget(e,spTarget) = TDSuccess([], x.AddTarget(TTarget([],e,spTarget)))
......@@ -1252,22 +1261,42 @@ let mkValAddr m v = Expr.Op (TOp.LValueOp (LGetAddr, v), [], [], m)
[<NoEquality; NoComparison>]
type ValHash<'T> =
| ValHash of Dictionary<Stamp,'T>
member ht.Values = let (ValHash t) = ht in seq { for KeyValue(_,v) in t do yield v }
member ht.TryFind (v:Val) = let (ValHash t) = ht in let i = v.Stamp in if t.ContainsKey(i) then Some(t.[i]) else None
member ht.Add (v:Val, x) = let (ValHash t) = ht in t.[v.Stamp] <- x
static member Create() = ValHash (new Dictionary<_,'T>(11))
member ht.Values =
let (ValHash t) = ht
t.Values :> seq<'T>
member ht.TryFind (v:Val) =
let (ValHash t) = ht
match t.TryGetValue v.Stamp with
| true,v -> Some v
| _ -> None
member ht.Add (v:Val, x) =
let (ValHash t) = ht
t.[v.Stamp] <- x
static member Create() = ValHash (new Dictionary<_,'T>(11))
[<Struct; NoEquality; NoComparison>]
type ValMultiMap<'T>(contents: StampMap<'T list>) =
member m.Find (v: Val) = let stamp = v.Stamp in if contents.ContainsKey stamp then contents.[stamp] else []
member m.Find (v: Val) =
match contents |> Map.tryFind v.Stamp with
| Some vals -> vals
| _ -> []
member m.Add (v:Val, x) = ValMultiMap<'T>(contents.Add (v.Stamp, x :: m.Find v))
member m.Remove (v: Val) = ValMultiMap<'T>(contents.Remove v.Stamp)
member m.Contents = contents
member m.Contents = contents
static member Empty = ValMultiMap<'T>(Map.empty)
[<Struct; NoEquality; NoComparison>]
type TyconRefMultiMap<'T>(contents: TyconRefMap<'T list>) =
member m.Find v = if contents.ContainsKey v then contents.[v] else []
member m.Find v =
match contents.TryFind v with
| Some vals -> vals
| _ -> []
member m.Add (v, x) = TyconRefMultiMap<'T>(contents.Add v (x :: m.Find v))
static member Empty = TyconRefMultiMap<'T>(TyconRefMap<_>.Empty)
static member OfList vs = (vs, TyconRefMultiMap<'T>.Empty) ||> List.foldBack (fun (x,y) acc -> acc.Add (x, y))
......
Markdown is supported
0% 或 .
You are about to add 0 people to the discussion. Proceed with caution.
先完成此消息的编辑！
想要评论请 注册 或