[Git][ghc/ghc][wip/t23812] Add -f{no-}distinct-constructor-tables-per-module

Finley McIlwaine (@FinleyMcIlwaine) gitlab at gitlab.haskell.org
Tue Sep 12 23:13:42 UTC 2023



Finley McIlwaine pushed to branch wip/t23812 at Glasgow Haskell Compiler / GHC


Commits:
dfb53f74 by Finley McIlwaine at 2023-09-12T16:13:22-07:00
Add -f{no-}distinct-constructor-tables-per-module

With -fdistinct-constructor-tables-per-module, only one info table will be
created for all equivalent constructors used in the same module. Just like
`-f{no-}distinct-constructor-tables`, these flags can also be given a
comma-separated list of constructor names to specify exactly which constructors
this behavior should apply to.

This commit alters the distinct-tables test to also test the behavior of these
flags.

Fixes #23812

- - - - -


24 changed files:

- compiler/GHC/Cmm/CLabel.hs
- compiler/GHC/CoreToStg.hs
- compiler/GHC/Driver/Config/StgToCmm.hs
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Driver/GenerateCgIPEStub.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Stg/Debug.hs
- compiler/GHC/Stg/Debug/Types.hs
- compiler/GHC/Stg/Syntax.hs
- compiler/GHC/StgToCmm.hs
- compiler/GHC/StgToCmm/Config.hs
- compiler/GHC/StgToCmm/DataCon.hs
- compiler/GHC/StgToCmm/Layout.hs
- compiler/GHC/StgToCmm/Ticky.hs
- compiler/GHC/StgToCmm/Utils.hs
- compiler/GHC/Types/IPE.hs
- docs/users_guide/9.10.1-notes.rst
- docs/users_guide/debug-info.rst
- testsuite/tests/rts/ipe/distinct-tables/Makefile
- + testsuite/tests/rts/ipe/distinct-tables/NoPerModuleNoBCon.out
- + testsuite/tests/rts/ipe/distinct-tables/PerModule.out
- + testsuite/tests/rts/ipe/distinct-tables/PerModuleACon.out
- + testsuite/tests/rts/ipe/distinct-tables/PerModuleNoBCon.out
- testsuite/tests/rts/ipe/distinct-tables/all.T


Changes:

=====================================
compiler/GHC/Cmm/CLabel.hs
=====================================
@@ -531,12 +531,14 @@ data IdLabelInfo
   deriving (Eq, Ord)
 
 -- | Which module is the info table from, and which number was it.
-data ConInfoTableLocation = UsageSite Module Int
+data ConInfoTableLocation = UsageSite !Module !Int
+                          | UsageModule !Module
                           | DefinitionSite
                               deriving (Eq, Ord)
 
 instance Outputable ConInfoTableLocation where
   ppr (UsageSite m n) = text "Loc(" <> ppr n <> text "):" <+> ppr m
+  ppr (UsageModule m) = text "Loc:" <+> ppr m
   ppr DefinitionSite = empty
 
 getConInfoTableLocation :: IdLabelInfo -> Maybe ConInfoTableLocation
@@ -1654,11 +1656,15 @@ ppIdFlavor x = pp_cSEP <> case x of
         DefinitionSite -> text "con_entry"
         UsageSite m n ->
           pprModule m <> pp_cSEP <> int n <> pp_cSEP <> text "con_entry"
+        UsageModule m ->
+          pprModule m <> pp_cSEP <> text "con_entry"
    ConInfoTable k   ->
     case k of
       DefinitionSite -> text "con_info"
       UsageSite m n ->
         pprModule m <> pp_cSEP <> int n <> pp_cSEP <> text "con_info"
+      UsageModule m ->
+        pprModule m <> pp_cSEP <> text "con_info"
    ClosureTable     -> text "closure_tbl"
    Bytes            -> text "bytes"
    BlockInfoTable   -> text "info"


=====================================
compiler/GHC/CoreToStg.hs
=====================================
@@ -245,7 +245,7 @@ coreToStg opts at CoreToStgOpts
     -- See Note [Mapping Info Tables to Source Positions]
     (!pgm'', !denv)
       | opt_InfoTableMap
-      = collectDebugInformation stgDebugOpts ml pgm'
+      = collectDebugInformation stgDebugOpts ml this_mod pgm'
       | otherwise = (pgm', emptyInfoTableProvMap)
 
     prof = hasWay ways WayProf


=====================================
compiler/GHC/Driver/Config/StgToCmm.hs
=====================================
@@ -17,6 +17,7 @@ import GHC.Platform.Profile
 import GHC.Utils.Error
 import GHC.Unit.Module
 import GHC.Utils.Outputable
+import GHC.Stg.Debug (StgDebugDctConfig(..))
 
 initStgToCmmConfig :: DynFlags -> Module -> StgToCmmConfig
 initStgToCmmConfig dflags mod = StgToCmmConfig
@@ -45,6 +46,7 @@ initStgToCmmConfig dflags mod = StgToCmmConfig
   , stgToCmmInfoTableMap  = gopt Opt_InfoTableMap          dflags
   , stgToCmmInfoTableMapWithFallback = gopt Opt_InfoTableMapWithFallback dflags
   , stgToCmmInfoTableMapWithStack = gopt Opt_InfoTableMapWithStack dflags
+  , stgToCmmDctPerModule  = dctConfig_perModule (distinctConstructorTables dflags)
   , stgToCmmOmitYields    = gopt Opt_OmitYields            dflags
   , stgToCmmOmitIfPragmas = gopt Opt_OmitInterfacePragmas  dflags
   , stgToCmmPIC           = gopt Opt_PIC                   dflags


=====================================
compiler/GHC/Driver/DynFlags.hs
=====================================
@@ -111,7 +111,7 @@ import GHC.Types.SrcLoc
 import GHC.Unit.Module
 import GHC.Unit.Module.Warnings
 import GHC.Utils.CliOption
-import GHC.Stg.Debug.Types (StgDebugDctConfig(..))
+import GHC.Stg.Debug.Types (StgDebugDctConfig(..), StgDebugDctConfigConstrs(..))
 import GHC.SysTools.Terminal ( stderrSupportsAnsiColors )
 import GHC.UniqueSubdir (uniqueSubdir)
 import GHC.Utils.Outputable
@@ -708,7 +708,7 @@ defaultDynFlags mySettings =
         maxErrors     = Nothing,
         cfgWeights    = defaultWeights,
 
-        distinctConstructorTables = None
+        distinctConstructorTables = StgDebugDctConfig False None
       }
 
 type FatalMessager = String -> IO ()


=====================================
compiler/GHC/Driver/GenerateCgIPEStub.hs
=====================================
@@ -29,7 +29,7 @@ import GHC.StgToCmm.Monad (getCmm, initC, runC, initFCodeState)
 import GHC.StgToCmm.Prof (initInfoTableProv)
 import GHC.StgToCmm.Types (CmmCgInfos (..), ModuleLFInfos)
 import GHC.StgToCmm.Utils
-import GHC.Types.IPE (InfoTableProvMap (provInfoTables), IpeSourceLocation)
+import GHC.Types.IPE (InfoTableProvMap(..), IpeSourceLocation(..))
 import GHC.Types.Name.Set (NonCaffySet)
 import GHC.Types.Tickish (GenTickish (SourceNote))
 import GHC.Unit.Types (Module, moduleName)
