Patch for tuple allocation elimination for implicitly-returned formal arguments

fsc-example.fs

module Test

open System.Collections.Generic
open SlimDX.DXGI
open SlimDX.Direct3D11

let test2 (d: IDictionary<int, string>) key =
    // tuple is allocated here, unless the patch is applied
    let r, v = d.TryGetValue(key)
    if r then v else ""

let test3 () =
    // tuple is allocated here, unless the patch is applied
    let res, device, swapChain = Device.CreateWithSwapChain(DriverType.Hardware, DeviceCreationFlags.None, SwapChainDescription())
    if res.IsFailure then failwithf "Device creation failed: %A" res
    device

fscopt-patch-tupleimplicitreturn.diff

diff -r b4b98358eaec src/fsharp/opt.fs
--- a/src/fsharp/opt.fs	Tue Dec 20 12:30:15 2011 +0400
+++ b/src/fsharp/opt.fs	Wed Jan 18 22:36:06 2012 -0800
@@ -1394,15 +1394,18 @@
 // This transform encourages that by allowing projections to be simplified.
 //------------------------------------------------------------------------- 
 
+let CanExpandStructuralBinding (v: Val) =
+    not v.IsCompiledAsTopLevel &&  
+    not v.IsMember && 
+    not v.IsTypeFunction &&
+    not v.IsMutable
+
 let ExprIsValue = function Expr.Val _ -> true | _ -> false
-let ExpandStructuralBinding cenv expr =
+let ExpandStructuralBindingRaw cenv expr =
     match expr with
     | Expr.Let (TBind(v,rhs,tgtSeqPtOpt),body,m,_) 
         when (isTupleExpr rhs &&  
-              not v.IsCompiledAsTopLevel &&  
-              not v.IsMember && 
-              not v.IsTypeFunction &&
-              not v.IsMutable) ->
+              CanExpandStructuralBinding v) ->
           let args   = tryDestTuple rhs
           if List.forall ExprIsValue args then
               expr (* avoid re-expanding when recursion hits original binding *)
@@ -1417,6 +1420,35 @@
               let tuple = mkTupled cenv.g m ves argTys
               mkLetsBind m binds (mkLet tgtSeqPtOpt m v tuple body)
     | expr -> expr
+
+// Moves outer tuple binding inside near the tupled expression:
+// let t = (let a0=v0 in let a1=v1 in ... in let an=vn in e0,e1,...,em) in body
+// let a0=v0 in let a1=v1 in ... in let an=vn in (let t = e0,e1,...,em in body)
+// This way ExpandStructuralBinding can replace expressions in constants, t is directly bound
+// to a tuple expression so that other optimizations such as OptimizeTupleFieldGet work,
+// and the tuple allocation can be eliminated.
+// Most importantly, this successfully eliminates tuple allocations for implicitly returned
+// formal arguments in method calls.
+let rec RearrangeTupleBindings expr fin =
+    match expr with
+    | Expr.Let (bind,body,m,_) ->
+        match RearrangeTupleBindings body fin with
+        | Some b -> Some (mkLetBind m bind b)
+        | None -> None
+    | Expr.Op (TOp.Tuple,_,_,_) ->
+        Some (fin expr)
+    | _ -> None
+
+let ExpandStructuralBinding cenv expr =
+    match expr with
+    | Expr.Let (TBind(v,rhs,tgtSeqPtOpt),body,m,_) 
+        when (isTupleTy cenv.g v.Type &&
+              not (isTupleExpr rhs) &&  
+              CanExpandStructuralBinding v) ->
+        match RearrangeTupleBindings rhs (fun top -> mkLet tgtSeqPtOpt m v top body) with
+        | Some e -> ExpandStructuralBindingRaw cenv e
+        | None -> expr
+    | expr -> ExpandStructuralBindingRaw cenv expr
     
 //-------------------------------------------------------------------------
 // The traversal

I created dotnet/fsharp#331 for discussion

For reference: this change has eventually made it into F#. Tx! See dotnet/fsharp#335.