process large expressions systematically

src/fsharp/InnerLambdasToTopLevelFuncs.fs

@@ -1073,9 +1073,14 @@ module Pass4_RewriteAssembly =
     /// At free vals,    fixup 0-call if it is an arity-met constant.
     /// Other cases rewrite structurally.
     let rec TransExpr (penv: RewriteContext) (z:RewriteState) expr : Expr * RewriteState =
+
         match expr with
-        // Use TransLinearExpr with a rebuild-continuation for some forms to avoid stack overflows on large terms *)
-        | Expr.LetRec _ | Expr.Let    _ | Expr.Sequential _ -> 
+        // Use TransLinearExpr with a rebuild-continuation for some forms to avoid stack overflows on large terms 
+        | LinearOpExpr _
+        | LinearMatchExpr _ 
+        | Expr.LetRec _ // note, Expr.LetRec not normally considered linear, but keeping it here as it's always been here
+        | Expr.Let    _ 
+        | Expr.Sequential _ -> 
              TransLinearExpr penv z expr (fun res -> res)
 
         // app - call sites may require z.
@@ -1138,19 +1143,25 @@ module Pass4_RewriteAssembly =
             MakePreDecs m pds (mkAndSimplifyMatch spBind exprm m ty dtree targets),z
 
         // all others - below - rewrite structurally - so boiler plate code after this point... 
-        | Expr.Const _ -> expr,z (* constant wrt Val *)
+        | Expr.Const _ -> 
+            expr,z 
+
         | Expr.Quote (a,{contents=Some(typeDefs,argTypes,argExprs,data)},isFromQueryExpression,m,ty) -> 
             let argExprs,z = List.mapFold (TransExpr penv) z argExprs
             Expr.Quote(a,{contents=Some(typeDefs,argTypes,argExprs,data)},isFromQueryExpression,m,ty),z
+
         | Expr.Quote (a,{contents=None},isFromQueryExpression,m,ty) -> 
             Expr.Quote(a,{contents=None},isFromQueryExpression,m,ty),z
+
         | Expr.Op (c,tyargs,args,m) -> 
             let args,z = List.mapFold (TransExpr penv) z args
             Expr.Op(c,tyargs,args,m),z
+
         | Expr.StaticOptimization (constraints,e2,e3,m) ->
             let e2,z = TransExpr penv z e2
             let e3,z = TransExpr penv z e3
             Expr.StaticOptimization(constraints,e2,e3,m),z
+
         | Expr.TyChoose (_,_,m) -> 
             error(Error(FSComp.SR.tlrUnexpectedTExpr(),m))
 
@@ -1203,9 +1214,16 @@ module Pass4_RewriteAssembly =
              let tg1,z = TransDecisionTreeTarget penv z tg1
              // tailcall
              TransLinearExpr penv z e2 (contf << (fun (e2,z) ->
-                 rebuildLinearMatchExpr (spBind,exprm,dtree,tg1,e2,sp2,m2,ty),z))
+                 rebuildLinearMatchExpr (spBind,exprm,dtree,tg1,e2,sp2,m2,ty), z))
+
+         | LinearOpExpr (op, tyargs, argsHead, argLast, m) ->
+             let argsHead,z = List.mapFold (TransExpr penv) z argsHead
+             // tailcall
+             TransLinearExpr penv z argLast (contf << (fun (argLast, z) ->
+                 rebuildLinearOpExpr (op, tyargs, argsHead, argLast, m), z))
 
          | _ -> 
+            // not a linear expression
             contf (TransExpr penv z expr)
 
     and TransMethod penv (z:RewriteState) (TObjExprMethod(slotsig,attribs,tps,vs,e,m)) =

src/fsharp/Optimizer.fs

@@ -1274,9 +1274,13 @@ let rec ExprHasEffect g expr =
     | Expr.Let(bind, body, _, _) -> BindingHasEffect g bind || ExprHasEffect g body
     // REVIEW: could add Expr.Obj on an interface type - these are similar to records of lambda expressions 
     | _ -> true
+
 and ExprsHaveEffect g exprs = List.exists (ExprHasEffect g) exprs
+
 and BindingsHaveEffect g binds = List.exists (BindingHasEffect g) binds
+
 and BindingHasEffect g bind = bind.Expr |> ExprHasEffect g
+
 and OpHasEffect g m op = 
     match op with 
     | TOp.Tuple _ -> false