@@ -345,7 +345,7 @@ labelsToSourcesWithTNTC acc (CmmProc _ _ _ cmm_graph) =
 
         maybeTick :: CmmNode O O -> Maybe IpeSourceLocation -> Maybe IpeSourceLocation
         maybeTick _ s@(Just _) = s
-        maybeTick (CmmTick (SourceNote span name)) Nothing = Just (span, name)
+        maybeTick (CmmTick (SourceNote span name)) Nothing = Just $ IpeSourceLocation span name
         maybeTick _ _ = Nothing
 labelsToSourcesWithTNTC acc _ = acc
 
@@ -371,6 +371,6 @@ labelsToSourcesSansTNTC acc (CmmProc _ _ _ cmm_graph) =
             (CmmStore _ (CmmLit (CmmLabel l)) _, Just src_loc) ->
               (Map.insert l src_loc acc, Nothing)
             (CmmTick (SourceNote span name), _) ->
-              (acc, Just (span, name))
+              (acc, Just $ IpeSourceLocation span name)
             _ -> (acc, lastTick)
-labelsToSourcesSansTNTC acc _ = acc
\ No newline at end of file
+labelsToSourcesSansTNTC acc _ = acc


=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -1797,6 +1797,10 @@ dynamic_flags_deps = [
         -- Caller-CC
   , make_ord_flag defGhcFlag "fprof-callers"
          (HasArg setCallerCcFilters)
+  , make_ord_flag defGhcFlag "fdistinct-constructor-tables-per-module"
+      (OptPrefix setDistinctConstructorTablesPerModule)
+  , make_ord_flag defGhcFlag "fno-distinct-constructor-tables-per-module"
+      (OptPrefix unSetDistinctConstructorTablesPerModule)
   , make_ord_flag defGhcFlag "fdistinct-constructor-tables"
       (OptPrefix setDistinctConstructorTables)
   , make_ord_flag defGhcFlag "fno-distinct-constructor-tables"
@@ -3314,12 +3318,28 @@ setCallerCcFilters arg =
     Right filt -> upd $ \d -> d { callerCcFilters = filt : callerCcFilters d }
     Left err -> addErr err
 
+setDistinctConstructorTablesPerModule :: String -> DynP ()
+setDistinctConstructorTablesPerModule arg = do
+  let cs = parseDistinctConstructorTablesArg arg
+  upd $ \d ->
+    d { distinctConstructorTables =
+        (distinctConstructorTables d) { dctConfig_perModule = True } `dctConfigConstrsPlus` cs
+      }
+
+unSetDistinctConstructorTablesPerModule :: String -> DynP ()
+unSetDistinctConstructorTablesPerModule arg = do
+  let cs = parseDistinctConstructorTablesArg arg
+  upd $ \d ->
+    d { distinctConstructorTables =
+        (distinctConstructorTables d) { dctConfig_perModule = False } `dctConfigConstrsMinus` cs
+      }
+
 setDistinctConstructorTables :: String -> DynP ()
 setDistinctConstructorTables arg = do
   let cs = parseDistinctConstructorTablesArg arg
   upd $ \d ->
     d { distinctConstructorTables =
-        (distinctConstructorTables d) `dctConfigPlus` cs
+        (distinctConstructorTables d) `dctConfigConstrsPlus` cs
       }
 
 unSetDistinctConstructorTables :: String -> DynP ()
@@ -3327,7 +3347,7 @@ unSetDistinctConstructorTables arg = do
   let cs = parseDistinctConstructorTablesArg arg
   upd $ \d ->
     d { distinctConstructorTables =
-        (distinctConstructorTables d) `dctConfigMinus` cs
+        (distinctConstructorTables d) `dctConfigConstrsMinus` cs
       }
 
 -- | Parse a string of comma-separated constructor names into a 'Set' of


=====================================
compiler/GHC/Stg/Debug.hs
=====================================
@@ -6,8 +6,9 @@
 module GHC.Stg.Debug
   ( StgDebugOpts(..)
   , StgDebugDctConfig(..)
-  , dctConfigPlus
-  , dctConfigMinus
+  , StgDebugDctConfigConstrs(..)
+  , dctConfigConstrsPlus
+  , dctConfigConstrsMinus
   , collectDebugInformation
   ) where
 
@@ -35,24 +36,33 @@ import Control.Applicative
 import qualified Data.List.NonEmpty as NE
 import Data.List.NonEmpty (NonEmpty(..))
 
-data R = R { rOpts :: StgDebugOpts, rModLocation :: ModLocation, rSpan :: Maybe SpanWithLabel }
+data R = R { rOpts :: StgDebugOpts, rModLocation :: ModLocation, rSpan :: Maybe IpeSourceLocation }
 
 type M a = ReaderT R (State InfoTableProvMap) a
 
 withSpan :: IpeSourceLocation -> M a -> M a
-withSpan (new_s, new_l) act = local maybe_replace act
+withSpan (IpeSourceLocation new_s new_l) act = local maybe_replace act
   where
-    maybe_replace r at R{ rModLocation = cur_mod, rSpan = Just (SpanWithLabel old_s _old_l) }
+    maybe_replace r at R{ rModLocation = cur_mod, rSpan = Just (IpeSourceLocation old_s _old_l) }
       -- prefer spans from the current module
       | Just (unpackFS $ srcSpanFile old_s) == ml_hs_file cur_mod
       , Just (unpackFS $ srcSpanFile new_s) /= ml_hs_file cur_mod
       = r
     maybe_replace r
-      = r { rSpan = Just (SpanWithLabel new_s new_l) }
-
-collectDebugInformation :: StgDebugOpts -> ModLocation -> [StgTopBinding] -> ([StgTopBinding], InfoTableProvMap)
-collectDebugInformation opts ml bs =
-    runState (runReaderT (mapM collectTop bs) (R opts ml Nothing)) emptyInfoTableProvMap
+      = r { rSpan = Just (IpeSourceLocation new_s new_l) }
+withSpan _ act = act
+
+collectDebugInformation :: StgDebugOpts -> ModLocation -> Module -> [StgTopBinding] -> ([StgTopBinding], InfoTableProvMap)
+collectDebugInformation opts ml m bs =
+    runState
+      ( runReaderT
+          (mapM collectTop bs)
+          (R opts ml (if perModule then Just (IpeModule m) else Nothing))
+      )
+      emptyInfoTableProvMap
+  where
+    perModule :: Bool
+    perModule = dctConfig_perModule (stgDebug_distinctConstructorTables opts)
 
 collectTop :: StgTopBinding -> M StgTopBinding
 collectTop (StgTopLifted t) = StgTopLifted <$> collectStgBind t
@@ -73,7 +83,7 @@ collectStgRhs bndr (StgRhsClosure ext cc us bs e t) = do
     -- If the name has a span, use that initially as the source position in-case
     -- we don't get anything better.
     with_span = case nameSrcSpan name of
-                  RealSrcSpan pos _ -> withSpan (pos, LexicalFastString $ occNameFS (getOccName name))
+                  RealSrcSpan pos _ -> withSpan $ IpeSourceLocation pos (LexicalFastString $ occNameFS (getOccName name))
                   _ -> id
   e' <- with_span $ collectExpr e
   recordInfo bndr e'
@@ -91,7 +101,7 @@ recordInfo bndr new_rhs = do
     -- A span from the ticks surrounding the new_rhs
     best_span = quickSourcePos thisFile new_rhs
     -- A back-up span if the bndr had a source position, many do not (think internally generated ids)
-    bndr_span = (\s -> SpanWithLabel s (LexicalFastString $ occNameFS (getOccName bndr)))
+    bndr_span = (\s -> IpeSourceLocation s (LexicalFastString $ occNameFS (getOccName bndr)))
                   <$> srcSpanToRealSrcSpan (nameSrcSpan (getName bndr))
   recordStgIdPosition bndr best_span bndr_span
 
@@ -117,7 +127,7 @@ collectExpr = go
 
     go (StgTick tick e) = do
        let k = case tick of
-                SourceNote ss fp -> withSpan (ss, fp)
+                SourceNote ss fp -> withSpan $ IpeSourceLocation ss fp
                 _ -> id
        e' <- k (go e)
        return (StgTick tick e')
@@ -134,20 +144,20 @@ collectAlt alt = do e' <- collectExpr $ alt_rhs alt
 -- It is usually a better alternative than using the 'RealSrcSpan' which is carefully
 -- propagated downwards by 'withSpan'. It's "quick" because it works only using immediate context rather
 -- than looking at the parent context like 'withSpan'
-quickSourcePos :: FastString -> StgExpr -> Maybe SpanWithLabel
+quickSourcePos :: FastString -> StgExpr -> Maybe IpeSourceLocation
 quickSourcePos cur_mod (StgTick (SourceNote ss m) e)
-  | srcSpanFile ss == cur_mod = Just (SpanWithLabel ss m)
+  | srcSpanFile ss == cur_mod = Just (IpeSourceLocation ss m)
   | otherwise = quickSourcePos cur_mod e
 quickSourcePos _ _ = Nothing
 
-recordStgIdPosition :: Id -> Maybe SpanWithLabel -> Maybe SpanWithLabel -> M ()
+recordStgIdPosition :: Id -> Maybe IpeSourceLocation -> Maybe IpeSourceLocation -> M ()
 recordStgIdPosition id best_span ss = do
   opts <- asks rOpts
   when (stgDebug_infoTableMap opts) $ do
     cc <- asks rSpan
     --Useful for debugging why a certain Id gets given a certain span
     --pprTraceM "recordStgIdPosition" (ppr id $$ ppr cc $$ ppr best_span $$ ppr ss)
-    let mbspan = (\(SpanWithLabel rss d) -> (rss, d)) <$> (best_span <|> cc <|> ss)
+    let mbspan = best_span <|> cc <|> ss
     lift $ modify (\env -> env { provClosure = addToUniqMap (provClosure env) (idName id) (idType id, mbspan) })
 
 -- | If -fdistinct-contructor-tables is enabled, each occurrance of a data
@@ -167,36 +177,59 @@ numberDataCon dc ts = do
     env <- lift get
     mcc <- asks rSpan
     let
+      -- Was -fdistinct-constructor-tables-per-module given?
+      perModule :: Bool
+      perModule = dctConfig_perModule (stgDebug_distinctConstructorTables opts)
+
       -- Guess a src span for this occurence using source note ticks and the
       -- current span in the environment
-      !mbest_span = selectTick ts <|> (\(SpanWithLabel rss l) -> (rss, l)) <$> mcc
+      !mbest_span = selectTick ts <|> mcc
 
       -- Add the occurence to the data constructor map of the InfoTableProvMap,
       -- noting the unique number assigned for this occurence
       (!r, !dcMap') =
         alterUniqMap_L
-          ( maybe
-              (Just ((0, mbest_span) :| [] ))
-              ( \xs@((k, _):|_) ->
-                  Just $! ((k + 1, mbest_span) `NE.cons` xs)
-              )
-          )
+          (addOcc perModule mbest_span)
           (provDC env)
           dc
     lift $ put (env { provDC = dcMap' })
     return $ case r of
       Nothing -> NoNumber
-      Just res -> Numbered (fst (NE.head res))
+      Just res ->
+        if perModule then
+          NumberedModule
+        else
+          Numbered (fst (NE.head res))
   else do
     -- -fdistinct-constructor-tables is not enabled, or we do not want to make
     -- distinct tables for this specific constructor
     return NoNumber
-
-selectTick :: [StgTickish] -> Maybe (RealSrcSpan, LexicalFastString)
+  where
+    addOcc
+      :: Bool -- Is -fdistinct-constructor-tables-per-module enabled?
+      -> Maybe IpeSourceLocation -- The best src location we have for this occurrence
+      -> Maybe (NonEmpty (Int, Maybe IpeSourceLocation)) -- Current noted occurrences
+      -> Maybe (NonEmpty (Int, Maybe IpeSourceLocation))
+    addOcc perModule mSrcLoc mCurOccs =
+      case mCurOccs of
+        Nothing -> Just $ pure (0, mSrcLoc)
+        Just es@((k, _) :| _) ->
+          if perModule then
+            -- -fdistinct-constructor-tables-per-module was given, meaning we do
+            -- not want to create another info table for this constructor if one
+            -- already exists for this module. Add another occurrence, but do
+            -- not increment the constructor number.
+            Just $! (0, mSrcLoc) `NE.cons` es
+          else
+            -- -fdistinct-constructor-tables-per-module was not given, add
+            -- another occurence and increment the constructor number
+            Just $! (k + 1, mSrcLoc) `NE.cons` es
+
+selectTick :: [StgTickish] -> Maybe IpeSourceLocation
 selectTick = foldl' go Nothing
   where
-    go :: Maybe (RealSrcSpan, LexicalFastString) -> StgTickish -> Maybe (RealSrcSpan, LexicalFastString)
-    go _   (SourceNote rss d) = Just (rss, d)
+    go :: Maybe IpeSourceLocation -> StgTickish -> Maybe IpeSourceLocation
+    go _   (SourceNote rss d) = Just $ IpeSourceLocation rss d
     go acc _                  = acc
 
 -- | Descide whether a distinct info table should be made for a usage of a data
@@ -205,7 +238,7 @@ selectTick = foldl' go Nothing
 -- given.
 shouldMakeDistinctTable :: StgDebugOpts -> DataCon -> Bool
 shouldMakeDistinctTable StgDebugOpts{..} dc =
-    case stgDebug_distinctConstructorTables of
+    case dctConfig_whichConstructors stgDebug_distinctConstructorTables of
       All -> True
       Only these -> Set.member dcStr these
       AllExcept these -> Set.notMember dcStr these


=====================================
compiler/GHC/Stg/Debug/Types.hs
=====================================
@@ -17,9 +17,24 @@ data StgDebugOpts = StgDebugOpts
   , stgDebug_distinctConstructorTables :: !StgDebugDctConfig
   }
 
+data StgDebugDctConfig =
+    StgDebugDctConfig
+      { dctConfig_perModule :: !Bool
+      , dctConfig_whichConstructors :: !StgDebugDctConfigConstrs
+      }
+
+-- | Necessary for 'StgDebugDctConfig' to be included in the dynflags
+-- fingerprint
+instance Binary StgDebugDctConfig where
+  put_ bh (StgDebugDctConfig pm cs) = do
+    B.put_ bh pm
+    B.put_ bh cs
+
+  get bh = StgDebugDctConfig <$> B.get bh <*> B.get bh
+
 -- | Configuration describing which constructors should be given distinct info
 -- tables for each usage.
-data StgDebugDctConfig =
+data StgDebugDctConfigConstrs =
     -- | Create distinct constructor tables for each usage of any data
     -- constructor.
     --
@@ -48,7 +63,7 @@ data StgDebugDctConfig =
 
 -- | Necessary for 'StgDebugDctConfig' to be included in the dynflags
 -- fingerprint
-instance Binary StgDebugDctConfig where
+instance Binary StgDebugDctConfigConstrs where
   put_ bh All = B.putByte bh 0
   put_ bh (Only cs) = do
     B.putByte bh 1
@@ -73,15 +88,15 @@ instance Binary StgDebugDctConfig where
 -- If the given set is empty, that means the user has entered
 -- @-fdistinct-constructor-tables@ with no constructor names specified, and
 -- therefore we consider that an 'All' configuration.
-dctConfigPlus :: StgDebugDctConfig -> Set String -> StgDebugDctConfig
-dctConfigPlus cfg cs
-    | Set.null cs = All
+dctConfigConstrsPlus :: StgDebugDctConfig -> Set String -> StgDebugDctConfig
+dctConfigConstrsPlus cfg cs
+    | Set.null cs = cfg { dctConfig_whichConstructors = All }
     | otherwise =
-        case cfg of
-          All -> All
-          Only cs' -> Only $ Set.union cs' cs
-          AllExcept cs' -> AllExcept $ Set.difference cs' cs
-          None -> Only cs
+        case dctConfig_whichConstructors cfg of
+          All -> cfg { dctConfig_whichConstructors = All }
+          Only cs' -> cfg { dctConfig_whichConstructors = Only $ Set.union cs' cs }
+          AllExcept cs' -> cfg { dctConfig_whichConstructors = AllExcept $ Set.difference cs' cs }
+          None -> cfg { dctConfig_whichConstructors = Only cs }
 
 -- | Given a distinct constructor tables configuration and a set of constructor
 -- names that we /do not/ want to generate distinct info tables for, create a
@@ -90,13 +105,13 @@ dctConfigPlus cfg cs
 -- If the given set is empty, that means the user has entered
 -- @-fno-distinct-constructor-tables@ with no constructor names specified, and
 -- therefore we consider that a 'None' configuration.
-dctConfigMinus :: StgDebugDctConfig -> Set String -> StgDebugDctConfig
-dctConfigMinus cfg cs
-    | Set.null cs = None
+dctConfigConstrsMinus :: StgDebugDctConfig -> Set String -> StgDebugDctConfig
+dctConfigConstrsMinus cfg cs
+    | Set.null cs = cfg { dctConfig_whichConstructors = None }
     | otherwise =
-        case cfg of
-          All -> AllExcept cs
-          Only cs' -> Only $ Set.difference cs' cs
-          AllExcept cs' -> AllExcept $ Set.union cs' cs
-          None -> None
+        case dctConfig_whichConstructors cfg of
+          All -> cfg { dctConfig_whichConstructors = AllExcept cs }
+          Only cs' -> cfg { dctConfig_whichConstructors = Only $ Set.difference cs' cs }
+          AllExcept cs' -> cfg { dctConfig_whichConstructors = AllExcept $ Set.union cs' cs }
+          None -> cfg { dctConfig_whichConstructors = None }
 


