diff options
author | Matthew Pickering <matthewtpickering@gmail.com> | 2020-11-18 11:55:55 +0000 |
---|---|---|
committer | Matthew Pickering <matthewtpickering@gmail.com> | 2021-03-03 19:09:34 +0000 |
commit | a7aac008f69ca48e5ab3d4186fdcb3214c6e1463 (patch) | |
tree | b41d57ca638eddfad54d9cfedf9b47c66106e34a /compiler/GHC/Stg/Lift.hs | |
parent | 4b297979d25740d31241a9000e36068db112545a (diff) | |
download | haskell-a7aac008f69ca48e5ab3d4186fdcb3214c6e1463.tar.gz |
Add option to give each usage of a data constructor its own info table
The `-fdistinct-constructor-tables` flag will generate a fresh info
table for the usage of any data constructor. This is useful for
debugging as now by inspecting the info table, you can determine which
usage of a constructor caused that allocation rather than the old
situation where the info table always mapped to the definition site of
the data constructor which is useless.
In conjunction with `-hi` and `-finfo-table-map` this gives a more fine
grained understanding of where constructor allocations arise from in a
program.
Diffstat (limited to 'compiler/GHC/Stg/Lift.hs')
-rw-r--r-- | compiler/GHC/Stg/Lift.hs | 6 |
1 files changed, 3 insertions, 3 deletions
diff --git a/compiler/GHC/Stg/Lift.hs b/compiler/GHC/Stg/Lift.hs index 8f2337120e..4e7b66f23d 100644 --- a/compiler/GHC/Stg/Lift.hs +++ b/compiler/GHC/Stg/Lift.hs @@ -199,9 +199,9 @@ liftRhs -- as lambda binders, discarding all free vars. -> LlStgRhs -> LiftM OutStgRhs -liftRhs mb_former_fvs rhs@(StgRhsCon ccs con args) +liftRhs mb_former_fvs rhs@(StgRhsCon ccs con mn ts args) = ASSERT2(isNothing mb_former_fvs, text "Should never lift a constructor" $$ pprStgRhs panicStgPprOpts rhs) - StgRhsCon ccs con <$> traverse liftArgs args + StgRhsCon ccs con mn ts <$> traverse liftArgs args liftRhs Nothing (StgRhsClosure _ ccs upd infos body) = -- This RHS wasn't lifted. withSubstBndrs (map binderInfoBndr infos) $ \bndrs' -> @@ -227,7 +227,7 @@ liftExpr (StgApp f args) = do fvs' <- formerFreeVars f let top_lvl_args = map StgVarArg fvs' ++ args' pure (StgApp f' top_lvl_args) -liftExpr (StgConApp con args tys) = StgConApp con <$> traverse liftArgs args <*> pure tys +liftExpr (StgConApp con mn args tys) = StgConApp con mn <$> traverse liftArgs args <*> pure tys liftExpr (StgOpApp op args ty) = StgOpApp op <$> traverse liftArgs args <*> pure ty liftExpr (StgCase scrut info ty alts) = do scrut' <- liftExpr scrut |