@@ -1788,10 +1792,18 @@ let rec OptimizeExpr cenv (env:IncrementalOptimizationEnv) expr =
 
     match expr with
     // treat the common linear cases to avoid stack overflows, using an explicit continuation 
-    | Expr.Sequential _ | Expr.Let _ ->  OptimizeLinearExpr cenv env expr (fun x -> x)
+    | LinearOpExpr _
+    | LinearMatchExpr _
+    | Expr.Sequential _ 
+    | Expr.Let _ ->  
+        OptimizeLinearExpr cenv env expr (fun x -> x)
+
+    | Expr.Const (c, m, ty) -> 
+        OptimizeConst cenv env expr (c, m, ty)
+
+    | Expr.Val (v, _vFlags, m) -> 
+        OptimizeVal cenv env expr (v, m)
 
-    | Expr.Const (c, m, ty) -> OptimizeConst cenv env expr (c, m, ty)
-    | Expr.Val (v, _vFlags, m) -> OptimizeVal cenv env expr (v, m)
     | Expr.Quote(ast, splices, isFromQueryExpression, m, ty) -> 
           let splices = ref (splices.Value |> Option.map (map3Of4 (List.map (OptimizeExpr cenv env >> fst))))
           Expr.Quote(ast, splices, isFromQueryExpression, m, ty), 
@@ -1800,34 +1812,48 @@ let rec OptimizeExpr cenv (env:IncrementalOptimizationEnv) expr =
             HasEffect = false  
             MightMakeCriticalTailcall=false
             Info=UnknownValue }
-    | Expr.Obj (_, ty, basev, expr, overrides, iimpls, m) -> OptimizeObjectExpr cenv env (ty, basev, expr, overrides, iimpls, m)
-    | Expr.Op (c, tyargs, args, m) -> OptimizeExprOp cenv env (c, tyargs, args, m)
+
+    | Expr.Obj (_, ty, basev, createExpr, overrides, iimpls, m) -> 
+        OptimizeObjectExpr cenv env (ty, basev, createExpr, overrides, iimpls, m)
+
+    | Expr.Op (op, tyargs, args, m) -> 
+        OptimizeExprOp cenv env (op, tyargs, args, m)
+
     | Expr.App(f, fty, tyargs, argsl, m) -> 
         // eliminate uses of query
         match TryDetectQueryQuoteAndRun cenv expr with 
         | Some newExpr -> OptimizeExpr cenv env newExpr
         | None -> OptimizeApplication cenv env (f, fty, tyargs, argsl, m) 
-    (* REVIEW: fold the next two cases together *)
+
     | Expr.Lambda(_lambdaId, _, _, argvs, _body, m, rty) -> 
         let topValInfo = ValReprInfo ([], [argvs |> List.map (fun _ -> ValReprInfo.unnamedTopArg1)], ValReprInfo.unnamedRetVal)
         let ty = mkMultiLambdaTy m argvs rty
         OptimizeLambdas None cenv env topValInfo expr ty
+
     | Expr.TyLambda(_lambdaId, tps, _body, _m, rty)  -> 
         let topValInfo = ValReprInfo (ValReprInfo.InferTyparInfo tps, [], ValReprInfo.unnamedRetVal)
         let ty = mkForallTyIfNeeded tps rty
         OptimizeLambdas None cenv env topValInfo expr ty
-    | Expr.TyChoose _  -> OptimizeExpr cenv env (TypeRelations.ChooseTyparSolutionsForFreeChoiceTypars cenv.g cenv.amap expr)
-    | Expr.Match(spMatch, exprm, dtree, targets, m, ty) -> OptimizeMatch cenv env (spMatch, exprm, dtree, targets, m, ty)
-    | Expr.LetRec (binds, e, m, _) ->  OptimizeLetRec cenv env (binds, e, m)
-    | Expr.StaticOptimization (constraints, e2, e3, m) ->
-        let e2', e2info = OptimizeExpr cenv env e2
-        let e3', e3info = OptimizeExpr cenv env e3
-        Expr.StaticOptimization(constraints, e2', e3', m), 
+
+    | Expr.TyChoose _  -> 
+        OptimizeExpr cenv env (TypeRelations.ChooseTyparSolutionsForFreeChoiceTypars cenv.g cenv.amap expr)
+
+    | Expr.Match(spMatch, exprm, dtree, targets, m, ty) -> 
+        OptimizeMatch cenv env (spMatch, exprm, dtree, targets, m, ty)
+
+    | Expr.LetRec (binds, bodyExpr, m, _) ->  
+        OptimizeLetRec cenv env (binds, bodyExpr, m)
+
+    | Expr.StaticOptimization (constraints, expr2, expr3, m) ->
+        let expr2R, e2info = OptimizeExpr cenv env expr2
+        let expr3R, e3info = OptimizeExpr cenv env expr3
+        Expr.StaticOptimization(constraints, expr2R, expr3R, m), 
         { TotalSize = min e2info.TotalSize e3info.TotalSize
           FunctionSize = min e2info.FunctionSize e3info.FunctionSize
           HasEffect = e2info.HasEffect || e3info.HasEffect
           MightMakeCriticalTailcall=e2info.MightMakeCriticalTailcall || e3info.MightMakeCriticalTailcall // seems conservative
           Info= UnknownValue }