=====================================
compiler/GHC/Stg/Syntax.hs
=====================================
@@ -607,11 +607,12 @@ type OutStgAlt        = StgAlt
 -- each usage of a constructor is given an unique number and
 -- an info table is generated for each different constructor.
 data ConstructorNumber =
-      NoNumber | Numbered Int
+      NoNumber | Numbered !Int | NumberedModule
 
 instance Outputable ConstructorNumber where
   ppr NoNumber = empty
   ppr (Numbered n) = text "#" <> ppr n
+  ppr NumberedModule = text "#<module>"
 
 {-
 Note Stg Passes
@@ -950,6 +951,7 @@ pprStgRhs opts rhs = case rhs of
               , case mid of
                   NoNumber -> empty
                   Numbered n -> hcat [ppr n, space]
+                  NumberedModule -> hcat [text "#<module>", space]
               -- The bang indicates this is an StgRhsCon instead of an StgConApp.
               , ppr con, text "! ", brackets (sep (map pprStgArg args))]
 


=====================================
compiler/GHC/StgToCmm.hs
=====================================
@@ -67,6 +67,7 @@ import GHC.Utils.Misc
 import System.IO.Unsafe
 import qualified Data.ByteString as BS
 import Data.IORef
+import Data.List.NonEmpty (NonEmpty(..))
 import GHC.Utils.Panic
 
 codeGen :: Logger
