[commit: ghc] typeable-with-kinds: Cache representation outside lambda, the way it was in manual instances. (6f93aa8)

[git at git.haskell.org]

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

On branch  : typeable-with-kinds
Link       : http://ghc.haskell.org/trac/ghc/changeset/6f93aa8d2a8ea420526ef264ff2b0fc4cedee6d2/ghc

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

commit 6f93aa8d2a8ea420526ef264ff2b0fc4cedee6d2
Author: Iavor S. Diatchki <diatchki at galois.com>
Date:   Tue Feb 10 14:28:19 2015 -0800

    Cache representation outside lambda, the way it was in manual instances.


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

6f93aa8d2a8ea420526ef264ff2b0fc4cedee6d2
 compiler/deSugar/DsBinds.hs | 39 +++++++++++++++++++++++++--------------
 1 file changed, 25 insertions(+), 14 deletions(-)

diff --git a/compiler/deSugar/DsBinds.hs b/compiler/deSugar/DsBinds.hs
index 707a963..6db3cae 100644
--- a/compiler/deSugar/DsBinds.hs
+++ b/compiler/deSugar/DsBinds.hs
@@ -888,21 +888,19 @@ dsEvTerm (EvTypeable ev) = dsEvTypeable ev
 dsEvTypeable :: EvTypeable -> DsM CoreExpr
 dsEvTypeable ev =
   do tyCl      <- dsLookupTyCon typeableClassName
+     typeRepTc <- dsLookupTyCon typeRepTyConName
+     let tyRepType = mkTyConApp typeRepTc []
+
      (ty, rep) <-
         case ev of
 
           EvTypeableTyCon tc ks ts ->
             do ctr       <- dsLookupGlobalId mkPolyTyConAppName
                mkTyCon   <- dsLookupGlobalId mkTyConName
-               typeRepTc <- dsLookupTyCon typeRepTyConName
                dflags    <- getDynFlags
-               let tyRepType = mkTyConApp typeRepTc []
-                   mkRep cRep kReps tReps = mkApps (Var ctr)
-                                                   [ cRep
-                                                   , mkListExpr tyRepType kReps
-                                                   , mkListExpr tyRepType tReps
-                                                   ]
-
+               let mkRep cRep kReps tReps =
+                     mkApps (Var ctr) [ cRep, mkListExpr tyRepType kReps
+                                            , mkListExpr tyRepType tReps ]
 
                let kindRep k =
                      case splitTyConApp_maybe k of
@@ -939,8 +937,15 @@ dsEvTypeable ev =
                tag <- mkStringExpr str
                return (ty, mkApps (Var ctr) [ tag ])
 
+     -- TyRep -> Typeable t
+     -- see also: Note [Memoising typeOf]
+     repName <- newSysLocalDs tyRepType
+     let proxyT = mkProxyPrimTy (typeKind ty) ty
+         method = bindNonRec repName rep
+                $ mkLams [mkWildValBinder proxyT] (Var repName)
 
-     return (mkDict tyCl ty rep)
+     -- package up the method as `Typeable` dictionary
+     return (mkCast method (getTypeableCo tyCl ty))
 
   where
   -- co: method -> Typeable k t
@@ -957,11 +962,6 @@ dsEvTypeable ev =
            proxy  = mkTyApps (Var proxyHashId) [t]
        return (mkApps method [proxy])
 
-  -- TyRep -> Typeable t
-  mkDict tc ty rep = mkCast (mkLams [mkWildValBinder proxyT] rep)
-                            (getTypeableCo tc ty)
-    where proxyT = mkProxyPrimTy (typeKind ty) ty
-
   -- This part could be cached
   tyConRep dflags mkTyCon tc =
     do pkgStr  <- mkStringExprFS pkg_fs
@@ -992,6 +992,17 @@ dsEvTypeable ev =
 
 
 
+{- Note [Memoising typeOf]
+~~~~~~~~~~~~~~~~~~~~~~~~~~
+See #3245, #9203
+
+IMPORTANT: we don't want to recalculate the TypeRep once per call with
+the proxy argument.  This is what went wrong in #3245 and #9203. So we
+help GHC by manually keeping the 'rep' *outside* the lambda.
+-}
+
+
+
 
 
 dsEvCallStack :: EvCallStack -> DsM CoreExpr