Skip to content

Instantly share code, notes, and snippets.

@zeux
Created January 19, 2012 06:39
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save zeux/1638442 to your computer and use it in GitHub Desktop.
Save zeux/1638442 to your computer and use it in GitHub Desktop.
Patch for tuple allocation elimination for implicitly-returned formal arguments
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
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
@dsyme
Copy link

dsyme commented Jun 25, 2014

Hi @zeux,

Please consider submitting this improvement to https://visualfsharp.codeplex.com/, now that contributions are being accepted for the F# compiler and language

Thanks
Don

@forki
Copy link

forki commented Mar 25, 2015

I created dotnet/fsharp#331 for discussion

@abelbraaksma
Copy link

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

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment