summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2017-03-07 13:28:34 +0000
committerSimon Peyton Jones <simonpj@microsoft.com>2017-03-07 14:49:04 +0000
commitcdfa1ec6a24e882a0a78400497766e0c147e7c59 (patch)
treec0bcb2a6ae1f5fff37dea2bb3c2122dcd9966205
parent749740f9c3cb25ee95e04a21c1ef73e1bf96afb1 (diff)
downloadhaskell-cdfa1ec6a24e882a0a78400497766e0c147e7c59.tar.gz
Move dataConTagZ to DataCon
Just a simple refactoring to remove duplication
-rw-r--r--compiler/basicTypes/DataCon.hs8
-rw-r--r--compiler/cmm/SMRep.hs4
-rw-r--r--compiler/codeGen/StgCmmClosure.hs12
-rw-r--r--compiler/codeGen/StgCmmMonad.hs1
-rw-r--r--compiler/vectorise/Vectorise/Utils/Base.hs5
5 files changed, 14 insertions, 16 deletions
diff --git a/compiler/basicTypes/DataCon.hs b/compiler/basicTypes/DataCon.hs
index 43bcf75bb4..4644d40e6d 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 83ddf18586..d40af4ff1c 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 e799ea6639..bc5e473d20 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 bb093a5e51..998ea1d3c3 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 071fab961c..aa79834599 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 ----------------------------------------------------------