@@ -120,8 +121,34 @@ codeGen logger tmpfs cfg (InfoTableProvMap (UniqMap denv) _ _) data_tycons
         ; mapM_ do_tycon data_tycons
 
         -- Emit special info tables for everything used in this module
-        -- This will only do something if  `-fdistinct-info-tables` is turned on.
-        ; mapM_ (\(dc, ns) -> forM_ ns $ \(k, _ss) -> cg (cgDataCon (UsageSite (stgToCmmThisModule cfg) k) dc)) (nonDetEltsUFM denv)
+        -- This will only do something if  `-fdistinct-info-tables` is turned
+        -- on.
+        -- Note: if `-fdistinct-constructor-tables-per-module` is on, we only
+        -- want to emit ONE info table for every data constructor used in the
+        -- module, to avoid emitting the same info table multiple times.
+        ; mapM_
+            ( \(dc, ((k1, _ss) :| ns)) -> do
+                let
+                  perModule = stgToCmmDctPerModule cfg
+                  mdl = stgToCmmThisModule cfg
+                  site k =
+                    if perModule then
+                      UsageModule mdl
+                    else
+                      UsageSite mdl k
+
+                -- Always emit at least one info table. If
+                -- -fdistinct-constructor-tables-per-module, equivalent data
+                -- constructors will all ave the same constructor number (0)
+                cg (cgDataCon (site k1) dc)
+
+                -- If -fdistinct-constructor-tables-per-module is disabled, emit
+                -- the rest of the info tables
+                when (not perModule) $
+                  forM_ ns $ \(k, _ss) ->
+                    cg (cgDataCon (site k) dc)
+            )
+            (nonDetEltsUFM denv)
 
         ; final_state <- liftIO (readIORef cgref)
         ; let cg_id_infos = cgs_binds final_state
@@ -234,9 +261,12 @@ cgEnumerationTyCon tycon
              | con <- tyConDataCons tycon]
 
 
-cgDataCon :: ConInfoTableLocation -> DataCon -> FCode ()
--- Generate the entry code, info tables, and (for niladic constructor)
+-- | Generate the entry code, info tables, and (for niladic constructor)
 -- the static closure, for a constructor.
