diff options
| -rw-r--r-- | compiler/GHC/Stg/Debug.hs | 6 | ||||
| -rw-r--r-- | compiler/GHC/Stg/Lift/Analysis.hs | 1 | ||||
| -rw-r--r-- | compiler/GHC/Stg/Syntax.hs | 9 |
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) |