process more large expressions more systematically

build/targets/NGenOrCrossGen.targets

@@ -16,9 +16,9 @@
         NGen for both 32 and 64 bit product.
         If compiling use the app config file, if present.
     -->
-    <Exec Command='"$(PathToNGen64)" install "$(TargetPath)" /ExeConfig:$(TargetPath)' Condition = "Exists('$(PathToNGen64)') AND Exists('$(TargetPath).config') AND '$(IsAdministrator)' == 'true'"/>
+    <Exec Command='"$(PathToNGen64)" install "$(TargetPath)" /ExeConfig:$(TargetPath)' Condition = "Exists('$(PathToNGen64)') AND Exists('$(TargetPath).config') AND '$(IsAdministrator)' == 'true' AND '$(PlatformTarget)' != 'x86'"/>
     <Exec Command='"$(PathToNGen32)" install "$(TargetPath)" /ExeConfig:$(TargetPath)' Condition = "Exists('$(PathToNGen32)') AND Exists('$(TargetPath).config') AND '$(IsAdministrator)' == 'true'"/>
-    <Exec Command='"$(PathToNGen64)" install "$(TargetPath)"' Condition = " Exists('$(PathToNGen64)') AND (!Exists('$(TargetPath).config')) AND '$(IsAdministrator)' == 'true' "/>
+    <Exec Command='"$(PathToNGen64)" install "$(TargetPath)"' Condition = " Exists('$(PathToNGen64)') AND (!Exists('$(TargetPath).config')) AND '$(IsAdministrator)' == 'true' AND '$(PlatformTarget)' != 'x86' "/>
     <Exec Command='"$(PathToNGen32)" install "$(TargetPath)"' Condition = " Exists('$(PathToNGen32)') AND (!Exists('$(TargetPath).config')) AND '$(IsAdministrator)' == 'true' "/>
   </Target>
 

src/fsharp/DetupleArgs.fs

@@ -256,42 +256,44 @@ module GlobalUsageAnalysis =
       let foldLocalVal f z (vref: ValRef) = 
           if valRefInThisAssembly g.compilingFslib vref then f z vref.Deref
           else z
-      let exprUsageIntercept exprF z expr =
+
+      let exprUsageIntercept exprF noInterceptF z origExpr =
+
           let rec recognise context expr = 
-            match expr with
-             | Expr.Val (v, _, _)                  -> 
+             match expr with
+             | Expr.Val (v, _, _) -> 
                  // YES: count free occurrence 
-                 let z = foldLocalVal (fun z v -> logUse v (context, [], []) z) z v
-                 Some z
-             | TyappAndApp(f, _, tys, args, _)       -> 
+                 foldLocalVal (fun z v -> logUse v (context, [], []) z) z v
+
+             | TyappAndApp(f, _, tys, args, _) -> 
                  match f with
                   | Expr.Val (fOrig, _, _) ->
                     // app where function is val 
                     // YES: count instance/app (app when have term args), and then
                     //      collect from args (have intercepted this node) 
                     let collect z f = logUse f (context, tys, args) z
                     let z = foldLocalVal collect z fOrig
-                    let z = List.fold exprF z args
-                    Some z
+                    List.fold exprF z args
                   | _ ->
                      // NO: app but function is not val 
-                     None
+                     noInterceptF z origExpr 
+
              | Expr.Op(TOp.TupleFieldGet (tupInfo, n), ts, [x], _) when not (evalTupInfoIsStruct tupInfo)  -> 
                  let context = TupleGet (n, ts) :: context
                  recognise context x
 
              // lambdas end top-level status 
              | Expr.Lambda(_id, _ctorThisValOpt, _baseValOpt, _vs, body, _, _)   -> 
-                 let z = foldUnderLambda exprF z body
-                 Some z
+                 foldUnderLambda exprF z body
+
              | Expr.TyLambda(_id, _tps, body, _, _) -> 
-                 let z = foldUnderLambda exprF z body
-                 Some z
+                 foldUnderLambda exprF z body
+
              | _  -> 
