summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAndreas Klebinger <klebinger.andreas@gmx.at>2021-03-23 15:09:42 +0100
committerAndreas Klebinger <klebinger.andreas@gmx.at>2021-03-23 15:14:07 +0100
commite40cfb9dc838dd23eeff383a7f5106d2c8d249c6 (patch)
tree617e2a27ca821e79ed456799c765e8d3b9964231
parent26ba86f73c9125c03968aec88be919bdd6a2152b (diff)
downloadhaskell-wip/con_num_field.tar.gz
STG AST - Make ConstructorNumber always a field.wip/con_num_field
It's used by all passes and already used as a regular field. So I figured it would be both more consistent and performant to make it a regular field for all constructors. I also added a few bangs in the process.
-rw-r--r--compiler/GHC/Stg/Debug.hs6
-rw-r--r--compiler/GHC/Stg/Lift/Analysis.hs1
-rw-r--r--compiler/GHC/Stg/Syntax.hs9
3 files changed, 5 insertions, 11 deletions
diff --git a/compiler/GHC/Stg/Debug.hs b/compiler/GHC/Stg/Debug.hs
index 46206d786e..17cb9fdebe 100644
--- a/compiler/GHC/Stg/Debug.hs
+++ b/compiler/GHC/Stg/Debug.hs
@@ -146,9 +146,9 @@ numberDataCon dc ts = do
if not (gopt Opt_DistinctConstructorTables dflags) then return NoNumber else do
env <- lift get
mcc <- asks rSpan
- let mbest_span = (\(SpanWithLabel rss l) -> (rss, l)) <$> (selectTick ts <|> mcc)
- let dcMap' = alterUniqMap (maybe (Just ((0, mbest_span) :| [] ))
- (\xs@((k, _):|_) -> Just ((k + 1, mbest_span) `NE.cons` xs))) (provDC env) dc
+ let !mbest_span = (\(SpanWithLabel rss l) -> (rss, l)) <$> (selectTick ts <|> mcc)
+ let !dcMap' = alterUniqMap (maybe (Just ((0, mbest_span) :| [] ))
+ (\xs@((k, _):|_) -> Just $! ((k + 1, mbest_span) `NE.cons` xs))) (provDC env) dc
lift $ put (env { provDC = dcMap' })
let r = lookupUniqMap dcMap' dc
return $ case r of
diff --git a/compiler/GHC/Stg/Lift/Analysis.hs b/compiler/GHC/Stg/Lift/Analysis.hs
index 884489e0f7..d4e59a8d6e 100644
--- a/compiler/GHC/Stg/Lift/Analysis.hs
+++ b/compiler/GHC/Stg/Lift/Analysis.hs
@@ -114,7 +114,6 @@ type instance BinderP 'LiftLams = BinderInfo
type instance XRhsClosure 'LiftLams = DIdSet
type instance XLet 'LiftLams = Skeleton
type instance XLetNoEscape 'LiftLams = Skeleton
-type instance XConApp 'LiftLams = ConstructorNumber
freeVarsOfRhs :: (XRhsClosure pass ~ DIdSet) => GenStgRhs pass -> DIdSet
freeVarsOfRhs (StgRhsCon _ _ _ _ args) = mkDVarSet [ id | StgVarArg id <- args ]
diff --git a/compiler/GHC/Stg/Syntax.hs b/compiler/GHC/Stg/Syntax.hs
index 6e2107e9d6..972efc5f44 100644
--- a/compiler/GHC/Stg/Syntax.hs
+++ b/compiler/GHC/Stg/Syntax.hs
@@ -25,7 +25,7 @@ module GHC.Stg.Syntax (
GenStgTopBinding(..), GenStgBinding(..), GenStgExpr(..), GenStgRhs(..),
GenStgAlt, AltType(..),
- StgPass(..), BinderP, XRhsClosure, XLet, XLetNoEscape, XConApp,
+ StgPass(..), BinderP, XRhsClosure, XLet, XLetNoEscape,
NoExtFieldSilent, noExtFieldSilent,
OutputablePass,
@@ -246,7 +246,7 @@ literals.
-- StgConApp is vital for returning unboxed tuples or sums
-- which can't be let-bound
| StgConApp DataCon
- (XConApp pass)
+ ConstructorNumber
[StgArg] -- Saturated
[Type] -- See Note [Types in StgConApp] in GHC.Stg.Unarise
@@ -485,10 +485,6 @@ type family XLet (pass :: StgPass)
type instance XLet 'Vanilla = NoExtFieldSilent
type instance XLet 'CodeGen = NoExtFieldSilent
-type family XConApp (pass :: StgPass)
-type instance XConApp 'Vanilla = ConstructorNumber
-type instance XConApp 'CodeGen = ConstructorNumber
-
-- | When `-fdistinct-constructor-tables` is turned on then
-- each usage of a constructor is given an unique number and
-- an info table is generated for each different constructor.
@@ -669,7 +665,6 @@ likes terminators instead... Ditto for case alternatives.
type OutputablePass pass =
( Outputable (XLet pass)
- , Outputable (XConApp pass)
, Outputable (XLetNoEscape pass)
, Outputable (XRhsClosure pass)
, OutputableBndr (BinderP pass)