[commit: ghc] wip/T14626: WIP: actuall look at the type of the constr field (1a0fc52)

[git at git.haskell.org]

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

On branch  : wip/T14626
Link       : http://ghc.haskell.org/trac/ghc/changeset/1a0fc52ac39c677a34ae6c2f34aecdf0ab784d39/ghc

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

commit 1a0fc52ac39c677a34ae6c2f34aecdf0ab784d39
Author: Gabor Greif <ggreif at gmail.com>
Date:   Sat Jan 13 23:47:37 2018 +0100

    WIP: actuall look at the type of the constr field


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

1a0fc52ac39c677a34ae6c2f34aecdf0ab784d39
 compiler/codeGen/StgCmmCon.hs | 11 +++++++----
 1 file changed, 7 insertions(+), 4 deletions(-)

diff --git a/compiler/codeGen/StgCmmCon.hs b/compiler/codeGen/StgCmmCon.hs
index fe85f05..a00081c 100644
--- a/compiler/codeGen/StgCmmCon.hs
+++ b/compiler/codeGen/StgCmmCon.hs
@@ -30,7 +30,8 @@ import StgCmmUtils
 import StgCmmClosure
 import StgCmmProf ( curCCS )
 
-import TyCon
+import TyCon -- NOT NEEDED
+import Type (isAlgType)
 import CmmExpr
 import CLabel
 import MkGraph
@@ -255,13 +256,15 @@ buildDynCon' dflags _ binder actually_bound ccs con args
 
       blame_cc = use_cc -- cost-centre on which to blame the alloc (same)
 
-      checkTagOnPtr base ((_,offset), bang) | isBanged bang = do
-                lgood <- newBlockId
+      checkTagOnPtr base (((NonVoid (StgVarArg var)),offset), bang)
+          | isBanged bang
+          , isAlgType (let ty = idType var in pprTrace "checkTagOnPtrTy" (ppr ty) ty)
+           = do lgood <- newBlockId
                 lcall <- newBlockId
                 let p = CmmLoad (cmmOffsetB dflags base offset) (bWord dflags)
                 emit $ mkCbranch (cmmIsTagged dflags p)
                          lgood lcall Nothing
-                emitLabel lcall
+                pprTrace "checkTagOnPtr" (ppr con $$ ppr (dataConRepType con)) emitLabel lcall
                 emitRtsCall rtsUnitId
                   (fsLit "checkTagged") [(p, AddrHint)] False
                 emitLabel lgood