-                 None // NO: no intercept 
+                 noInterceptF z origExpr
 
           let context = []
-          recognise context expr
+          recognise context origExpr
 
       let targetIntercept exprF z = function TTarget(_argvs, body, _) -> Some (foldUnderLambda exprF z body)
       let tmethodIntercept exprF z = function TObjExprMethod(_, _, _, _, e, _m) -> Some (foldUnderLambda exprF z e)

src/fsharp/FindUnsolved.fs

@@ -38,46 +38,65 @@ let rec accExpr   (cenv:cenv) (env:env) expr =
     | Expr.Sequential (e1,e2,_,_,_) -> 
         accExpr cenv env e1 
         accExpr cenv env e2
+
     | Expr.Let (bind,body,_,_) ->  
         accBind cenv env bind  
         accExpr cenv env body
+
     | Expr.Const (_,_,ty) -> 
         accTy cenv env ty 
 
     | Expr.Val (_v,_vFlags,_m) -> ()
+
     | Expr.Quote(ast,_,_,_m,ty) -> 
         accExpr cenv env ast
         accTy cenv env ty
+
     | Expr.Obj (_,ty,basev,basecall,overrides,iimpls,_m) -> 
         accTy cenv env ty
         accExpr cenv env basecall
         accMethods cenv env basev overrides 
         accIntfImpls cenv env basev iimpls
+
+    | LinearOpExpr (_op, tyargs, argsHead, argLast, _m) ->
+        // Note, LinearOpExpr doesn't include any of the "special" cases for accOp
+        accTypeInst cenv env tyargs
+        accExprs cenv env argsHead
+        // tailcall
+        accExpr cenv env argLast
+
     | Expr.Op (c,tyargs,args,m) ->
         accOp cenv env (c,tyargs,args,m) 
+
     | Expr.App(f,fty,tyargs,argsl,_m) ->
         accTy cenv env fty
         accTypeInst cenv env tyargs
         accExpr cenv env f
         accExprs cenv env argsl
+
     | Expr.Lambda(_,_ctorThisValOpt,_baseValOpt,argvs,_body,m,rty) -> 
         let topValInfo = ValReprInfo ([],[argvs |> List.map (fun _ -> ValReprInfo.unnamedTopArg1)],ValReprInfo.unnamedRetVal) 
         let ty = mkMultiLambdaTy m argvs rty 
         accLambdas cenv env topValInfo expr ty
+
     | Expr.TyLambda(_,tps,_body,_m,rty)  -> 
         let topValInfo = ValReprInfo (ValReprInfo.InferTyparInfo tps,[],ValReprInfo.unnamedRetVal) 
         accTy cenv env rty
         let ty = mkForallTyIfNeeded tps rty 
         accLambdas cenv env topValInfo expr ty
+
     | Expr.TyChoose(_tps,e1,_m)  -> 
         accExpr cenv env e1 
+
     | Expr.Match(_,_exprm,dtree,targets,m,ty) -> 
         accTy cenv env ty
         accDTree cenv env dtree
         accTargets cenv env m ty targets
+
     | Expr.LetRec (binds,e,_m,_) ->  
         accBinds cenv env binds
         accExpr cenv env e
+
     | Expr.StaticOptimization (constraints,e2,e3,_m) -> 
         accExpr cenv env e2
         accExpr cenv env e3
@@ -87,14 +106,19 @@ let rec accExpr   (cenv:cenv) (env:env) expr =
                 accTy cenv env ty2
             | TTyconIsStruct(ty1) -> 
                 accTy cenv env ty1)
+
     | Expr.Link _eref -> failwith "Unexpected reclink"
 
-and accMethods cenv env baseValOpt l = List.iter (accMethod cenv env baseValOpt) l
+and accMethods cenv env baseValOpt l = 
+    List.iter (accMethod cenv env baseValOpt) l
+
 and accMethod cenv env _baseValOpt (TObjExprMethod(_slotsig,_attribs,_tps,vs,e,_m)) = 
     vs |> List.iterSquared (accVal cenv env)
     accExpr cenv env e
 
