Cleanup Optimizer (#1519)

* Cleanup Optimizer
Thank you for taking care of this.
* We don't need to check the lenght here

* Don't convert list to array multiple times

* Only fold the Flatlist

* Optimize FlatList away

* Revert code duplication

* match => if

* cleanup

* DevirtualizeApplication doesn't need optimized Expression

Author: forki

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

src/fsharp/FlatList.fs

@@ -198,38 +198,38 @@ type internal FlatList<'T> ='T list
 [<CompilationRepresentation(CompilationRepresentationFlags.ModuleSuffix)>]
 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<int>) = 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<int>) = 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

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
 
@@ -568,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
 
@@ -2032,16 +2036,15 @@ 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 
     // REVIEW: graph analysis to determine which items are unused 
     // 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 
@@ -2206,7 +2209,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 
@@ -2300,9 +2303,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
@@ -2579,50 +2582,51 @@ 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 
-        | 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) 
+        match newf0 with 
+        | 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 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
@@ -2633,25 +2637,25 @@ 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 -> 
                     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
 
             | _ -> 
                 // 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
@@ -2661,7 +2665,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
@@ -2709,13 +2712,18 @@ 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) 
 
 
-        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 +2747,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))
@@ -2753,7 +2762,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
 
@@ -2868,8 +2878,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
             | _ -> 
@@ -3072,7 +3081,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 
@@ -3116,13 +3125,12 @@ and OptimizeModuleDef cenv (env,bindInfosColl) x =
         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 *)
+        (* 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) 
+         notlazy { ValInfos = ValInfos(FlatList.map2 (fun bind binfo -> mkValBind bind (mkValInfo binfo bind.Var)) binds binfos) 
                    ModuleOrNamespaceInfos = NameMap.ofList minfos}),
-         (env,bindInfosColl)
+        (env,bindInfosColl)
     | TMAbstract(mexpr) -> 
         let mexpr,info = OptimizeModuleExpr cenv env mexpr
         let env = BindValsInModuleOrNamespace cenv info env
@@ -3132,7 +3140,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)  ->