+
     | Expr.Link _eref -> 
         assert ("unexpected reclink" = "")
         failwith "Unexpected reclink"
@@ -1851,7 +1877,9 @@ and OptimizeObjectExpr cenv env (ty, baseValOpt, basecall, overrides, iimpls, m)
 // Optimize/analyze the methods that make up an object expression
 //------------------------------------------------------------------------- 
 
-and OptimizeMethods cenv env baseValOpt l = OptimizeList (OptimizeMethod cenv env baseValOpt) l
+and OptimizeMethods cenv env baseValOpt methods = 
+    OptimizeList (OptimizeMethod cenv env baseValOpt) methods
+
 and OptimizeMethod cenv env baseValOpt (TObjExprMethod(slotsig, attribs, tps, vs, e, m) as tmethod) = 
     let env = {env with latestBoundId=Some tmethod.Id; functionVal = None}
     let env = BindTypeVarsToUnknown tps env
@@ -1866,11 +1894,11 @@ and OptimizeMethod cenv env baseValOpt (TObjExprMethod(slotsig, attribs, tps, vs
       MightMakeCriticalTailcall=false
       Info=UnknownValue}
 
-//-------------------------------------------------------------------------
-// Optimize/analyze the interface implementations that form part of an object expression
-//------------------------------------------------------------------------- 
+/// Optimize/analyze the interface implementations that form part of an object expression
+and OptimizeInterfaceImpls cenv env baseValOpt iimpls = 
+    OptimizeList (OptimizeInterfaceImpl cenv env baseValOpt) iimpls
 
-and OptimizeInterfaceImpls cenv env baseValOpt l = OptimizeList (OptimizeInterfaceImpl cenv env baseValOpt) l
+/// Optimize/analyze the interface implementations that form part of an object expression
 and OptimizeInterfaceImpl cenv env baseValOpt (ty, overrides) = 
     let overrides', overridesinfos = OptimizeMethods cenv env baseValOpt overrides
     (ty, overrides'), 
@@ -1880,13 +1908,10 @@ and OptimizeInterfaceImpl cenv env baseValOpt (ty, overrides) =
       MightMakeCriticalTailcall=false
       Info=UnknownValue}
 
-//-------------------------------------------------------------------------
-// Make and optimize String.Concat calls
-//------------------------------------------------------------------------- 
-
+/// Make and optimize String.Concat calls
 and MakeOptimizedSystemStringConcatCall cenv env m args =
-    let rec optimizeArg e accArgs =
-        match e, accArgs with
+    let rec optimizeArg argExpr accArgs =
+        match argExpr, accArgs with
         | Expr.Op(TOp.ILCall(_, _, _, _, _, _, _, methRef, _, _, _), _, [ Expr.Op(TOp.Array, _, args, _) ], _), _ when IsSystemStringConcatArray methRef ->
             optimizeArgs args accArgs
 
@@ -1905,7 +1930,7 @@ and MakeOptimizedSystemStringConcatCall cenv env m args =
 
     let args = optimizeArgs args []
 
-    let e =
+    let expr =
         match args with
         | [ arg ] ->
             arg
@@ -1919,11 +1944,11 @@ and MakeOptimizedSystemStringConcatCall cenv env m args =
             let arg = mkArray (cenv.g.string_ty, args, m)
             mkStaticCall_String_Concat_Array cenv.g m arg
 
-    match e with
+    match expr with
     | Expr.Op(TOp.ILCall(_, _, _, _, _, _, _, methRef, _, _, _) as op, tyargs, args, m) when IsSystemStringConcatOverload methRef || IsSystemStringConcatArray methRef ->
         OptimizeExprOpReductions cenv env (op, tyargs, args, m)
     | _ ->
-        OptimizeExpr cenv env e
+        OptimizeExpr cenv env expr
 
 //-------------------------------------------------------------------------
 // Optimize/analyze an application of an intrinsic operator to arguments
@@ -1933,11 +1958,11 @@ and OptimizeExprOp cenv env (op, tyargs, args, m) =
 
     // Special cases 
     match op, tyargs, args with 
-    | TOp.Coerce, [toty;fromty], [e] -> 
-        let e', einfo = OptimizeExpr cenv env e
-        if typeEquiv cenv.g toty fromty then e', einfo 
+    | TOp.Coerce, [toty;fromty], [arg] -> 
+        let argR, einfo = OptimizeExpr cenv env arg
+        if typeEquiv cenv.g toty fromty then argR, einfo 
         else 
-          mkCoerceExpr(e', toty, m, fromty), 
+          mkCoerceExpr(argR, toty, m, fromty), 
           { TotalSize=einfo.TotalSize + 1
             FunctionSize=einfo.FunctionSize + 1
             HasEffect = true  
@@ -2004,6 +2029,9 @@ and OptimizeExprOp cenv env (op, tyargs, args, m) =
 
 and OptimizeExprOpReductions cenv env (op, tyargs, args, m) =
     let args', arginfos = OptimizeExprsThenConsiderSplits cenv env args
+    OptimizeExprOpReductionsAfter cenv env (op, tyargs, args', arginfos, m)
+
+and OptimizeExprOpReductionsAfter cenv env (op, tyargs, args', arginfos, m) =
     let knownValue = 
         match op, arginfos with 
         | TOp.ValFieldGet (rf), [e1info] -> TryOptimizeRecordFieldGet cenv env (e1info, rf, tyargs, m) 
@@ -2252,10 +2280,10 @@ and OptimizeLinearExpr cenv env expr contf =
               MightMakeCriticalTailcall = bodyInfo.MightMakeCriticalTailcall // discard tailcall info from binding - not in tailcall position
               Info = UnknownValue }
         else 
-            (* On the way back up: Trim out any optimization info that involves escaping values on the way back up *)
+            // On the way back up: Trim out any optimization info that involves escaping values on the way back up
             let evalue' = AbstractExprInfoByVars ([bind'.Var], []) bodyInfo.Info 
             body', 
-            { TotalSize = bindingInfo.TotalSize + bodyInfo.TotalSize - localVarSize (* eliminated a local var *) 
+            { TotalSize = bindingInfo.TotalSize + bodyInfo.TotalSize - localVarSize // eliminated a local var
               FunctionSize = bindingInfo.FunctionSize + bodyInfo.FunctionSize - localVarSize (* eliminated a local var *) 
               HasEffect=bindingInfo.HasEffect || bodyInfo.HasEffect
               MightMakeCriticalTailcall = bodyInfo.MightMakeCriticalTailcall // discard tailcall info from binding - not in tailcall position
@@ -2271,6 +2299,12 @@ and OptimizeLinearExpr cenv env expr contf =
              let tgs = [tg1; TTarget([], e2, spTarget2)]
              RebuildOptimizedMatch (spMatch, exprm, m, ty, dtree, tgs, dinfo, tinfos)))
 
+    | LinearOpExpr (op, tyargs, argsHead, argLast, m) ->
+         let argsHead', argsHeadInfos' = OptimizeList (OptimizeExprThenConsiderSplit cenv env) argsHead
+         // tailcall
+         OptimizeLinearExpr cenv env argLast (contf << (fun (argLast', argLastInfo) ->
+             OptimizeExprOpReductionsAfter cenv env (op, tyargs, argsHead' @ [argLast'], argsHeadInfos' @ [argLastInfo], m)))
+
     | _ -> contf (OptimizeExpr cenv env expr)
 
 //-------------------------------------------------------------------------
@@ -2916,7 +2950,6 @@ and OptimizeExprsThenConsiderSplits cenv env exprs =
     | [] -> NoExprs 
     | _ -> OptimizeList (OptimizeExprThenConsiderSplit cenv env) exprs
 
-
 and OptimizeExprThenReshapeAndConsiderSplit cenv env (shape, e) = 
     OptimizeExprThenConsiderSplit cenv env (ReshapeExpr cenv (shape, e))
 

src/fsharp/PostInferenceChecks.fs

@@ -879,27 +879,12 @@ and CheckCallWithReceiver cenv env m returnTy args contexts context =
                 limitArgs
         CheckCallLimitArgs cenv env m returnTy limitArgs context
 
-/// Check an expression, given information about the position of the expression
-and CheckExpr (cenv:cenv) (env:env) origExpr (context:PermitByRefExpr) : Limit =    
-    let g = cenv.g
-
-    let origExpr = stripExpr origExpr
-
-    // CheckForOverAppliedExceptionRaisingPrimitive is more easily checked prior to NormalizeAndAdjustPossibleSubsumptionExprs
-    CheckForOverAppliedExceptionRaisingPrimitive cenv origExpr
-    let expr = NormalizeAndAdjustPossibleSubsumptionExprs g origExpr
-    let expr = stripExpr expr
-
+and CheckExprLinear (cenv:cenv) (env:env) expr (context:PermitByRefExpr) contf =    
     match expr with
-    | Expr.Sequential (e1,e2,dir,_,_) -> 
+    | Expr.Sequential (e1,e2,NormalSeq,_,_) -> 
         CheckExprNoByrefs cenv env e1
-
-        match dir with
-        | NormalSeq -> 
-            CheckExpr cenv env e2 context       // carry context into _;RHS (normal sequencing only)      
-        | ThenDoSeq -> 
-            CheckExprNoByrefs cenv {env with ctorLimitedZone=false} e2
-            NoLimit
+        // tailcall
+        CheckExprLinear cenv env e2 context contf
 
     | Expr.Let ((TBind(v,_bindRhs,_) as bind),body,_,_) ->
         let isByRef = isByrefTy cenv.g v.Type
@@ -913,7 +898,48 @@ and CheckExpr (cenv:cenv) (env:env) origExpr (context:PermitByRefExpr) : Limit =
         let limit = CheckBinding cenv { env with returnScope = env.returnScope + 1 } false bindingContext bind  
         BindVal cenv env v
         LimitVal cenv v { limit with scope = if isByRef then limit.scope else env.returnScope }
-        CheckExpr cenv env body context
+        // tailcall
+        CheckExprLinear cenv env body context contf 
+
+    | LinearOpExpr (_op, tyargs, argsHead, argLast, m) ->
+        CheckTypeInstNoByrefs cenv env m tyargs
+        argsHead |> List.iter (CheckExprNoByrefs cenv env) 
+        // tailcall
+        CheckExprLinear cenv env argLast PermitByRefExpr.No (fun _ -> NoLimit)
+
+    | LinearMatchExpr (_spMatch, _exprm, dtree, tg1, e2, _spTarget2, m, ty) ->
+        CheckTypeNoInnerByrefs cenv env m ty 
+        CheckDecisionTree cenv env dtree
+        let lim1 = CheckDecisionTreeTarget cenv env context tg1
+        // tailcall
+        CheckExprLinear cenv env e2 context (fun lim2 -> contf (CombineLimits [ lim1; lim2 ]))
+
+    | _ -> 
+        // not a linear expression
+        contf (CheckExpr cenv env expr context)
+
+/// Check an expression, given information about the position of the expression
+and CheckExpr (cenv:cenv) (env:env) origExpr (context:PermitByRefExpr) : Limit =    
+    let g = cenv.g
+
+    let origExpr = stripExpr origExpr
+
+    // CheckForOverAppliedExceptionRaisingPrimitive is more easily checked prior to NormalizeAndAdjustPossibleSubsumptionExprs
+    CheckForOverAppliedExceptionRaisingPrimitive cenv origExpr
+    let expr = NormalizeAndAdjustPossibleSubsumptionExprs g origExpr
+    let expr = stripExpr expr
+
+    match expr with
+    | LinearOpExpr _ 
+    | LinearMatchExpr _ 
+    | Expr.Let _ 
+    | Expr.Sequential (_, _, NormalSeq, _, _) -> 
+        CheckExprLinear cenv env expr context id
+
+    | Expr.Sequential (e1,e2,ThenDoSeq,_,_) -> 
+        CheckExprNoByrefs cenv env e1
+        CheckExprNoByrefs cenv {env with ctorLimitedZone=false} e2
+        NoLimit
 
     | Expr.Const (_,m,ty) -> 
         CheckTypeNoInnerByrefs cenv env m ty