[commit: ghc] wip/spj-T13397: Move dataConTagZ to DataCon (cdfa1ec)

[git at git.haskell.org]

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

On branch  : wip/spj-T13397
Link       : http://ghc.haskell.org/trac/ghc/changeset/cdfa1ec6a24e882a0a78400497766e0c147e7c59/ghc

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

commit cdfa1ec6a24e882a0a78400497766e0c147e7c59
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date:   Tue Mar 7 13:28:34 2017 +0000

    Move dataConTagZ to DataCon
    
    Just a simple refactoring to remove duplication


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

cdfa1ec6a24e882a0a78400497766e0c147e7c59
 compiler/basicTypes/DataCon.hs             |  8 ++++++--
 compiler/cmm/SMRep.hs                      |  4 ++--
 compiler/codeGen/StgCmmClosure.hs          | 12 ++++--------
 compiler/codeGen/StgCmmMonad.hs            |  1 +
 compiler/vectorise/Vectorise/Utils/Base.hs |  5 +----
 5 files changed, 14 insertions(+), 16 deletions(-)

diff --git a/compiler/basicTypes/DataCon.hs b/compiler/basicTypes/DataCon.hs
index 43bcf75..4644d40 100644
--- a/compiler/basicTypes/DataCon.hs
+++ b/compiler/basicTypes/DataCon.hs
@@ -28,8 +28,9 @@ module DataCon (
 
         -- ** Type deconstruction
         dataConRepType, dataConSig, dataConInstSig, dataConFullSig,
-        dataConName, dataConIdentity, dataConTag, dataConTyCon,
-        dataConOrigTyCon, dataConUserType,
+        dataConName, dataConIdentity, dataConTag, dataConTagZ,
+        dataConTyCon, dataConOrigTyCon,
+        dataConUserType,
         dataConUnivTyVars, dataConUnivTyVarBinders,
         dataConExTyVars, dataConExTyVarBinders,
         dataConAllTyVars,
@@ -861,6 +862,9 @@ dataConName = dcName
 dataConTag :: DataCon -> ConTag
 dataConTag  = dcTag
 
+dataConTagZ :: DataCon -> ConTagZ
+dataConTagZ con = dataConTag con - fIRST_TAG
+
 -- | The type constructor that we are building via this data constructor
 dataConTyCon :: DataCon -> TyCon
 dataConTyCon = dcRepTyCon
diff --git a/compiler/cmm/SMRep.hs b/compiler/cmm/SMRep.hs
index 83ddf18..d40af4f 100644
--- a/compiler/cmm/SMRep.hs
+++ b/compiler/cmm/SMRep.hs
@@ -50,6 +50,7 @@ module SMRep (
 #include "../HsVersions.h"
 #include "../includes/MachDeps.h"
 
+import BasicTypes( ConTagZ )
 import DynFlags
 import Outputable
 import Platform
@@ -185,14 +186,13 @@ type IsStatic = Bool
 -- rtsClosureType below.
 
 data ClosureTypeInfo
-  = Constr        ConstrTag ConstrDescription
+  = Constr        ConTagZ ConstrDescription
   | Fun           FunArity ArgDescr
   | Thunk
   | ThunkSelector SelectorOffset
   | BlackHole
   | IndStatic
 
-type ConstrTag         = Int
 type ConstrDescription = [Word8] -- result of dataConIdentity
 type FunArity          = Int
 type SelectorOffset    = Int
diff --git a/compiler/codeGen/StgCmmClosure.hs b/compiler/codeGen/StgCmmClosure.hs
index e799ea6..bc5e473 100644
--- a/compiler/codeGen/StgCmmClosure.hs
+++ b/compiler/codeGen/StgCmmClosure.hs
@@ -13,7 +13,6 @@
 
 module StgCmmClosure (
         DynTag,  tagForCon, isSmallFamily,
-        ConTagZ, dataConTagZ,
 
         idPrimRep, isVoidRep, isGcPtrRep, addIdReps, addArgReps,
         argPrimRep,
@@ -360,17 +359,12 @@ type DynTag = Int       -- The tag on a *pointer*
 isSmallFamily :: DynFlags -> Int -> Bool
 isSmallFamily dflags fam_size = fam_size <= mAX_PTR_TAG dflags
 
--- We keep the *zero-indexed* tag in the srt_len field of the info
--- table of a data constructor.
-dataConTagZ :: DataCon -> ConTagZ
-dataConTagZ con = dataConTag con - fIRST_TAG
-
 tagForCon :: DynFlags -> DataCon -> DynTag
 tagForCon dflags con
-  | isSmallFamily dflags fam_size = con_tag + 1
+  | isSmallFamily dflags fam_size = con_tag
   | otherwise                     = 1
   where
-    con_tag  = dataConTagZ con
+    con_tag  = dataConTag con -- NB: 1-indexed
     fam_size = tyConFamilySize (dataConTyCon con)
 
 tagForArity :: DynFlags -> RepArity -> DynTag
@@ -1050,6 +1044,8 @@ mkDataConInfoTable dflags data_con is_static ptr_wds nonptr_wds
    info_lbl = mkConInfoTableLabel name NoCafRefs
    sm_rep = mkHeapRep dflags is_static ptr_wds nonptr_wds cl_type
    cl_type = Constr (dataConTagZ data_con) (dataConIdentity data_con)
+                  -- We keep the *zero-indexed* tag in the srt_len field
+                  -- of the info table of a data constructor.
 
    prof | not (gopt Opt_SccProfilingOn dflags) = NoProfilingInfo
         | otherwise                            = ProfilingInfo ty_descr val_descr
diff --git a/compiler/codeGen/StgCmmMonad.hs b/compiler/codeGen/StgCmmMonad.hs
index bb093a5..998ea1d 100644
--- a/compiler/codeGen/StgCmmMonad.hs
+++ b/compiler/codeGen/StgCmmMonad.hs
@@ -74,6 +74,7 @@ import Module
 import Id
 import VarEnv
 import OrdList
+import BasicTypes( ConTagZ )
 import Unique
 import UniqSupply
 import FastString
diff --git a/compiler/vectorise/Vectorise/Utils/Base.hs b/compiler/vectorise/Vectorise/Utils/Base.hs
index 071fab9..aa79834 100644
--- a/compiler/vectorise/Vectorise/Utils/Base.hs
+++ b/compiler/vectorise/Vectorise/Utils/Base.hs
@@ -4,7 +4,7 @@ module Vectorise.Utils.Base
   ( voidType
   , newLocalVVar
 
-  , mkDataConTag, dataConTagZ
+  , mkDataConTag
   , mkWrapType
   , mkClosureTypes
   , mkPReprType
@@ -66,9 +66,6 @@ newLocalVVar fs vty
 mkDataConTag :: DynFlags -> DataCon -> CoreExpr
 mkDataConTag dflags = mkIntLitInt dflags . dataConTagZ
 
-dataConTagZ :: DataCon -> Int
-dataConTagZ con = dataConTag con - fIRST_TAG
-
 
 -- Type Construction ----------------------------------------------------------