From b0b900a308f3df5881da03aad1b8677059199317 Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Mon, 5 Sep 2016 17:06:36 +0200 Subject: [PATCH 1/9] Cleanup Optimizer --- src/absil/illib.fs | 1 + src/fsharp/Optimizer.fs | 51 ++++++++++++++++++++++++++--------------- 2 files changed, 33 insertions(+), 19 deletions(-) diff --git a/src/absil/illib.fs b/src/absil/illib.fs index abb1c3090ad..91b44acd2b7 100644 --- a/src/absil/illib.fs +++ b/src/absil/illib.fs @@ -780,6 +780,7 @@ module NameMap = let exists f m = Map.foldBack (fun x y sofar -> sofar || f x y) m false let ofKeyedList f l = List.foldBack (fun x acc -> Map.add (f x) x acc) l Map.empty let ofList l : NameMap<'T> = Map.ofList l + let ofSeq l : NameMap<'T> = Map.ofSeq l let ofFlatList (l:FlatList<_>) : NameMap<'T> = FlatList.toMap l let toList (l: NameMap<'T>) = Map.toList l let layer (m1 : NameMap<'T>) m2 = Map.foldBack Map.add m1 m2 diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index 9bb4ba0ecde..70559723f3e 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -467,18 +467,20 @@ let rec BindValsInModuleOrNamespace cenv (mval:LazyModuleInfo) env = let env = (env, mval.ValInfos.Entries) ||> Seq.fold (fun env (v:ValRef, vval) -> BindExternalLocalVal cenv v.Deref vval env) env -let BindInternalValToUnknown cenv v env = +let inline BindInternalValToUnknown cenv v env = #if CHECKED BindInternalLocalVal cenv v UnknownValue env #else - ignore (cenv,v) + ignore cenv + ignore v env #endif -let BindInternalValsToUnknown cenv vs env = +let inline BindInternalValsToUnknown cenv vs env = #if CHECKED List.foldBack (BindInternalValToUnknown cenv) vs env #else - ignore (cenv,vs) + ignore cenv + ignore vs env #endif @@ -2661,7 +2663,6 @@ and OptimizeLambdas (vspec: Val option) cenv env topValInfo e ety = match e with | Expr.Lambda (lambdaId,_,_,_,_,m,_) | Expr.TyLambda(lambdaId,_,_,m,_) -> - let isTopLevel = Option.isSome vspec && vspec.Value.IsCompiledAsTopLevel let tps,ctorThisValOpt,baseValOpt,vsl,body,bodyty = IteratedAdjustArityOfLambda cenv.g cenv.amap topValInfo e let env = { env with functionVal = (match vspec with None -> None | Some v -> Some (v,topValInfo)) } let env = Option.foldBack (BindInternalValToUnknown cenv) ctorThisValOpt env @@ -2715,7 +2716,12 @@ and OptimizeLambdas (vspec: Val option) cenv env topValInfo e ety = CurriedLambdaValue (lambdaId,arities,bsize,expr2,ety) - expr', { TotalSize=bsize + (if isTopLevel then methodDefnTotalSize else closureTotalSize) (* estimate size of new syntactic closure - expensive, in contrast to a method *) + let estimatedSize = + match vspec with + | Some v when v.IsCompiledAsTopLevel -> methodDefnTotalSize + | _ -> closureTotalSize + + expr', { TotalSize=bsize + estimatedSize (* estimate size of new syntactic closure - expensive, in contrast to a method *) FunctionSize=1 HasEffect=false MightMakeCriticalTailcall = false @@ -2739,9 +2745,10 @@ and OptimizeExprsThenConsiderSplits cenv env exprs = | [] -> NoExprs | _ -> OptimizeList (OptimizeExprThenConsiderSplit cenv env) exprs -and OptimizeFlatExprsThenConsiderSplits cenv env (exprs:FlatExprs) = - if FlatList.isEmpty exprs then NoFlatExprs - else OptimizeFlatList (OptimizeExprThenConsiderSplit cenv env) exprs +and OptimizeFlatExprsThenConsiderSplits cenv env exprs = + match exprs with + | [] -> NoFlatExprs + | _ -> OptimizeFlatList (OptimizeExprThenConsiderSplit cenv env) exprs and OptimizeExprThenReshapeAndConsiderSplit cenv env (shape,e) = OptimizeExprThenConsiderSplit cenv env (ReshapeExpr cenv (shape,e)) @@ -3072,7 +3079,7 @@ and OptimizeModuleExpr cenv env x = new ModuleOrNamespaceType(kind=mtyp.ModuleOrNamespaceKind, vals= (mtyp.AllValsAndMembers |> QueueList.filter (Zset.memberOf deadSet >> not)), entities= mtyp.AllEntities) - mtyp.ModuleAndNamespaceDefinitions |> List.iter (fun mspec -> elimModSpec mspec) + mtyp.ModuleAndNamespaceDefinitions |> List.iter elimModSpec mty and elimModSpec (mspec:ModuleOrNamespace) = let mtyp = elimModTy mspec.ModuleOrNamespaceType @@ -3112,16 +3119,22 @@ and OptimizeModuleDef cenv (env,bindInfosColl) x = | TMDefRec(isRec,tycons,mbinds,m) -> let env = if isRec then BindInternalValsToUnknown cenv (allValsOfModDef x) env else env let mbindInfos,(env,bindInfosColl) = OptimizeModuleBindings cenv (env,bindInfosColl) mbinds - let mbinds,minfos = List.unzip mbindInfos - let binds = minfos |> List.choose (function Choice1Of2 (x,_) -> Some x | _ -> None) - let binfos = minfos |> List.choose (function Choice1Of2 (_,x) -> Some x | _ -> None) - let minfos = minfos |> List.choose (function Choice2Of2 x -> Some x | _ -> None) - + let mbinds = List<_>() + let results = List<_>() + let minfos = List<_>() + for mbind,minfo in mbindInfos do + mbinds.Add mbind |> ignore + match minfo with + | Choice1Of2 (bind,binfo) -> + mkValBind bind (mkValInfo binfo bind.Var) + |> results.Add + |> ignore + | Choice2Of2 x -> minfos.Add x |> ignore (* REVIEW: Eliminate let bindings on the way back up *) - (TMDefRec(isRec,tycons,mbinds,m), - notlazy { ValInfos= ValInfos(FlatList.map2 (fun bind binfo -> mkValBind bind (mkValInfo binfo bind.Var)) binds binfos) - ModuleOrNamespaceInfos = NameMap.ofList minfos}), + (TMDefRec(isRec,tycons,Seq.toList mbinds,m), + notlazy { ValInfos = ValInfos(results) + ModuleOrNamespaceInfos = NameMap.ofSeq minfos}), (env,bindInfosColl) | TMAbstract(mexpr) -> let mexpr,info = OptimizeModuleExpr cenv env mexpr @@ -3132,7 +3145,7 @@ and OptimizeModuleDef cenv (env,bindInfosColl) x = (* REVIEW: Eliminate unused let bindings from modules *) (TMDefLet(bind',m), notlazy { ValInfos=ValInfos [mkValBind bind (mkValInfo binfo bind.Var)] - ModuleOrNamespaceInfos = NameMap.ofList []}), + ModuleOrNamespaceInfos = NameMap.empty }), (env ,([bindInfo]::bindInfosColl)) | TMDefDo(e,m) -> From 5f033129128f6f059c7cde9ce48026a906410177 Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Mon, 5 Sep 2016 17:37:50 +0200 Subject: [PATCH 2/9] We don't need to check the lenght here --- src/fsharp/Optimizer.fs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index 70559723f3e..17b98cc32f3 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -2875,8 +2875,7 @@ and OptimizeDecisionTree cenv env m x = let info = CombineValueInfosUnknown [rinfo;binfo] // try to fold the let-binding into a single result expression match rest with - | TDSuccess(es,n) when es.Length = 1 -> - let e = es.[0] + | TDSuccess([e],n) -> let e,_adjust = TryEliminateLet cenv env bind e m TDSuccess(FlatList.one e,n),info | _ -> From 13f8472e73c9062ddc6bbb177c66e8a954c5182e Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Mon, 5 Sep 2016 17:43:43 +0200 Subject: [PATCH 3/9] Don't convert list to array multiple times --- src/fsharp/Optimizer.fs | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index 17b98cc32f3..e056f925476 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -2760,7 +2760,8 @@ and ReshapeExpr cenv (shape,e) = match shape,e with | TupleValue(subshapes), Expr.Val(_vref,_vFlags,m) -> let tinst = destRefTupleTy cenv.g (tyOfExpr cenv.g e) - mkRefTupled cenv.g m (List.mapi (fun i subshape -> ReshapeExpr cenv (subshape,mkTupleFieldGet cenv.g (tupInfoRef,e,tinst,i,m))) (Array.toList subshapes)) tinst + let subshapes = Array.toList subshapes + mkRefTupled cenv.g m (List.mapi (fun i subshape -> ReshapeExpr cenv (subshape,mkTupleFieldGet cenv.g (tupInfoRef,e,tinst,i,m))) subshapes) tinst | _ -> e From e87c158f67cfe046dc70e70cec62a27c2fa55080 Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Mon, 5 Sep 2016 18:08:39 +0200 Subject: [PATCH 4/9] Only fold the Flatlist --- src/fsharp/Optimizer.fs | 115 ++++++++++++++++------------------------ 1 file changed, 45 insertions(+), 70 deletions(-) diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index e056f925476..352e1e327fb 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -2034,7 +2034,7 @@ and OptimizeFastIntegerForLoop cenv env (spStart,v,e1,dir,e2,e3,m) = //------------------------------------------------------------------------- and OptimizeLetRec cenv env (binds,bodyExpr,m) = - let vs = binds |> FlatList.map (fun v -> v.Var) in + let vs = binds |> FlatList.map (fun v -> v.Var) let env = BindInternalValsToUnknown cenv vs env let binds',env = OptimizeBindings cenv true env binds let bodyExpr',einfo = OptimizeExpr cenv env bodyExpr @@ -2042,8 +2042,7 @@ and OptimizeLetRec cenv env (binds,bodyExpr,m) = // Eliminate any unused bindings, as in let case let binds'',bindinfos = let fvs0 = freeInExpr CollectLocals bodyExpr' - let fvsN = FlatList.map (fst >> freeInBindingRhs CollectLocals) binds' - let fvs = FlatList.fold unionFreeVars fvs0 fvsN + let fvs = FlatList.fold (fun acc x -> unionFreeVars acc (fst x |> freeInBindingRhs CollectLocals)) fvs0 binds' SplitValuesByIsUsedOrHasEffect cenv (fun () -> fvs.FreeLocals) binds' // Trim out any optimization info that involves escaping values let evalue' = AbstractExprInfoByVars (FlatList.toList vs,[]) einfo.Info @@ -2208,7 +2207,7 @@ and TryOptimizeVal cenv env (mustInline,valInfoForVal,m) = | SizeValue (_,detail) -> TryOptimizeVal cenv env (mustInline,detail,m) | ValValue (v',detail) -> // Inline values bound to other values immediately - match TryOptimizeVal cenv env (mustInline,detail,m) with + match TryOptimizeVal cenv env (mustInline,detail,m) with // Prefer to inline using the more specific info if possible | Some e -> Some e //If the more specific info didn't reveal an inline then use the value @@ -2302,9 +2301,9 @@ and TakeAddressOfStructArgumentIfNeeded cenv (vref:ValRef) ty args m = wrap, (objArgAddress::rest) | _ -> // no wrapper, args stay the same - (fun x -> x), args + id, args else - (fun x -> x), args + id, args and DevirtualizeApplication cenv env (vref:ValRef) ty tyargs args m = let wrap,args = TakeAddressOfStructArgumentIfNeeded cenv vref ty args m @@ -2398,89 +2397,65 @@ and TryDevirtualizeApplication cenv env (f,tyargs,args,m) = // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericComparisonWithComparerIntrinsic for tuple types | Expr.Val(v,_,_),[ty],_ when valRefEq cenv.g v cenv.g.generic_comparison_inner_vref && isRefTupleTy cenv.g ty -> let tyargs = destRefTupleTy cenv.g ty - let vref = - match tyargs.Length with - | 2 -> Some cenv.g.generic_compare_withc_tuple2_vref - | 3 -> Some cenv.g.generic_compare_withc_tuple3_vref - | 4 -> Some cenv.g.generic_compare_withc_tuple4_vref - | 5 -> Some cenv.g.generic_compare_withc_tuple5_vref - | _ -> None - match vref with - | Some vref -> Some (DevirtualizeApplication cenv env vref ty tyargs (mkCallGetGenericComparer cenv.g m :: args) m) - | None -> None + match tyargs.Length with + | 2 -> Some (DevirtualizeApplication cenv env cenv.g.generic_compare_withc_tuple2_vref ty tyargs (mkCallGetGenericComparer cenv.g m :: args) m) + | 3 -> Some (DevirtualizeApplication cenv env cenv.g.generic_compare_withc_tuple3_vref ty tyargs (mkCallGetGenericComparer cenv.g m :: args) m) + | 4 -> Some (DevirtualizeApplication cenv env cenv.g.generic_compare_withc_tuple4_vref ty tyargs (mkCallGetGenericComparer cenv.g m :: args) m) + | 5 -> Some (DevirtualizeApplication cenv env cenv.g.generic_compare_withc_tuple5_vref ty tyargs (mkCallGetGenericComparer cenv.g m :: args) m) + | _ -> None // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericHashWithComparerIntrinsic for tuple types | Expr.Val(v,_,_),[ty],_ when valRefEq cenv.g v cenv.g.generic_hash_inner_vref && isRefTupleTy cenv.g ty -> let tyargs = destRefTupleTy cenv.g ty - let vref = - match tyargs.Length with - | 2 -> Some cenv.g.generic_hash_withc_tuple2_vref - | 3 -> Some cenv.g.generic_hash_withc_tuple3_vref - | 4 -> Some cenv.g.generic_hash_withc_tuple4_vref - | 5 -> Some cenv.g.generic_hash_withc_tuple5_vref - | _ -> None - match vref with - | Some vref -> Some (DevirtualizeApplication cenv env vref ty tyargs (mkCallGetGenericEREqualityComparer cenv.g m :: args) m) - | None -> None - + match tyargs.Length with + | 2 -> Some (DevirtualizeApplication cenv env cenv.g.generic_hash_withc_tuple2_vref ty tyargs (mkCallGetGenericEREqualityComparer cenv.g m :: args) m) + | 3 -> Some (DevirtualizeApplication cenv env cenv.g.generic_hash_withc_tuple3_vref ty tyargs (mkCallGetGenericEREqualityComparer cenv.g m :: args) m) + | 4 -> Some (DevirtualizeApplication cenv env cenv.g.generic_hash_withc_tuple4_vref ty tyargs (mkCallGetGenericEREqualityComparer cenv.g m :: args) m) + | 5 -> Some (DevirtualizeApplication cenv env cenv.g.generic_hash_withc_tuple5_vref ty tyargs (mkCallGetGenericEREqualityComparer cenv.g m :: args) m) + | _ -> None // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericEqualityIntrinsic for tuple types // REVIEW (5537): GenericEqualityIntrinsic implements PER semantics, and we are replacing it to something also // implementing PER semantics. However GenericEqualityIntrinsic should implement ER semantics. | Expr.Val(v,_,_),[ty],_ when valRefEq cenv.g v cenv.g.generic_equality_per_inner_vref && isRefTupleTy cenv.g ty -> let tyargs = destRefTupleTy cenv.g ty - let vref = - match tyargs.Length with - | 2 -> Some cenv.g.generic_equals_withc_tuple2_vref - | 3 -> Some cenv.g.generic_equals_withc_tuple3_vref - | 4 -> Some cenv.g.generic_equals_withc_tuple4_vref - | 5 -> Some cenv.g.generic_equals_withc_tuple5_vref - | _ -> None - match vref with - | Some vref -> Some (DevirtualizeApplication cenv env vref ty tyargs (mkCallGetGenericPEREqualityComparer cenv.g m :: args) m) - | None -> None + match tyargs.Length with + | 2 -> Some (DevirtualizeApplication cenv env cenv.g.generic_equals_withc_tuple2_vref ty tyargs (mkCallGetGenericPEREqualityComparer cenv.g m :: args) m) + | 3 -> Some (DevirtualizeApplication cenv env cenv.g.generic_equals_withc_tuple3_vref ty tyargs (mkCallGetGenericPEREqualityComparer cenv.g m :: args) m) + | 4 -> Some (DevirtualizeApplication cenv env cenv.g.generic_equals_withc_tuple4_vref ty tyargs (mkCallGetGenericPEREqualityComparer cenv.g m :: args) m) + | 5 -> Some (DevirtualizeApplication cenv env cenv.g.generic_equals_withc_tuple5_vref ty tyargs (mkCallGetGenericPEREqualityComparer cenv.g m :: args) m) + | _ -> None // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericComparisonWithComparerIntrinsic for tuple types | Expr.Val(v,_,_),[ty],_ when valRefEq cenv.g v cenv.g.generic_comparison_withc_inner_vref && isRefTupleTy cenv.g ty -> - let tyargs = destRefTupleTy cenv.g ty - let vref = - match tyargs.Length with - | 2 -> Some cenv.g.generic_compare_withc_tuple2_vref - | 3 -> Some cenv.g.generic_compare_withc_tuple3_vref - | 4 -> Some cenv.g.generic_compare_withc_tuple4_vref - | 5 -> Some cenv.g.generic_compare_withc_tuple5_vref - | _ -> None - match vref with - | Some vref -> Some (DevirtualizeApplication cenv env vref ty tyargs args m) - | None -> None + let tyargs = destRefTupleTy cenv.g ty + match tyargs.Length with + | 2 -> Some (DevirtualizeApplication cenv env cenv.g.generic_compare_withc_tuple2_vref ty tyargs args m) + | 3 -> Some (DevirtualizeApplication cenv env cenv.g.generic_compare_withc_tuple3_vref ty tyargs args m) + | 4 -> Some (DevirtualizeApplication cenv env cenv.g.generic_compare_withc_tuple4_vref ty tyargs args m) + | 5 -> Some (DevirtualizeApplication cenv env cenv.g.generic_compare_withc_tuple5_vref ty tyargs args m) + | _ -> None // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericHashWithComparerIntrinsic for tuple types | Expr.Val(v,_,_),[ty],_ when valRefEq cenv.g v cenv.g.generic_hash_withc_inner_vref && isRefTupleTy cenv.g ty -> let tyargs = destRefTupleTy cenv.g ty - let vref = - match tyargs.Length with - | 2 -> Some cenv.g.generic_hash_withc_tuple2_vref - | 3 -> Some cenv.g.generic_hash_withc_tuple3_vref - | 4 -> Some cenv.g.generic_hash_withc_tuple4_vref - | 5 -> Some cenv.g.generic_hash_withc_tuple5_vref - | _ -> None - match vref with - | Some vref -> Some (DevirtualizeApplication cenv env vref ty tyargs args m) - | None -> None + + match tyargs.Length with + | 2 -> Some (DevirtualizeApplication cenv env cenv.g.generic_hash_withc_tuple2_vref ty tyargs args m) + | 3 -> Some (DevirtualizeApplication cenv env cenv.g.generic_hash_withc_tuple3_vref ty tyargs args m) + | 4 -> Some (DevirtualizeApplication cenv env cenv.g.generic_hash_withc_tuple4_vref ty tyargs args m) + | 5 -> Some (DevirtualizeApplication cenv env cenv.g.generic_hash_withc_tuple5_vref ty tyargs args m) + | _ -> None // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericEqualityWithComparerIntrinsic for tuple types | Expr.Val(v,_,_),[ty],_ when valRefEq cenv.g v cenv.g.generic_equality_withc_inner_vref && isRefTupleTy cenv.g ty -> - let tyargs = destRefTupleTy cenv.g ty - let vref = - match tyargs.Length with - | 2 -> Some cenv.g.generic_equals_withc_tuple2_vref - | 3 -> Some cenv.g.generic_equals_withc_tuple3_vref - | 4 -> Some cenv.g.generic_equals_withc_tuple4_vref - | 5 -> Some cenv.g.generic_equals_withc_tuple5_vref - | _ -> None - match vref with - | Some vref -> Some (DevirtualizeApplication cenv env vref ty tyargs args m) - | None -> None + let tyargs = destRefTupleTy cenv.g ty + match tyargs.Length with + | 2 -> Some (DevirtualizeApplication cenv env cenv.g.generic_equals_withc_tuple2_vref ty tyargs args m) + | 3 -> Some (DevirtualizeApplication cenv env cenv.g.generic_equals_withc_tuple3_vref ty tyargs args m) + | 4 -> Some (DevirtualizeApplication cenv env cenv.g.generic_equals_withc_tuple4_vref ty tyargs args m) + | 5 -> Some (DevirtualizeApplication cenv env cenv.g.generic_equals_withc_tuple5_vref ty tyargs args m) + | _ -> None // Calls to LanguagePrimitives.IntrinsicFunctions.UnboxGeneric can be optimized to calls to UnboxFast when we know that the @@ -2710,7 +2685,7 @@ and OptimizeLambdas (vspec: Val option) cenv env topValInfo e ety = | Some baseVal -> let fvs = freeInExpr CollectLocals body' if fvs.UsesMethodLocalConstructs || fvs.FreeLocals.Contains baseVal then - UnknownValue + UnknownValue else let expr2 = mkMemberLambdas m tps ctorThisValOpt None vsl (body',bodyty) CurriedLambdaValue (lambdaId,arities,bsize,expr2,ety) From f0cc65225c7ed6f2666c831573ccb345aae77ab3 Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Mon, 5 Sep 2016 18:19:39 +0200 Subject: [PATCH 5/9] Optimize FlatList away --- src/fsharp/FlatList.fs | 64 +++++++++++++++++++++--------------------- 1 file changed, 32 insertions(+), 32 deletions(-) diff --git a/src/fsharp/FlatList.fs b/src/fsharp/FlatList.fs index ba9c8af6ab6..66e0f056b7c 100644 --- a/src/fsharp/FlatList.fs +++ b/src/fsharp/FlatList.fs @@ -198,38 +198,38 @@ type internal FlatList<'T> ='T list [] module internal FlatList = let empty<'T> : 'T list = [] - let collect (f: 'T -> FlatList<'T>) (x:FlatList<_>) = List.collect f x - let exists f (x:FlatList<_>) = List.exists f x - let filter f (x:FlatList<_>) = List.filter f x - let fold f acc (x:FlatList<_>) = List.fold f acc x - let fold2 f acc (x:FlatList<_>) (y:FlatList<_>) = List.fold2 f acc x y - let foldBack f (x:FlatList<_>) acc = List.foldBack f x acc - let foldBack2 f (x:FlatList<_>) (y:FlatList<_>) acc = List.foldBack2 f x y acc - let map2 f (x:FlatList<_>) (y:FlatList<_>) = List.map2 f x y - let forall f (x:FlatList<_>) = List.forall f x - let forall2 f (x1:FlatList<_>) (x2:FlatList<_>) = List.forall2 f x1 x2 - let iter2 f (x1:FlatList<_>) (x2:FlatList<_>) = List.iter2 f x1 x2 - let partition f (x:FlatList<_>) = List.partition f x - let (* inline *) sum (x:FlatList) = List.sum x - let (* inline *) sumBy (f: 'T -> int) (x:FlatList<'T>) = List.sumBy f x - let unzip (x:FlatList<_>) = List.unzip x - let physicalEquality (x:FlatList<_>) (y:FlatList<_>) = (LanguagePrimitives.PhysicalEquality x y) - let tryFind f (x:FlatList<_>) = List.tryFind f x - let concat (x:FlatList<_>) = List.concat x - let isEmpty (x:FlatList<_>) = List.isEmpty x - let one(x) = [x] - let toMap (x:FlatList<_>) = Map.ofList x - let length (x:FlatList<_>) = List.length x - let map f (x:FlatList<_>) = List.map f x - let mapi f (x:FlatList<_>) = List.mapi f x - let iter f (x:FlatList<_>) = List.iter f x - let iteri f (x:FlatList<_>) = List.iteri f x - let toList (x:FlatList<_>) = x - let ofSeq (x:seq<_>) = List.ofSeq x - let append(l1 : FlatList<'T>) (l2 : FlatList<'T>) = List.append l1 l2 - let ofList(l) = l - let init n f = List.init n f - let zip (x:FlatList<_>) (y:FlatList<_>) = List.zip x y + let inline collect (f: 'T -> FlatList<'T>) (x:FlatList<_>) = List.collect f x + let inline exists f (x:FlatList<_>) = List.exists f x + let inline filter f (x:FlatList<_>) = List.filter f x + let inline fold f acc (x:FlatList<_>) = List.fold f acc x + let inline fold2 f acc (x:FlatList<_>) (y:FlatList<_>) = List.fold2 f acc x y + let inline foldBack f (x:FlatList<_>) acc = List.foldBack f x acc + let inline foldBack2 f (x:FlatList<_>) (y:FlatList<_>) acc = List.foldBack2 f x y acc + let inline map2 f (x:FlatList<_>) (y:FlatList<_>) = List.map2 f x y + let inline forall f (x:FlatList<_>) = List.forall f x + let inline forall2 f (x1:FlatList<_>) (x2:FlatList<_>) = List.forall2 f x1 x2 + let inline iter2 f (x1:FlatList<_>) (x2:FlatList<_>) = List.iter2 f x1 x2 + let inline partition f (x:FlatList<_>) = List.partition f x + let inline sum (x:FlatList) = List.sum x + let inline sumBy (f: 'T -> int) (x:FlatList<'T>) = List.sumBy f x + let inline unzip (x:FlatList<_>) = List.unzip x + let inline physicalEquality (x:FlatList<_>) (y:FlatList<_>) = (LanguagePrimitives.PhysicalEquality x y) + let inline tryFind f (x:FlatList<_>) = List.tryFind f x + let inline concat (x:FlatList<_>) = List.concat x + let inline isEmpty (x:FlatList<_>) = List.isEmpty x + let inline one(x) = [x] + let inline toMap (x:FlatList<_>) = Map.ofList x + let inline length (x:FlatList<_>) = List.length x + let inline map f (x:FlatList<_>) = List.map f x + let inline mapi f (x:FlatList<_>) = List.mapi f x + let inline iter f (x:FlatList<_>) = List.iter f x + let inline iteri f (x:FlatList<_>) = List.iteri f x + let inline toList (x:FlatList<_>) = x + let inline ofSeq (x:seq<_>) = List.ofSeq x + let inline append(l1 : FlatList<'T>) (l2 : FlatList<'T>) = List.append l1 l2 + let inline ofList(l) = l + let inline init n f = List.init n f + let inline zip (x:FlatList<_>) (y:FlatList<_>) = List.zip x y #endif #if FLAT_LIST_AS_ARRAY From 12d1412da3ac687859047e8b1d4fba41a3a365d7 Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Mon, 5 Sep 2016 20:52:09 +0200 Subject: [PATCH 6/9] Revert code duplication --- src/fsharp/Optimizer.fs | 102 +++++++++++++++++++++++++--------------- 1 file changed, 63 insertions(+), 39 deletions(-) diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index 352e1e327fb..735847c2e0c 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -2397,65 +2397,89 @@ and TryDevirtualizeApplication cenv env (f,tyargs,args,m) = // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericComparisonWithComparerIntrinsic for tuple types | Expr.Val(v,_,_),[ty],_ when valRefEq cenv.g v cenv.g.generic_comparison_inner_vref && isRefTupleTy cenv.g ty -> let tyargs = destRefTupleTy cenv.g ty - match tyargs.Length with - | 2 -> Some (DevirtualizeApplication cenv env cenv.g.generic_compare_withc_tuple2_vref ty tyargs (mkCallGetGenericComparer cenv.g m :: args) m) - | 3 -> Some (DevirtualizeApplication cenv env cenv.g.generic_compare_withc_tuple3_vref ty tyargs (mkCallGetGenericComparer cenv.g m :: args) m) - | 4 -> Some (DevirtualizeApplication cenv env cenv.g.generic_compare_withc_tuple4_vref ty tyargs (mkCallGetGenericComparer cenv.g m :: args) m) - | 5 -> Some (DevirtualizeApplication cenv env cenv.g.generic_compare_withc_tuple5_vref ty tyargs (mkCallGetGenericComparer cenv.g m :: args) m) - | _ -> None + let vref = + match tyargs.Length with + | 2 -> Some cenv.g.generic_compare_withc_tuple2_vref + | 3 -> Some cenv.g.generic_compare_withc_tuple3_vref + | 4 -> Some cenv.g.generic_compare_withc_tuple4_vref + | 5 -> Some cenv.g.generic_compare_withc_tuple5_vref + | _ -> None + match vref with + | Some vref -> Some (DevirtualizeApplication cenv env vref ty tyargs (mkCallGetGenericComparer cenv.g m :: args) m) + | None -> None // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericHashWithComparerIntrinsic for tuple types | Expr.Val(v,_,_),[ty],_ when valRefEq cenv.g v cenv.g.generic_hash_inner_vref && isRefTupleTy cenv.g ty -> let tyargs = destRefTupleTy cenv.g ty - match tyargs.Length with - | 2 -> Some (DevirtualizeApplication cenv env cenv.g.generic_hash_withc_tuple2_vref ty tyargs (mkCallGetGenericEREqualityComparer cenv.g m :: args) m) - | 3 -> Some (DevirtualizeApplication cenv env cenv.g.generic_hash_withc_tuple3_vref ty tyargs (mkCallGetGenericEREqualityComparer cenv.g m :: args) m) - | 4 -> Some (DevirtualizeApplication cenv env cenv.g.generic_hash_withc_tuple4_vref ty tyargs (mkCallGetGenericEREqualityComparer cenv.g m :: args) m) - | 5 -> Some (DevirtualizeApplication cenv env cenv.g.generic_hash_withc_tuple5_vref ty tyargs (mkCallGetGenericEREqualityComparer cenv.g m :: args) m) - | _ -> None + let vref = + match tyargs.Length with + | 2 -> Some cenv.g.generic_hash_withc_tuple2_vref + | 3 -> Some cenv.g.generic_hash_withc_tuple3_vref + | 4 -> Some cenv.g.generic_hash_withc_tuple4_vref + | 5 -> Some cenv.g.generic_hash_withc_tuple5_vref + | _ -> None + match vref with + | Some vref -> Some (DevirtualizeApplication cenv env vref ty tyargs (mkCallGetGenericEREqualityComparer cenv.g m :: args) m) + | None -> None + // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericEqualityIntrinsic for tuple types // REVIEW (5537): GenericEqualityIntrinsic implements PER semantics, and we are replacing it to something also // implementing PER semantics. However GenericEqualityIntrinsic should implement ER semantics. | Expr.Val(v,_,_),[ty],_ when valRefEq cenv.g v cenv.g.generic_equality_per_inner_vref && isRefTupleTy cenv.g ty -> let tyargs = destRefTupleTy cenv.g ty - match tyargs.Length with - | 2 -> Some (DevirtualizeApplication cenv env cenv.g.generic_equals_withc_tuple2_vref ty tyargs (mkCallGetGenericPEREqualityComparer cenv.g m :: args) m) - | 3 -> Some (DevirtualizeApplication cenv env cenv.g.generic_equals_withc_tuple3_vref ty tyargs (mkCallGetGenericPEREqualityComparer cenv.g m :: args) m) - | 4 -> Some (DevirtualizeApplication cenv env cenv.g.generic_equals_withc_tuple4_vref ty tyargs (mkCallGetGenericPEREqualityComparer cenv.g m :: args) m) - | 5 -> Some (DevirtualizeApplication cenv env cenv.g.generic_equals_withc_tuple5_vref ty tyargs (mkCallGetGenericPEREqualityComparer cenv.g m :: args) m) - | _ -> None + let vref = + match tyargs.Length with + | 2 -> Some cenv.g.generic_equals_withc_tuple2_vref + | 3 -> Some cenv.g.generic_equals_withc_tuple3_vref + | 4 -> Some cenv.g.generic_equals_withc_tuple4_vref + | 5 -> Some cenv.g.generic_equals_withc_tuple5_vref + | _ -> None + match vref with + | Some vref -> Some (DevirtualizeApplication cenv env vref ty tyargs (mkCallGetGenericPEREqualityComparer cenv.g m :: args) m) + | None -> None // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericComparisonWithComparerIntrinsic for tuple types | Expr.Val(v,_,_),[ty],_ when valRefEq cenv.g v cenv.g.generic_comparison_withc_inner_vref && isRefTupleTy cenv.g ty -> - let tyargs = destRefTupleTy cenv.g ty - match tyargs.Length with - | 2 -> Some (DevirtualizeApplication cenv env cenv.g.generic_compare_withc_tuple2_vref ty tyargs args m) - | 3 -> Some (DevirtualizeApplication cenv env cenv.g.generic_compare_withc_tuple3_vref ty tyargs args m) - | 4 -> Some (DevirtualizeApplication cenv env cenv.g.generic_compare_withc_tuple4_vref ty tyargs args m) - | 5 -> Some (DevirtualizeApplication cenv env cenv.g.generic_compare_withc_tuple5_vref ty tyargs args m) - | _ -> None + let tyargs = destRefTupleTy cenv.g ty + let vref = + match tyargs.Length with + | 2 -> Some cenv.g.generic_compare_withc_tuple2_vref + | 3 -> Some cenv.g.generic_compare_withc_tuple3_vref + | 4 -> Some cenv.g.generic_compare_withc_tuple4_vref + | 5 -> Some cenv.g.generic_compare_withc_tuple5_vref + | _ -> None + match vref with + | Some vref -> Some (DevirtualizeApplication cenv env vref ty tyargs args m) + | None -> None // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericHashWithComparerIntrinsic for tuple types | Expr.Val(v,_,_),[ty],_ when valRefEq cenv.g v cenv.g.generic_hash_withc_inner_vref && isRefTupleTy cenv.g ty -> let tyargs = destRefTupleTy cenv.g ty - - match tyargs.Length with - | 2 -> Some (DevirtualizeApplication cenv env cenv.g.generic_hash_withc_tuple2_vref ty tyargs args m) - | 3 -> Some (DevirtualizeApplication cenv env cenv.g.generic_hash_withc_tuple3_vref ty tyargs args m) - | 4 -> Some (DevirtualizeApplication cenv env cenv.g.generic_hash_withc_tuple4_vref ty tyargs args m) - | 5 -> Some (DevirtualizeApplication cenv env cenv.g.generic_hash_withc_tuple5_vref ty tyargs args m) - | _ -> None + let vref = + match tyargs.Length with + | 2 -> Some cenv.g.generic_hash_withc_tuple2_vref + | 3 -> Some cenv.g.generic_hash_withc_tuple3_vref + | 4 -> Some cenv.g.generic_hash_withc_tuple4_vref + | 5 -> Some cenv.g.generic_hash_withc_tuple5_vref + | _ -> None + match vref with + | Some vref -> Some (DevirtualizeApplication cenv env vref ty tyargs args m) + | None -> None // Optimize/analyze calls to LanguagePrimitives.HashCompare.GenericEqualityWithComparerIntrinsic for tuple types | Expr.Val(v,_,_),[ty],_ when valRefEq cenv.g v cenv.g.generic_equality_withc_inner_vref && isRefTupleTy cenv.g ty -> - let tyargs = destRefTupleTy cenv.g ty - match tyargs.Length with - | 2 -> Some (DevirtualizeApplication cenv env cenv.g.generic_equals_withc_tuple2_vref ty tyargs args m) - | 3 -> Some (DevirtualizeApplication cenv env cenv.g.generic_equals_withc_tuple3_vref ty tyargs args m) - | 4 -> Some (DevirtualizeApplication cenv env cenv.g.generic_equals_withc_tuple4_vref ty tyargs args m) - | 5 -> Some (DevirtualizeApplication cenv env cenv.g.generic_equals_withc_tuple5_vref ty tyargs args m) - | _ -> None + let tyargs = destRefTupleTy cenv.g ty + let vref = + match tyargs.Length with + | 2 -> Some cenv.g.generic_equals_withc_tuple2_vref + | 3 -> Some cenv.g.generic_equals_withc_tuple3_vref + | 4 -> Some cenv.g.generic_equals_withc_tuple4_vref + | 5 -> Some cenv.g.generic_equals_withc_tuple5_vref + | _ -> None + match vref with + | Some vref -> Some (DevirtualizeApplication cenv env vref ty tyargs args m) + | None -> None // Calls to LanguagePrimitives.IntrinsicFunctions.UnboxGeneric can be optimized to calls to UnboxFast when we know that the From 7647050764ee96d2b4025764c6ee501b32249e61 Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Mon, 5 Sep 2016 21:11:12 +0200 Subject: [PATCH 7/9] match => if --- src/fsharp/Optimizer.fs | 10 ++++++---- 1 file changed, 6 insertions(+), 4 deletions(-) diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index 735847c2e0c..39b74f2dbe4 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -570,9 +570,11 @@ let GetInfoForNonLocalVal cenv env (vref:ValRef) = let GetInfoForVal cenv env m (vref:ValRef) = let res = - match vref.IsLocalRef with - | true -> GetInfoForLocalValue cenv env vref.binding m - | false -> GetInfoForNonLocalVal cenv env vref + if vref.IsLocalRef then + GetInfoForLocalValue cenv env vref.binding m + else + GetInfoForNonLocalVal cenv env vref + check (* "its stored value was incomplete" m *) vref res |> ignore res @@ -2640,7 +2642,7 @@ and OptimizeApplication cenv env (f0,f0ty,tyargs,args,m) = | None -> match env.functionVal with | Some (_v,i) -> numArgs > i.NumCurriedArgs - | None -> true // over-applicaiton of a known function, which presumably returns a function. This counts as an indirect call + | None -> true // over-application of a known function, which presumably returns a function. This counts as an indirect call else true // application of a function that may make a critical tailcall From 29251f40a25856e8928743cb256e47ba24c1a3bb Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Tue, 6 Sep 2016 08:55:32 +0200 Subject: [PATCH 8/9] cleanup --- src/fsharp/Optimizer.fs | 32 +++++++++++++++++--------------- 1 file changed, 17 insertions(+), 15 deletions(-) diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index 39b74f2dbe4..340c269b28e 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -2598,21 +2598,23 @@ and OptimizeApplication cenv env (f0,f0ty,tyargs,args,m) = let shapes = match f0' with - | Expr.Val(vref,_,_) when Option.isSome vref.ValReprInfo -> - let (ValReprInfo(_kinds,detupArgsL,_)) = Option.get vref.ValReprInfo - let nargs = (args.Length) - let nDetupArgsL = detupArgsL.Length - let nShapes = min nargs nDetupArgsL - let detupArgsShapesL = - List.take nShapes detupArgsL |> List.map (fun detupArgs -> - match detupArgs with - | [] | [_] -> UnknownValue - | _ -> TupleValue(Array.ofList (List.map (fun _ -> UnknownValue) detupArgs))) - detupArgsShapesL @ List.replicate (nargs - nShapes) UnknownValue - - | _ -> args |> List.map (fun _ -> UnknownValue) - - let args',arginfos = OptimizeExprsThenReshapeAndConsiderSplits cenv env (List.zip shapes args) + | Expr.Val(vref,_,_) -> + match vref.ValReprInfo with + | Some(ValReprInfo(_,detupArgsL,_)) -> + let nargs = args.Length + let nDetupArgsL = detupArgsL.Length + let nShapes = min nargs nDetupArgsL + let detupArgsShapesL = + List.take nShapes detupArgsL + |> List.map (fun detupArgs -> + match detupArgs with + | [] | [_] -> UnknownValue + | _ -> TupleValue(Array.ofList (List.map (fun _ -> UnknownValue) detupArgs))) + List.zip (detupArgsShapesL @ List.replicate (nargs - nShapes) UnknownValue) args + | _ -> args |> List.map (fun arg -> UnknownValue,arg) + | _ -> args |> List.map (fun arg -> UnknownValue,arg) + + let args',arginfos = OptimizeExprsThenReshapeAndConsiderSplits cenv env shapes // beta reducing let expr' = MakeApplicationAndBetaReduce cenv.g (f0',f0ty, [tyargs],args',m) From 5f4209fc8d97dfe03389fd1c0b14f5a09df250b8 Mon Sep 17 00:00:00 2001 From: Steffen Forkmann Date: Tue, 6 Sep 2016 09:59:10 +0200 Subject: [PATCH 9/9] DevirtualizeApplication doesn't need optimized Expression --- src/fsharp/Optimizer.fs | 54 ++++++++++++++++++----------------------- 1 file changed, 23 insertions(+), 31 deletions(-) diff --git a/src/fsharp/Optimizer.fs b/src/fsharp/Optimizer.fs index 340c269b28e..b547523882f 100644 --- a/src/fsharp/Optimizer.fs +++ b/src/fsharp/Optimizer.fs @@ -2582,22 +2582,21 @@ and TryInlineApplication cenv env (_f0',finfo) (tyargs: TType list,args: Expr li //------------------------------------------------------------------------- and OptimizeApplication cenv env (f0,f0ty,tyargs,args,m) = - let f0',finfo = OptimizeExpr cenv env f0 // trying to devirtualize match TryDevirtualizeApplication cenv env (f0,tyargs,args,m) with | Some res -> // devirtualized res | None -> - - match TryInlineApplication cenv env (f0',finfo) (tyargs,args,m) with + let newf0,finfo = OptimizeExpr cenv env f0 + match TryInlineApplication cenv env (newf0,finfo) (tyargs,args,m) with | Some res -> // inlined res | None -> let shapes = - match f0' with + match newf0 with | Expr.Val(vref,_,_) -> match vref.ValReprInfo with | Some(ValReprInfo(_,detupArgsL,_)) -> @@ -2614,20 +2613,20 @@ and OptimizeApplication cenv env (f0,f0ty,tyargs,args,m) = | _ -> args |> List.map (fun arg -> UnknownValue,arg) | _ -> args |> List.map (fun arg -> UnknownValue,arg) - let args',arginfos = OptimizeExprsThenReshapeAndConsiderSplits cenv env shapes + let newArgs,arginfos = OptimizeExprsThenReshapeAndConsiderSplits cenv env shapes // beta reducing - let expr' = MakeApplicationAndBetaReduce cenv.g (f0',f0ty, [tyargs],args',m) + let newExpr = MakeApplicationAndBetaReduce cenv.g (newf0,f0ty, [tyargs],newArgs,m) - match f0', expr' with + match newf0, newExpr with | (Expr.Lambda _ | Expr.TyLambda _), Expr.Let _ -> // we beta-reduced, hence reoptimize - OptimizeExpr cenv env expr' + OptimizeExpr cenv env newExpr | _ -> // regular // Determine if this application is a critical tailcall let mayBeCriticalTailcall = - match f0' with + match newf0 with | KnownValApp(vref,_typeArgs,otherArgs) -> // Check if this is a call to a function of known arity that has been inferred to not be a critical tailcall when used as a direct call @@ -2638,7 +2637,7 @@ and OptimizeApplication cenv env (f0,f0ty,tyargs,args,m) = (let valInfoForVal = GetInfoForVal cenv env m vref in valInfoForVal.ValMakesNoCriticalTailcalls) || (match env.functionVal with | None -> false | Some (v,_) -> valEq vref.Deref v) if doesNotMakeCriticalTailcall then - let numArgs = otherArgs.Length + args'.Length + let numArgs = otherArgs.Length + newArgs.Length match vref.ValReprInfo with | Some i -> numArgs > i.NumCurriedArgs | None -> @@ -2652,11 +2651,11 @@ and OptimizeApplication cenv env (f0,f0ty,tyargs,args,m) = // All indirect calls (calls to unknown functions) are assumed to be critical tailcalls true - expr', { TotalSize=finfo.TotalSize + AddTotalSizes arginfos - FunctionSize=finfo.FunctionSize + AddFunctionSizes arginfos - HasEffect=true - MightMakeCriticalTailcall = mayBeCriticalTailcall - Info=ValueOfExpr expr' } + newExpr, { TotalSize=finfo.TotalSize + AddTotalSizes arginfos + FunctionSize=finfo.FunctionSize + AddFunctionSizes arginfos + HasEffect=true + MightMakeCriticalTailcall = mayBeCriticalTailcall + Info=ValueOfExpr newExpr } //------------------------------------------------------------------------- // Optimize/analyze a lambda expression @@ -3122,23 +3121,16 @@ and OptimizeModuleDef cenv (env,bindInfosColl) x = | TMDefRec(isRec,tycons,mbinds,m) -> let env = if isRec then BindInternalValsToUnknown cenv (allValsOfModDef x) env else env let mbindInfos,(env,bindInfosColl) = OptimizeModuleBindings cenv (env,bindInfosColl) mbinds - let mbinds = List<_>() - let results = List<_>() - let minfos = List<_>() - for mbind,minfo in mbindInfos do - mbinds.Add mbind |> ignore - match minfo with - | Choice1Of2 (bind,binfo) -> - mkValBind bind (mkValInfo binfo bind.Var) - |> results.Add - |> ignore - | Choice2Of2 x -> minfos.Add x |> ignore + let mbinds,minfos = List.unzip mbindInfos + let binds = minfos |> List.choose (function Choice1Of2 (x,_) -> Some x | _ -> None) + let binfos = minfos |> List.choose (function Choice1Of2 (_,x) -> Some x | _ -> None) + let minfos = minfos |> List.choose (function Choice2Of2 x -> Some x | _ -> None) - (* REVIEW: Eliminate let bindings on the way back up *) - (TMDefRec(isRec,tycons,Seq.toList mbinds,m), - notlazy { ValInfos = ValInfos(results) - ModuleOrNamespaceInfos = NameMap.ofSeq minfos}), - (env,bindInfosColl) + (* REVIEW: Eliminate let bindings on the way back up *) + (TMDefRec(isRec,tycons,mbinds,m), + notlazy { ValInfos = ValInfos(FlatList.map2 (fun bind binfo -> mkValBind bind (mkValInfo binfo bind.Var)) binds binfos) + ModuleOrNamespaceInfos = NameMap.ofList minfos}), + (env,bindInfosColl) | TMAbstract(mexpr) -> let mexpr,info = OptimizeModuleExpr cenv env mexpr let env = BindValsInModuleOrNamespace cenv info env