-and accIntfImpls cenv env baseValOpt l = List.iter (accIntfImpl cenv env baseValOpt) l
+and accIntfImpls cenv env baseValOpt l = 
+    List.iter (accIntfImpl cenv env baseValOpt) l
+
 and accIntfImpl cenv env baseValOpt (ty,overrides) = 
     accTy cenv env ty
     accMethods cenv env baseValOpt overrides 
@@ -132,11 +156,14 @@ and accLambdas cenv env topValInfo e ety =
     | _ -> 
         accExpr cenv env e
 
-and accExprs            cenv env exprs = exprs |> List.iter (accExpr cenv env) 
+and accExprs cenv env exprs = 
+    exprs |> List.iter (accExpr cenv env) 
 
-and accTargets cenv env m ty targets = Array.iter (accTarget cenv env m ty) targets
+and accTargets cenv env m ty targets = 
+    Array.iter (accTarget cenv env m ty) targets
 
-and accTarget cenv env _m _ty (TTarget(_vs,e,_)) = accExpr cenv env e
+and accTarget cenv env _m _ty (TTarget(_vs,e,_)) = 
+    accExpr cenv env e
 
 and accDTree cenv env x =
     match x with 
@@ -169,7 +196,8 @@ and accAttrib cenv env (Attrib(_,_k,args,props,_,_,_m)) =
         accExpr cenv env expr2
         accTy cenv env ty)
 
-and accAttribs cenv env attribs = List.iter (accAttrib cenv env) attribs
+and accAttribs cenv env attribs = 
+    List.iter (accAttrib cenv env) attribs
 
 and accValReprInfo cenv env (ValReprInfo(_,args,ret)) =
     args |> List.iterSquared (accArgReprInfo cenv env)
@@ -188,7 +216,8 @@ and accBind cenv env (bind:Binding) =
     let topValInfo  = match bind.Var.ValReprInfo with Some info -> info | _ -> ValReprInfo.emptyValData
     accLambdas cenv env topValInfo bind.Expr bind.Var.Type
 
-and accBinds cenv env xs = xs |> List.iter (accBind cenv env) 
+and accBinds cenv env xs = 
+    xs |> List.iter (accBind cenv env) 
 
 let accTyconRecdField cenv env _tycon (rfield:RecdField) = 
     accAttribs cenv env rfield.PropertyAttribs
@@ -203,13 +232,15 @@ let accTycon cenv env (tycon:Tycon) =
           accAttribs cenv env uc.Attribs
           uc.RecdFieldsArray |> Array.iter (accTyconRecdField cenv env tycon))
 
-let accTycons cenv env tycons = List.iter (accTycon cenv env) tycons
+let accTycons cenv env tycons = 
+    List.iter (accTycon cenv env) tycons
 
 let rec accModuleOrNamespaceExpr cenv env x = 
     match x with  
     | ModuleOrNamespaceExprWithSig(_mty, def, _m) -> accModuleOrNamespaceDef cenv env def
 
-and accModuleOrNamespaceDefs cenv env x = List.iter (accModuleOrNamespaceDef cenv env) x
+and accModuleOrNamespaceDefs cenv env x = 
+    List.iter (accModuleOrNamespaceDef cenv env) x
 
 and accModuleOrNamespaceDef cenv env x = 
     match x with 
@@ -221,12 +252,16 @@ and accModuleOrNamespaceDef cenv env x =
     | TMAbstract(def)  -> accModuleOrNamespaceExpr cenv env def
     | TMDefs(defs) -> accModuleOrNamespaceDefs cenv env defs 
 
-and accModuleOrNamespaceBinds cenv env xs = List.iter (accModuleOrNamespaceBind cenv env) xs
+and accModuleOrNamespaceBinds cenv env xs = 
+    List.iter (accModuleOrNamespaceBind cenv env) xs
 
 and accModuleOrNamespaceBind cenv env x = 
     match x with 
