Move dataConTagZ to DataCon
authorSimon Peyton Jones <simonpj@microsoft.com>
Tue, 7 Mar 2017 13:28:34 +0000 (13:28 +0000)
committerDavid Feuer <David.Feuer@gmail.com>
Fri, 28 Apr 2017 22:04:22 +0000 (18:04 -0400)
Just a simple refactoring to remove duplication

compiler/basicTypes/DataCon.hs
compiler/cmm/SMRep.hs
compiler/codeGen/StgCmmClosure.hs
compiler/codeGen/StgCmmMonad.hs
compiler/vectorise/Vectorise/Utils/Base.hs

index c6bb8eb..acd2865 100644 (file)
@@ -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
index 83ddf18..d40af4f 100644 (file)
@@ -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
index e799ea6..bc5e473 100644 (file)
@@ -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
index cf78269..754cbfb 100644 (file)
@@ -74,6 +74,7 @@ import Module
 import Id
 import VarEnv
 import OrdList
+import BasicTypes( ConTagZ )
 import Unique
 import UniqSupply
 import FastString
index 4227109..88058e2 100644 (file)
@@ -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 ----------------------------------------------------------