[commit: ghc] wip/nomeata-T2110: Let coerce have a lower arity (35117c9)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : wip/nomeata-T2110
Link       : http://ghc.haskell.org/trac/ghc/changeset/35117c970696bdd3f30c52b1a3d4481c18fdb189/ghc

>---------------------------------------------------------------

commit 35117c970696bdd3f30c52b1a3d4481c18fdb189
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Fri Jan 24 13:29:47 2014 +0000

    Let coerce have a lower arity
    
    by writing
     λ k α β c -> case c of (MkCoercible co) -> (λx. x) |> (α_R → co)
    instead of
     λ k α β c x -> case c of (MkCoercible co) -> x |> co
    which allows coerce to be inlined even when partially applied, and its
    definition matches the shape of code generated from a newtype
    constructor in, say, "map Age".


>---------------------------------------------------------------

35117c970696bdd3f30c52b1a3d4481c18fdb189
 compiler/basicTypes/MkId.lhs |   16 +++++++++++++---
 1 file changed, 13 insertions(+), 3 deletions(-)

diff --git a/compiler/basicTypes/MkId.lhs b/compiler/basicTypes/MkId.lhs
index 604163f..9aaeb55 100644
--- a/compiler/basicTypes/MkId.lhs
+++ b/compiler/basicTypes/MkId.lhs
@@ -1154,10 +1154,20 @@ coerceId = pcMiscPrelId coerceName ty info
     eqRPrimTy = mkTyConApp eqReprPrimTyCon [k, aTy, bTy]
     ty   = mkForAllTys [kv, a, b] (mkFunTys [eqRTy, aTy] bTy)
 
-    [eqR,x,eq] = mkTemplateLocals [eqRTy, aTy,eqRPrimTy]
-    rhs = mkLams [kv,a,b,eqR,x] $
+    [eqR,eq] = mkTemplateLocals [eqRTy, eqRPrimTy]
+    rhs = mkLams [kv,a,b,eqR] $
           mkWildCase (Var eqR) eqRTy bTy $
-	  [(DataAlt coercibleDataCon, [eq], Cast (Var x) (CoVarCo eq))]
+	  [(DataAlt coercibleDataCon, [eq], mkCastId (CoVarCo eq))]
+
+-- Turns co :: a ~#R b coercion into
+--  (\x -> x) |> (<a>_R -> co)
+-- which allows the unfoldings ofunsafeCoerce and coerce to have a lower arity
+mkCastId :: Coercion -> CoreExpr
+mkCastId co = Cast (mkLams [x] (Var x))
+                   (mkFunCo Representational (mkReflCo Representational aTy) co)
+ where
+    Pair aTy _ = coercionKind co
+    [x] = mkTemplateLocals [aTy]
 \end{code}
 
 Note [Unsafe coerce magic]