+cgDataCon
+  :: ConInfoTableLocation -- ^ Location information for the info table
+  -> DataCon -- ^ Data constructor
+  -> FCode ()
 cgDataCon mn data_con
   = do  { massert (not (isUnboxedTupleDataCon data_con || isUnboxedSumDataCon data_con))
         ; profile <- getProfile
@@ -248,8 +278,7 @@ cgDataCon mn data_con
 
             nonptr_wds   = tot_wds - ptr_wds
 
-            dyn_info_tbl =
-              mkDataConInfoTable profile data_con mn False ptr_wds nonptr_wds
+            dyn_info_tbl = mkDataConInfoTable profile data_con mn False ptr_wds nonptr_wds
 
             -- We're generating info tables, so we don't know and care about
             -- what the actual arguments are. Using () here as the place holder.


=====================================
compiler/GHC/StgToCmm/Config.hs
=====================================
@@ -54,6 +54,7 @@ data StgToCmmConfig = StgToCmmConfig
   , stgToCmmInfoTableMap   :: !Bool              -- ^ true means generate C Stub for IPE map, See Note [Mapping Info Tables to Source Positions]
   , stgToCmmInfoTableMapWithFallback :: !Bool    -- ^ Include info tables with fallback source locations in the info table map
   , stgToCmmInfoTableMapWithStack :: !Bool       -- ^ Include info tables for STACK closures in the info table map
+  , stgToCmmDctPerModule :: !Bool                -- ^ Only generate one info table per module for distinct usages of data constructors
   , stgToCmmOmitYields     :: !Bool              -- ^ true means omit heap checks when no allocation is performed
   , stgToCmmOmitIfPragmas  :: !Bool              -- ^ true means don't generate interface programs (implied by -O0)
   , stgToCmmPIC            :: !Bool              -- ^ true if @-fPIC@


=====================================
compiler/GHC/StgToCmm/DataCon.hs
=====================================
@@ -149,6 +149,7 @@ addModuleLoc this_mod mn = do
   case mn of
     NoNumber -> DefinitionSite
     Numbered n -> UsageSite this_mod n
+    NumberedModule -> UsageModule this_mod
 
 ---------------------------------------------------------------
 --      Lay out and allocate non-top-level constructors


=====================================
compiler/GHC/StgToCmm/Layout.hs
=====================================
@@ -648,10 +648,14 @@ emitClosureProcAndInfoTable top_lvl bndr lf_info info_tbl args body
 
 -- Data constructors need closures, but not with all the argument handling
 -- needed for functions. The shared part goes here.
-emitClosureAndInfoTable
-   :: Platform -> CmmInfoTable -> Convention -> [LocalReg] -> FCode () -> FCode ()
+emitClosureAndInfoTable :: Platform -> CmmInfoTable -> Convention -> [LocalReg] -> FCode () -> FCode ()
 emitClosureAndInfoTable platform info_tbl conv args body
   = do { (_, blks) <- getCodeScoped body
        ; let entry_lbl = toEntryLbl platform (cit_lbl info_tbl)
-       ; emitProcWithConvention conv (Just info_tbl) entry_lbl args blks
+       ; emitProcWithConvention
+           conv
+           (Just info_tbl)
+           entry_lbl
+           args
+           blks
        }


=====================================
compiler/GHC/StgToCmm/Ticky.hs
=====================================
@@ -348,6 +348,7 @@ emitTickyCounter cloType tickee
                             TickyCon dc mn -> case mn of
                                                NoNumber -> return $! CmmLabel $ mkConInfoTableLabel (dataConName dc) DefinitionSite
                                                (Numbered n) -> return $! CmmLabel $ mkConInfoTableLabel (dataConName dc) (UsageSite this_mod n)
+                                               NumberedModule -> return $! CmmLabel $ mkConInfoTableLabel (dataConName dc) (UsageModule this_mod)
                             TickyFun {} ->
                               return $! CmmLabel $ mkInfoTableLabel name NoCafRefs
 


=====================================
compiler/GHC/StgToCmm/Utils.hs
=====================================
@@ -94,6 +94,7 @@ import Control.Monad
 import qualified Data.Map.Strict as Map
 import qualified Data.IntMap.Strict as I
 import qualified Data.Semigroup (Semigroup(..))
+import GHC.Types.SrcLoc (RealSrcSpan)
 
 --------------------------------------------------------------------------
 --
@@ -660,22 +661,41 @@ convertInfoProvMap cfg this_mod (InfoTableProvMap (UniqMap dcenv) denv infoTable
         tyString :: Outputable a => a -> String
         tyString = renderWithContext defaultSDocContext . ppr
 
+        convertIpeSrcLoc :: Maybe IpeSourceLocation -> Maybe (RealSrcSpan, LexicalFastString)
+        convertIpeSrcLoc (Just (IpeSourceLocation s l)) = Just (s, l)
+        convertIpeSrcLoc _ = Nothing
+
         lookupClosureMap :: Maybe (IPEStats, InfoProvEnt)
-        lookupClosureMap = case hasHaskellName cl >>= lookupUniqMap denv of
-                                Just (ty, mbspan) -> Just (closureIpeStats cn, (InfoProvEnt cl cn (tyString ty) this_mod mbspan))
-                                Nothing -> Nothing
+        lookupClosureMap =
+          case hasHaskellName cl >>= lookupUniqMap denv of
+            Just (ty, mbspan) ->
+              Just ( closureIpeStats cn
+                   , (InfoProvEnt cl cn (tyString ty) this_mod (convertIpeSrcLoc mbspan))
+                   )
+            Nothing -> Nothing
 
         lookupDataConMap :: Maybe (IPEStats, InfoProvEnt)
         lookupDataConMap = (closureIpeStats cn,) <$> do
-            UsageSite _ n <- hasIdLabelInfo cl >>= getConInfoTableLocation
+            n <-
+              hasIdLabelInfo cl >>= getConInfoTableLocation >>= \s ->
+                case s of
+                  UsageSite _ n -> return n
+                  UsageModule _ -> return 0
+                  _ -> Nothing
             -- This is a bit grimy, relies on the DataCon and Name having the same Unique, which they do
             (dc, ns) <- hasHaskellName cl >>= lookupUFM_Directly dcenv . getUnique
-            -- Lookup is linear but lists will be small (< 100)
-            return $ (InfoProvEnt cl cn (tyString (dataConTyCon dc)) this_mod (join $ lookup n (NE.toList ns)))
+            return $
+              InfoProvEnt cl cn (tyString (dataConTyCon dc)) this_mod $
+                if stgToCmmDctPerModule cfg then
+                  Nothing
+                else
+                  convertIpeSrcLoc
+                    -- Lookup is linear but lists will be small (< 100)
+                    (join $ lookup n (NE.toList ns))
 
         lookupInfoTableToSourceLocation :: Maybe (IPEStats, InfoProvEnt)
         lookupInfoTableToSourceLocation = do
-            sourceNote <- Map.lookup (cit_lbl cmit) infoTableToSourceLocationMap
+            sourceNote <- convertIpeSrcLoc <$> Map.lookup (cit_lbl cmit) infoTableToSourceLocationMap
             return $ (closureIpeStats cn, (InfoProvEnt cl cn "" this_mod sourceNote))
 
         -- This catches things like prim closure types and anything else which doesn't have a


=====================================
compiler/GHC/Types/IPE.hs
=====================================
@@ -3,7 +3,7 @@ module GHC.Types.IPE (
     ClosureMap,
     InfoTableProvMap(..),
     emptyInfoTableProvMap,
-    IpeSourceLocation
+    IpeSourceLocation(..)
 ) where
 
 import GHC.Prelude
@@ -18,10 +18,14 @@ import GHC.Core.Type
 import Data.List.NonEmpty
 import GHC.Cmm.CLabel (CLabel)
 import qualified Data.Map.Strict as Map
+import GHC.Unit.Module (Module)
 
 -- | Position and information about an info table.
 -- For return frames these are the contents of a 'CoreSyn.SourceNote'.
-type IpeSourceLocation = (RealSrcSpan, LexicalFastString)
+data IpeSourceLocation
+    = IpeSourceLocation !RealSrcSpan !LexicalFastString
+    | IpeModule !Module
+  deriving Eq
 
 -- | A map from a 'Name' to the best approximate source position that
 -- name arose from.


=====================================
docs/users_guide/9.10.1-notes.rst
=====================================
@@ -66,6 +66,24 @@ Compiler
   users to refine the set of constructors for which distinct info tables should
   be generated.
 
+- The :ghc-flag:`-fdistinct-constructor-tables-per-module
+  <-fdistinct-constructor-tables-per-module=⟨cs⟩>` flag is introduced. When
+  provided, this flag will cause only one distinct info table to be created for
+  every usage of a data constructor in a module, when
+  :ghc-flag:`-fdistinct-constructor-tables <-fdistinct-constructor-tables=⟨cs⟩>`
+  is enabled for that constructor.
+
+  For example, consider a module containing five occurrences of some
+  constructor. If that module is compiled with only
+  :ghc-flag:`-fdistinct-constructor-tables <-fdistinct-constructor-tables=⟨cs⟩>`
+  then five distinct info tables will be created, one for each occurrence of the
+  constructor. If that module is also compiled with
+  :ghc-flag:`-fdistinct-constructor-tables-per-module
+  <-fdistinct-constructor-tables-per-module=⟨cs⟩>`, then only one info table
+  will be created. This means that allocations resulting from any of those five
+  occurrences will be attributed to that one info table when using the
+  :rts-flag:`-hi` profiling mode.
+
 GHCi
 ~~~~
 


=====================================
docs/users_guide/debug-info.rst
=====================================
@@ -400,7 +400,6 @@ to a source location. This lookup table is generated by using the ``-finfo-table
     :shortdesc: Include info tables for ``STACK`` closures in the info table
                 map.
     :type: dynamic
-    :reverse: -fno-info-table-map-with-stack
     :category: debugging
 
     :since: 9.10
@@ -412,7 +411,6 @@ to a source location. This lookup table is generated by using the ``-finfo-table
     :shortdesc: Omit info tables for ``STACK`` closures from the info table
                 map.
     :type: dynamic
-    :reverse: -finfo-table-map-with-stack
     :category: debugging
 
     :since: 9.10
@@ -428,7 +426,6 @@ to a source location. This lookup table is generated by using the ``-finfo-table
     :shortdesc: Include info tables with no source location information in the
                 info table map.
     :type: dynamic
-    :reverse: -fno-info-table-map-with-fallback
     :category: debugging
 
     :since: 9.10
@@ -440,7 +437,6 @@ to a source location. This lookup table is generated by using the ``-finfo-table
     :shortdesc: Omit info tables with no source location information from the
                 info table map.
     :type: dynamic
-    :reverse: -finfo-table-map-with-fallback
     :category: debugging
 
     :since: 9.10
@@ -492,7 +488,8 @@ to a source location. This lookup table is generated by using the ``-finfo-table
     Use this flag to refine the set of data constructors for which distinct info
     tables are generated (as specified by
     :ghc-flag:`-fdistinct-constructor-tables
-    <-fdistinct-constructor-tables=⟨cs⟩>`).
+    <-fdistinct-constructor-tables=⟨cs⟩>` or :ghc-flag:`-fdistinct-constructor-tables-per-module
+    <-fdistinct-constructor-tables-per-module=⟨cs⟩>`).
     If no constructor names are given
     (i.e. just ``-fno-distinct-constructor-tables`` is given) then no distinct
     info tables will be generated for any usages of any data constructors.
@@ -502,6 +499,76 @@ to a source location. This lookup table is generated by using the ``-finfo-table
     ``-fdistinct-constructor-tables`` and
     ``-fno-distinct-constructor-tables=MyConstr``.
 
+.. ghc-flag:: -fdistinct-constructor-tables-per-module=⟨cs⟩
+    :shortdesc: Generate only one fresh info table to be used for all
+                occurrences of a data constructor in a module.
+    :type: dynamic
+    :category: debugging
+
+    :since: 9.10
+
+    This flag has the same effect as :ghc-flag:`-fdistinct-constructor-tables
+    <-fdistinct-constructor-tables=⟨cs⟩>` except that instead of a distinct info
+    table being generated for *every* usage of a data constructor, only one info
+    table will be generated and used for all occurrences of a data constructor
+    *in a single module*. In other words, when just
+    :ghc-flag:`-fdistinct-constructor-tables
+    <-fdistinct-constructor-tables=⟨cs⟩>` is used, it results in a one-to-one
+    mapping from info tables to data constructor usages, for a given data
+    constructor in a given module. However, when just
+    :ghc-flag:`-fdistinct-constructor-tables-per-module
+    <-fdistinct-constructor-tables-per-module=⟨cs⟩>` is used, it will result in
+    a one-to-N mapping from into tables to data constructor usages, for a given
+    data constructor which is used N times in a given module.
+
+    This is useful when used in conjunction with :ghc-flag:`-finfo-table-map`
+    and the :rts-flag:`-hi` profiling mode to track all allocations resulting
+    from some constructor at a module-level granularity.
+
+    Like the :ghc-flag:`-fdistinct-constructor-tables
+    <-fdistinct-constructor-tables=⟨cs⟩>` flag, the set of constructors for
+    which this behavior applies may also be refined by providing a
+    comma-separated list of constructor names to this flag or the
+    :ghc-flag:`-fno-distinct-constructor-tables-per-module
+    <-fno-distinct-constructor-tables-per-module=⟨cs⟩>`. For example, to
+    generate per-module constructor tables for just the ``Just`` and ``Right``
+    constructors, use ``-fdistinct-constructor-tables-per-module=Just,Right``.
+
+.. ghc-flag:: -fno-distinct-constructor-tables-per-module=⟨cs⟩
+    :shortdesc: Avoid generating a fresh info table for each usage of a data
+                constructor, and revert to the normal usage-level granularity
+                of distinct info table creation.
+    :type: dynamic
+    :category: debugging
+
+    :since: 9.10
+
+    This flag has the same effect as :ghc-flag:`-fno-distinct-constructor-tables
+    <-fno-distinct-constructor-tables=⟨cs⟩>` except it also disables the
+    per-module behavior of the :ghc-flag:`-fdistinct-constructor-tables-per-module
+    <-fdistinct-constructor-tables-per-module=⟨cs⟩>` flag, resulting in a
+    distinct info table being generated for *every* usage of *every* data
+    constructor for which the distinct constructor table behavior has not been
+    disabled.
+
+    This may not be intuitive, but the behavior is intended, since it is
+    important that there is some way to disable the per-module behavior of
+    :ghc-flag:`-fdistinct-constructor-tables-per-module
+    <-fdistinct-constructor-tables-per-module=⟨cs⟩>`. For example, the flag
+    combination ``-fdistinct-constructor-tables-per-module
+    -fno-distinct-constructor-tables-per-module=MyConstr`` will result in the
+    same configuration as ``-fdistinct-constructor-tables
+    -fno-distinct-constructor-tables=MyConstr``. To preserve the per-module
+    behavior introduced by the
+    :ghc-flag:`-fdistinct-constructor-tables-per-module
+    <-fdistinct-constructor-tables-per-module=⟨cs⟩>` flag while refining the set
+    of data constructors for which it applies, just use the
+    :ghc-flag:`-fno-distinct-constructor-tables
+    <-fno-distinct-constructor-tables=⟨cs⟩>` flag. For example, to generate
+    per-module distinct tables for all data constructors except the ``Just``
+    constructor, use ``-fdistinct-constructor-tables-per-module
+    -fno-distinct-constructor-tables=Just``.
+
 Querying the Info Table Map
 ---------------------------
 


=====================================
testsuite/tests/rts/ipe/distinct-tables/Makefile
=====================================
@@ -23,6 +23,14 @@ distinct_tables:
 	NoCCon="$$(./Main)" ; \
 	$$TEST_HC $$TEST_HC_OPTS -finfo-table-map -fdistinct-constructor-tables -fno-distinct-constructor-tables=BCon,CCon Main.hs ; \
 	NoBConCCon="$$(./Main)" ; \
+	$$TEST_HC $$TEST_HC_OPTS -finfo-table-map -fdistinct-constructor-tables-per-module Main.hs ; \
+	PerModule="$$(./Main)" ; \
+	$$TEST_HC $$TEST_HC_OPTS -finfo-table-map -fdistinct-constructor-tables-per-module=ACon Main.hs ; \
+	PerModuleACon="$$(./Main)" ; \
+	$$TEST_HC $$TEST_HC_OPTS -finfo-table-map -fdistinct-constructor-tables-per-module -fno-distinct-constructor-tables=BCon Main.hs ; \
+	PerModuleNoBCon="$$(./Main)" ; \
+	$$TEST_HC $$TEST_HC_OPTS -finfo-table-map -fdistinct-constructor-tables-per-module -fno-distinct-constructor-tables-per-module=BCon Main.hs ; \
+	NoPerModuleNoBCon="$$(./Main)" ; \
 	echo "$$ACon" | diff --strip-trailing-cr ACon.out - && \
 	echo "$$BCon" | diff --strip-trailing-cr BCon.out - && \
 	echo "$$CCon" | diff --strip-trailing-cr CCon.out - && \
@@ -30,4 +38,9 @@ distinct_tables:
 	echo "$$NoACon" | diff --strip-trailing-cr NoACon.out - && \
 	echo "$$NoBCon" | diff --strip-trailing-cr NoBCon.out - && \
 	echo "$$NoCCon" | diff --strip-trailing-cr NoCCon.out - && \
-	echo "$$NoBConCCon" | diff --strip-trailing-cr NoBConCCon.out -
+	echo "$$NoBConCCon" | diff --strip-trailing-cr NoBConCCon.out - && \
+	echo "$$PerModule" | diff --strip-trailing-cr PerModule.out - && \
+	echo "$$PerModuleACon" | diff --strip-trailing-cr PerModuleACon.out - && \
+	echo "$$PerModuleNoBCon" | diff --strip-trailing-cr PerModuleNoBCon.out - && \
+	echo "$$NoPerModuleNoBCon" | diff --strip-trailing-cr NoPerModuleNoBCon.out - && \
+	[ "x$$NoPerModuleNoBCon" = "x$$NoBCon" ]


=====================================
testsuite/tests/rts/ipe/distinct-tables/NoPerModuleNoBCon.out
=====================================
@@ -0,0 +1,13 @@
+InfoProv {ipName = "ACon_Main_0_con_info", ipDesc = "2", ipTyDesc = "A", ipLabel = "cafA1", ipMod = "Main", ipSrcFile = "", ipSrcSpan = "30:1-15"}
+InfoProv {ipName = "ACon_Main_1_con_info", ipDesc = "2", ipTyDesc = "A", ipLabel = "cafA2", ipMod = "Main", ipSrcFile = "", ipSrcSpan = "31:1-15"}
+InfoProv {ipName = "BCon_con_info", ipDesc = "2", ipTyDesc = "", ipLabel = "", ipMod = "Main", ipSrcFile = "", ipSrcSpan = ""}
+InfoProv {ipName = "BCon_con_info", ipDesc = "2", ipTyDesc = "", ipLabel = "", ipMod = "Main", ipSrcFile = "", ipSrcSpan = ""}
+InfoProv {ipName = "CCon_Main_0_con_info", ipDesc = "2", ipTyDesc = "C", ipLabel = "cafC1", ipMod = "Main", ipSrcFile = "", ipSrcSpan = "34:1-27"}
+InfoProv {ipName = "CCon_Main_1_con_info", ipDesc = "2", ipTyDesc = "C", ipLabel = "cafC2", ipMod = "Main", ipSrcFile = "", ipSrcSpan = "35:1-27"}
+InfoProv {ipName = "ACon_Main_3_con_info", ipDesc = "2", ipTyDesc = "A", ipLabel = "main", ipMod = "Main", ipSrcFile = "", ipSrcSpan = "13:17-35"}
+InfoProv {ipName = "ACon_Main_0_con_info", ipDesc = "2", ipTyDesc = "X", ipLabel = "cafXA", ipMod = "Main", ipSrcFile = "", ipSrcSpan = "37:1-17"}
+InfoProv {ipName = "ACon_X_0_con_info", ipDesc = "2", ipTyDesc = "X", ipLabel = "cafXA1", ipMod = "X", ipSrcFile = "", ipSrcSpan = "6:1-16"}
+InfoProv {ipName = "ACon_X_1_con_info", ipDesc = "2", ipTyDesc = "X", ipLabel = "cafXA2", ipMod = "X", ipSrcFile = "", ipSrcSpan = "7:1-16"}
+InfoProv {ipName = "ACon_Main_1_con_info", ipDesc = "2", ipTyDesc = "X", ipLabel = "main", ipMod = "Main", ipSrcFile = "", ipSrcSpan = "17:17-37"}
+InfoProv {ipName = "BCon_con_info", ipDesc = "2", ipTyDesc = "", ipLabel = "", ipMod = "Main", ipSrcFile = "", ipSrcSpan = ""}
+InfoProv {ipName = "CCon_Main_2_con_info", ipDesc = "2", ipTyDesc = "C", ipLabel = "main", ipMod = "Main", ipSrcFile = "", ipSrcSpan = "19:34-38"}


=====================================
testsuite/tests/rts/ipe/distinct-tables/PerModule.out
=====================================
@@ -0,0 +1,13 @@
+InfoProv {ipName = "ACon_Main_con_info", ipDesc = "2", ipTyDesc = "A", ipLabel = "", ipMod = "Main", ipSrcFile = "", ipSrcSpan = ""}
+InfoProv {ipName = "ACon_Main_con_info", ipDesc = "2", ipTyDesc = "A", ipLabel = "", ipMod = "Main", ipSrcFile = "", ipSrcSpan = ""}
+InfoProv {ipName = "BCon_Main_con_info", ipDesc = "2", ipTyDesc = "B", ipLabel = "", ipMod = "Main", ipSrcFile = "", ipSrcSpan = ""}
+InfoProv {ipName = "BCon_Main_con_info", ipDesc = "2", ipTyDesc = "B", ipLabel = "", ipMod = "Main", ipSrcFile = "", ipSrcSpan = ""}
+InfoProv {ipName = "CCon_Main_con_info", ipDesc = "2", ipTyDesc = "C", ipLabel = "", ipMod = "Main", ipSrcFile = "", ipSrcSpan = ""}
+InfoProv {ipName = "CCon_Main_con_info", ipDesc = "2", ipTyDesc = "C", ipLabel = "", ipMod = "Main", ipSrcFile = "", ipSrcSpan = ""}
+InfoProv {ipName = "ACon_Main_con_info", ipDesc = "2", ipTyDesc = "A", ipLabel = "", ipMod = "Main", ipSrcFile = "", ipSrcSpan = ""}
+InfoProv {ipName = "ACon_Main_con_info", ipDesc = "2", ipTyDesc = "X", ipLabel = "", ipMod = "Main", ipSrcFile = "", ipSrcSpan = ""}
+InfoProv {ipName = "ACon_X_con_info", ipDesc = "2", ipTyDesc = "X", ipLabel = "", ipMod = "X", ipSrcFile = "", ipSrcSpan = ""}
+InfoProv {ipName = "ACon_X_con_info", ipDesc = "2", ipTyDesc = "X", ipLabel = "", ipMod = "X", ipSrcFile = "", ipSrcSpan = ""}
+InfoProv {ipName = "ACon_Main_con_info", ipDesc = "2", ipTyDesc = "X", ipLabel = "", ipMod = "Main", ipSrcFile = "", ipSrcSpan = ""}
+InfoProv {ipName = "BCon_Main_con_info", ipDesc = "2", ipTyDesc = "B", ipLabel = "", ipMod = "Main", ipSrcFile = "", ipSrcSpan = ""}
+InfoProv {ipName = "CCon_Main_con_info", ipDesc = "2", ipTyDesc = "C", ipLabel = "", ipMod = "Main", ipSrcFile = "", ipSrcSpan = ""}


=====================================
testsuite/tests/rts/ipe/distinct-tables/PerModuleACon.out
=====================================
@@ -0,0 +1,13 @@
+InfoProv {ipName = "ACon_Main_con_info", ipDesc = "2", ipTyDesc = "A", ipLabel = "", ipMod = "Main", ipSrcFile = "", ipSrcSpan = ""}
+InfoProv {ipName = "ACon_Main_con_info", ipDesc = "2", ipTyDesc = "A", ipLabel = "", ipMod = "Main", ipSrcFile = "", ipSrcSpan = ""}
+InfoProv {ipName = "BCon_con_info", ipDesc = "2", ipTyDesc = "", ipLabel = "", ipMod = "Main", ipSrcFile = "", ipSrcSpan = ""}
+InfoProv {ipName = "BCon_con_info", ipDesc = "2", ipTyDesc = "", ipLabel = "", ipMod = "Main", ipSrcFile = "", ipSrcSpan = ""}
+InfoProv {ipName = "CCon_con_info", ipDesc = "2", ipTyDesc = "", ipLabel = "", ipMod = "Main", ipSrcFile = "", ipSrcSpan = ""}
+InfoProv {ipName = "CCon_con_info", ipDesc = "2", ipTyDesc = "", ipLabel = "", ipMod = "Main", ipSrcFile = "", ipSrcSpan = ""}
+InfoProv {ipName = "ACon_Main_con_info", ipDesc = "2", ipTyDesc = "A", ipLabel = "", ipMod = "Main", ipSrcFile = "", ipSrcSpan = ""}
+InfoProv {ipName = "ACon_Main_con_info", ipDesc = "2", ipTyDesc = "X", ipLabel = "", ipMod = "Main", ipSrcFile = "", ipSrcSpan = ""}
+InfoProv {ipName = "ACon_X_con_info", ipDesc = "2", ipTyDesc = "X", ipLabel = "", ipMod = "X", ipSrcFile = "", ipSrcSpan = ""}
+InfoProv {ipName = "ACon_X_con_info", ipDesc = "2", ipTyDesc = "X", ipLabel = "", ipMod = "X", ipSrcFile = "", ipSrcSpan = ""}
+InfoProv {ipName = "ACon_Main_con_info", ipDesc = "2", ipTyDesc = "X", ipLabel = "", ipMod = "Main", ipSrcFile = "", ipSrcSpan = ""}
+InfoProv {ipName = "BCon_con_info", ipDesc = "2", ipTyDesc = "", ipLabel = "", ipMod = "Main", ipSrcFile = "", ipSrcSpan = ""}
+InfoProv {ipName = "CCon_con_info", ipDesc = "2", ipTyDesc = "", ipLabel = "", ipMod = "Main", ipSrcFile = "", ipSrcSpan = ""}


=====================================
testsuite/tests/rts/ipe/distinct-tables/PerModuleNoBCon.out
=====================================
@@ -0,0 +1,13 @@
+InfoProv {ipName = "ACon_Main_con_info", ipDesc = "2", ipTyDesc = "A", ipLabel = "", ipMod = "Main", ipSrcFile = "", ipSrcSpan = ""}
+InfoProv {ipName = "ACon_Main_con_info", ipDesc = "2", ipTyDesc = "A", ipLabel = "", ipMod = "Main", ipSrcFile = "", ipSrcSpan = ""}
+InfoProv {ipName = "BCon_con_info", ipDesc = "2", ipTyDesc = "", ipLabel = "", ipMod = "Main", ipSrcFile = "", ipSrcSpan = ""}
+InfoProv {ipName = "BCon_con_info", ipDesc = "2", ipTyDesc = "", ipLabel = "", ipMod = "Main", ipSrcFile = "", ipSrcSpan = ""}
+InfoProv {ipName = "CCon_Main_con_info", ipDesc = "2", ipTyDesc = "C", ipLabel = "", ipMod = "Main", ipSrcFile = "", ipSrcSpan = ""}
+InfoProv {ipName = "CCon_Main_con_info", ipDesc = "2", ipTyDesc = "C", ipLabel = "", ipMod = "Main", ipSrcFile = "", ipSrcSpan = ""}
+InfoProv {ipName = "ACon_Main_con_info", ipDesc = "2", ipTyDesc = "A", ipLabel = "", ipMod = "Main", ipSrcFile = "", ipSrcSpan = ""}
+InfoProv {ipName = "ACon_Main_con_info", ipDesc = "2", ipTyDesc = "X", ipLabel = "", ipMod = "Main", ipSrcFile = "", ipSrcSpan = ""}
+InfoProv {ipName = "ACon_X_con_info", ipDesc = "2", ipTyDesc = "X", ipLabel = "", ipMod = "X", ipSrcFile = "", ipSrcSpan = ""}
+InfoProv {ipName = "ACon_X_con_info", ipDesc = "2", ipTyDesc = "X", ipLabel = "", ipMod = "X", ipSrcFile = "", ipSrcSpan = ""}
+InfoProv {ipName = "ACon_Main_con_info", ipDesc = "2", ipTyDesc = "X", ipLabel = "", ipMod = "Main", ipSrcFile = "", ipSrcSpan = ""}
+InfoProv {ipName = "BCon_con_info", ipDesc = "2", ipTyDesc = "", ipLabel = "", ipMod = "Main", ipSrcFile = "", ipSrcSpan = ""}
+InfoProv {ipName = "CCon_Main_con_info", ipDesc = "2", ipTyDesc = "C", ipLabel = "", ipMod = "Main", ipSrcFile = "", ipSrcSpan = ""}


=====================================
testsuite/tests/rts/ipe/distinct-tables/all.T
=====================================
@@ -14,7 +14,11 @@ test(
             'NoACon.out',
             'NoBCon.out',
             'NoCCon.out',
-            'NoBConCCon.out'
+            'NoBConCCon.out',
+            'PerModule.out',
+            'PerModuleACon.out',
+            'PerModuleNoBCon.out',
+            'NoPerModuleNoBCon.out'
         ]),
         ignore_stdout
         ]



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dfb53f740df9fd76ae189055dba6530a349792fd

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dfb53f740df9fd76ae189055dba6530a349792fd
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230912/1c6cc331/attachment-0001.html>


More information about the ghc-commits mailing list