-    | ModuleOrNamespaceBinding.Binding bind -> accBind cenv env bind
-    | ModuleOrNamespaceBinding.Module(mspec, rhs) -> accTycon cenv env mspec; accModuleOrNamespaceDef cenv env rhs 
+    | ModuleOrNamespaceBinding.Binding bind -> 
+        accBind cenv env bind
+    | ModuleOrNamespaceBinding.Module(mspec, rhs) -> 
+        accTycon cenv env mspec
+        accModuleOrNamespaceDef cenv env rhs 
 
 let UnsolvedTyparsOfModuleDef g amap denv (mdef, extraAttribs) =
    let cenv = 

src/fsharp/IlxGen.fs

@@ -141,6 +141,8 @@ type IlxGenIntraAssemblyInfo =
       /// that come from both the signature and the implementation.
       StaticFieldInfo : Dictionary<ILMethodRef, ILFieldSpec> }
 
+type FakeUnit = | Fake
+
 //-------------------------------------------------------------------------- 
 
 /// Indicates how the generated IL code is ultimately emitted 
@@ -2044,6 +2046,13 @@ let rec GenExpr (cenv:cenv) (cgbuf:CodeGenBuffer) eenv sp expr sequel =
       GenApp cenv cgbuf eenv (f,fty,tyargs,args,m) sequel
   | Expr.Val(v,_,m) -> 
       GenGetVal cenv cgbuf eenv (v,m) sequel
+
+  // Most generation of linear expressions is implemented routinely using tailcalls and the correct sequels.
+  // This is because the element of expansion happens to be the final thing generated in most cases. However
+  // for large lists we have to process the linearity separately
+  | LinearOpExpr _ -> 
+      GenLinearExpr cenv cgbuf eenv expr sequel id |> ignore<FakeUnit>
+
   | Expr.Op(op,tyargs,args,m) -> 
       match op,args,tyargs with 
       | TOp.ExnConstr(c),_,_      -> 
@@ -2346,12 +2355,27 @@ and GenAllocExn cenv cgbuf eenv (c,args,m) sequel =
       (mkNormalNewobj mspec) 
     GenSequel cenv eenv.cloc cgbuf sequel
 
+and GenAllocUnionCaseCore cenv cgbuf eenv (c,tyargs,n,m) =
+    let cuspec,idx = GenUnionCaseSpec cenv.amap m eenv.tyenv c tyargs
+    CG.EmitInstrs cgbuf (pop n) (Push [cuspec.DeclaringType]) (EraseUnions.mkNewData cenv.g.ilg (cuspec, idx))
+
 and GenAllocUnionCase cenv cgbuf eenv  (c,tyargs,args,m) sequel =
     GenExprs cenv cgbuf eenv args
-    let cuspec,idx = GenUnionCaseSpec cenv.amap m eenv.tyenv c tyargs
-    CG.EmitInstrs cgbuf (pop args.Length) (Push [cuspec.DeclaringType]) (EraseUnions.mkNewData cenv.g.ilg (cuspec, idx))
+    GenAllocUnionCaseCore cenv cgbuf eenv (c,tyargs,args.Length,m)
     GenSequel cenv eenv.cloc cgbuf sequel
 
+and GenLinearExpr cenv cgbuf eenv expr sequel (contf: FakeUnit -> FakeUnit) =
+    match expr with 
+    | LinearOpExpr (TOp.UnionCase c, tyargs, argsFront, argLast, m) -> 
+        GenExprs cenv cgbuf eenv argsFront
+        GenLinearExpr cenv cgbuf eenv argLast Continue (contf << (fun (Fake) -> 
+            GenAllocUnionCaseCore cenv cgbuf eenv (c, tyargs, argsFront.Length + 1, m)
+            GenSequel cenv eenv.cloc cgbuf sequel
+            Fake))
+    | _ -> 
+        GenExpr cenv cgbuf eenv SPSuppress expr sequel
+        contf Fake
+
 and GenAllocRecd cenv cgbuf eenv ctorInfo (tcref,argtys,args,m) sequel =
     let ty = GenNamedTyApp cenv.amap m eenv.tyenv tcref argtys