[Git][ghc/ghc][wip/t23703] Allow constructor names for -fdistinct-constructor-tables
Finley McIlwaine (@FinleyMcIlwaine)
gitlab at gitlab.haskell.org
Mon Jul 24 23:26:56 UTC 2023
Finley McIlwaine pushed to branch wip/t23703 at Glasgow Haskell Compiler / GHC
Commits:
be2375db by Finley McIlwaine at 2023-07-24T17:26:30-06:00
Allow constructor names for -fdistinct-constructor-tables
Also introduce `-fno-distinct-constructor-tables`. A distinct constructor table
configuration is built from the combination of flags given, in order. For example,
to create distinct constructor tables for all constructors except for a specific
few named `C1`,..., `CN`, pass `-fdistinct-contructor-tables` followed by
`fno-distinct-constructor-tables=C1,...,CN`. To only generate distinct
constuctor tables for a few specific constructors and no others, just pass
`-fdistinct-constructor-tables=C1,...,CN`.
The various configuations of these flags is included in the dynflags fingerprints,
which should result in the expected recompilation logic.
Fixes #23703
- - - - -
8 changed files:
- compiler/GHC/Driver/Config/Stg/Debug.hs
- compiler/GHC/Driver/DynFlags.hs
- compiler/GHC/Driver/Flags.hs
- compiler/GHC/Driver/Session.hs
- compiler/GHC/Iface/Recomp/Flags.hs
- compiler/GHC/Stg/Debug.hs
- docs/users_guide/9.10.1-notes.rst
- docs/users_guide/debug-info.rst
Changes:
=====================================
compiler/GHC/Driver/Config/Stg/Debug.hs
=====================================
@@ -10,5 +10,5 @@ import GHC.Driver.DynFlags
initStgDebugOpts :: DynFlags -> StgDebugOpts
initStgDebugOpts dflags = StgDebugOpts
{ stgDebug_infoTableMap = gopt Opt_InfoTableMap dflags
- , stgDebug_distinctConstructorTables = gopt Opt_DistinctConstructorTables dflags
+ , stgDebug_distinctConstructorTables = distinctConstructorTables dflags
}
=====================================
compiler/GHC/Driver/DynFlags.hs
=====================================
@@ -99,6 +99,7 @@ import GHC.Types.SrcLoc
import GHC.Unit.Module
import GHC.Unit.Module.Warnings
import GHC.Utils.CliOption
+import GHC.Stg.Debug (StgDebugDctConfig(..))
import GHC.SysTools.Terminal ( stderrSupportsAnsiColors )
import GHC.UniqueSubdir (uniqueSubdir)
import GHC.Utils.Outputable
@@ -116,6 +117,7 @@ import Control.Monad.Trans.Class (lift)
import Control.Monad.Trans.Except (ExceptT)
import Control.Monad.Trans.Reader (ReaderT)
import Control.Monad.Trans.Writer (WriterT)
+import qualified Data.Set as Set
import Data.Word
import System.IO
import System.IO.Error (catchIOError)
@@ -124,8 +126,6 @@ import System.FilePath (normalise, (</>))
import System.Directory
import GHC.Foreign (withCString, peekCString)
-import qualified Data.Set as Set
-
import qualified GHC.LanguageExtensions as LangExt
-- -----------------------------------------------------------------------------
@@ -445,7 +445,11 @@ data DynFlags = DynFlags {
-- 'Int' because it can be used to test uniques in decreasing order.
-- | Temporary: CFG Edge weights for fast iterations
- cfgWeights :: Weights
+ cfgWeights :: Weights,
+
+ -- | Configuration specifying which constructor names we should create
+ -- distinct info tables for
+ distinctConstructorTables :: StgDebugDctConfig
}
class HasDynFlags m where
@@ -690,7 +694,9 @@ defaultDynFlags mySettings =
reverseErrors = False,
maxErrors = Nothing,
- cfgWeights = defaultWeights
+ cfgWeights = defaultWeights,
+
+ distinctConstructorTables = None
}
type FatalMessager = String -> IO ()
=====================================
compiler/GHC/Driver/Flags.hs
=====================================
@@ -221,7 +221,6 @@ data GeneralFlag
| Opt_FastLlvm -- hidden flag
| Opt_NoTypeableBinds
- | Opt_DistinctConstructorTables
| Opt_InfoTableMap
| Opt_WarnIsError -- -Werror; makes warnings fatal
@@ -575,7 +574,6 @@ codeGenFlags = EnumSet.fromList
, Opt_DoTagInferenceChecks
-- Flags that affect debugging information
- , Opt_DistinctConstructorTables
, Opt_InfoTableMap
, Opt_OrigThunkInfo
]
=====================================
compiler/GHC/Driver/Session.hs
=====================================
@@ -260,6 +260,7 @@ import GHC.Utils.Outputable
import GHC.Settings
import GHC.CmmToAsm.CFG.Weight
import GHC.Core.Opt.CallerCC
+import GHC.Stg.Debug
import GHC.SysTools.BaseDir ( expandToolDir, expandTopDir )
@@ -1780,7 +1781,9 @@ dynamic_flags_deps = [
, make_ord_flag defGhcFlag "fprof-callers"
(HasArg setCallerCcFilters)
, make_ord_flag defGhcFlag "fdistinct-constructor-tables"
- (NoArg (setGeneralFlag Opt_DistinctConstructorTables))
+ (OptPrefix setDistinctCostructorTables)
+ , make_ord_flag defGhcFlag "fno-distinct-constructor-tables"
+ (OptPrefix unSetDistinctCostructorTables)
, make_ord_flag defGhcFlag "finfo-table-map"
(NoArg (setGeneralFlag Opt_InfoTableMap))
------ Compiler flags -----------------------------------------------
@@ -3292,6 +3295,22 @@ setCallerCcFilters arg =
Right filt -> upd $ \d -> d { callerCcFilters = filt : callerCcFilters d }
Left err -> addErr err
+setDistinctCostructorTables :: String -> DynP ()
+setDistinctCostructorTables arg = do
+ let cs = parseDistinctConstructorTablesArg arg
+ upd $ \d ->
+ d { distinctConstructorTables =
+ (distinctConstructorTables d) `dctConfigPlus` cs
+ }
+
+unSetDistinctCostructorTables :: String -> DynP ()
+unSetDistinctCostructorTables arg = do
+ let cs = parseDistinctConstructorTablesArg arg
+ upd $ \d ->
+ d { distinctConstructorTables =
+ (distinctConstructorTables d) `dctConfigMinus` cs
+ }
+
setMainIs :: String -> DynP ()
setMainIs arg
| x:_ <- main_fn, isLower x -- The arg looked like "Foo.Bar.baz"
=====================================
compiler/GHC/Iface/Recomp/Flags.hs
=====================================
@@ -68,7 +68,7 @@ fingerprintDynFlags hsc_env this_mod nameio =
map (`gopt` dflags) [Opt_Ticky, Opt_Ticky_Allocd, Opt_Ticky_LNE, Opt_Ticky_Dyn_Thunk, Opt_Ticky_Tag]
-- Other flags which affect code generation
- codegen = map (`gopt` dflags) (EnumSet.toList codeGenFlags)
+ codegen = (map (`gopt` dflags) (EnumSet.toList codeGenFlags), distinctConstructorTables)
flags = ((mainis, safeHs, lang, cpp), (paths, prof, ticky, codegen, debugLevel, callerCcFilters))
=====================================
compiler/GHC/Stg/Debug.hs
=====================================
@@ -1,10 +1,15 @@
-{-# LANGUAGE TupleSections #-}
+{-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE TupleSections #-}
-- This module contains functions which implement
-- the -finfo-table-map and -fdistinct-constructor-tables flags
module GHC.Stg.Debug
( StgDebugOpts(..)
+ , StgDebugDctConfig(..)
+ , dctConfigPlus
+ , dctConfigMinus
, collectDebugInformation
+ , parseDistinctConstructorTablesArg
) where
import GHC.Prelude
@@ -16,12 +21,16 @@ import GHC.Types.Tickish
import GHC.Core.DataCon
import GHC.Types.IPE
import GHC.Unit.Module
-import GHC.Types.Name ( getName, getOccName, occNameFS, nameSrcSpan)
+import GHC.Types.Name ( getName, getOccName, occNameFS, nameSrcSpan, occName, occNameString)
import GHC.Data.FastString
import Control.Monad (when)
import Control.Monad.Trans.Reader
+import Data.Set (Set)
+import qualified Data.Set as Set
import GHC.Utils.Monad.State.Strict
+import GHC.Utils.Binary (Binary)
+import qualified GHC.Utils.Binary as B
import Control.Monad.Trans.Class
import GHC.Types.Unique.Map
import GHC.Types.SrcLoc
@@ -33,9 +42,93 @@ data SpanWithLabel = SpanWithLabel RealSrcSpan LexicalFastString
data StgDebugOpts = StgDebugOpts
{ stgDebug_infoTableMap :: !Bool
- , stgDebug_distinctConstructorTables :: !Bool
+ , stgDebug_distinctConstructorTables :: !StgDebugDctConfig
}
+-- | Configuration describing which constructors should be given distinct info
+-- tables for each usage.
+data StgDebugDctConfig =
+ -- | Create distinct constructor tables for each usage of any data
+ -- constructor.
+ --
+ -- This is the behavior if just @-fdistinct-constructor-tables@ is supplied.
+ All
+
+ -- | Create distinct constructor tables for each usage of only these data
+ -- constructors.
+ --
+ -- This is the behavior if @-fdistinct-constructor-tables=C1,...,CN@ is
+ -- supplied.
+ | Only !(Set String)
+
+ -- | Create distinct constructor tables for each usage of any data
+ -- constructor except these ones.
+ --
+ -- This is the behavior if @-fdistinct-constructor-tables@ and
+ -- @-fno-distinct-constructor-tables=C1,...,CN@ is given.
+ | AllExcept !(Set String)
+
+ -- | Do not create distinct constructor tables for any data constructor.
+ --
+ -- This is the behavior if no @-fdistinct-constructor-tables@ is given (or
+ -- @-fno-distinct-constructor-tables@ is given).
+ | None
+
+-- | Necessary for 'StgDebugDctConfig' to be included in the dynflags
+-- fingerprint
+instance Binary StgDebugDctConfig where
+ put_ bh All = B.putByte bh 0
+ put_ bh (Only cs) = do
+ B.putByte bh 1
+ B.put_ bh cs
+ put_ bh (AllExcept cs) = do
+ B.putByte bh 2
+ B.put_ bh cs
+ put_ bh None = B.putByte bh 3
+
+ get bh = do
+ h <- B.getByte bh
+ case h of
+ 0 -> pure All
+ 1 -> Only <$> B.get bh
+ 2 -> AllExcept <$> B.get bh
+ _ -> pure None
+
+-- | Given a distinct constructor tables configuration and a set of constructor
+-- names that we want to generate distinct info tables for, create a new
+-- configuration which includes those constructors.
+--
+-- 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
+ | otherwise =
+ case (cfg, cs) of
+ (All , _ ) -> All
+ ((Only cs1), cs2) -> Only $ Set.union cs1 cs2
+ ((AllExcept cs1), cs2) -> AllExcept $ Set.difference cs1 cs2
+ (None , cs ) -> 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
+-- new configuration which excludes those constructors.
+--
+-- 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
+ | otherwise =
+ case (cfg, cs) of
+ (All , cs ) -> AllExcept cs
+ ((Only cs1), cs2) -> Only $ Set.difference cs1 cs2
+ ((AllExcept cs1), cs2) -> AllExcept $ Set.union cs1 cs2
+ (None , _ ) -> None
+
+
data R = R { rOpts :: StgDebugOpts, rModLocation :: ModLocation, rSpan :: Maybe SpanWithLabel }
type M a = ReaderT R (State InfoTableProvMap) a
@@ -160,10 +253,11 @@ numberDataCon dc _ | isUnboxedTupleDataCon dc = return NoNumber
numberDataCon dc _ | isUnboxedSumDataCon dc = return NoNumber
numberDataCon dc ts = do
opts <- asks rOpts
- if stgDebug_distinctConstructorTables opts then do
- -- -fdistinct-constructor-tables is enabled. Add an entry to the data
- -- constructor map for this occurence of the data constructor with a unique
- -- number and a src span
+ if shouldMakeDistinctTable opts dc then do
+ -- -fdistinct-constructor-tables is enabled and we do want to make distinct
+ -- tables for this constructor. Add an entry to the data constructor map for
+ -- this occurence of the data constructor with a unique number and a src
+ -- span
env <- lift get
mcc <- asks rSpan
let
@@ -188,7 +282,8 @@ numberDataCon dc ts = do
Nothing -> NoNumber
Just res -> Numbered (fst (NE.head res))
else do
- -- -fdistinct-constructor-tables is not enabled
+ -- -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)
@@ -198,6 +293,37 @@ selectTick = foldl' go Nothing
go _ (SourceNote rss d) = Just (rss, d)
go acc _ = acc
+-- | Parse a string of comma-separated constructor names into a 'Set' of
+-- 'String's with one entry per constructor.
+parseDistinctConstructorTablesArg :: String -> Set String
+parseDistinctConstructorTablesArg =
+ -- Ensure we insert the last constructor name built by the fold, if not
+ -- empty
+ uncurry insertNonEmpty
+ . foldr go ("", Set.empty)
+ where
+ go :: Char -> (String, Set String) -> (String, Set String)
+ go ',' (cur, acc) = ("", Set.insert cur acc)
+ go c (cur, acc) = (c : cur, acc)
+
+ insertNonEmpty :: String -> Set String -> Set String
+ insertNonEmpty "" = id
+ insertNonEmpty cs = Set.insert cs
+
+-- | Descide whether a distinct info table should be made for a usage of a data
+-- constructor. We only want to do this if -fdistinct-constructor-tables was
+-- given and this constructor name was given, or no constructor names were
+-- given.
+shouldMakeDistinctTable :: StgDebugOpts -> DataCon -> Bool
+shouldMakeDistinctTable StgDebugOpts{..} dc =
+ case stgDebug_distinctConstructorTables of
+ All -> True
+ Only these -> Set.member dcStr these
+ AllExcept these -> Set.notMember dcStr these
+ None -> False
+ where
+ dcStr = occNameString . occName $ dataConName dc
+
{-
Note [Mapping Info Tables to Source Positions]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
=====================================
docs/users_guide/9.10.1-notes.rst
=====================================
@@ -9,6 +9,18 @@ Language
Compiler
~~~~~~~~
+- The :ghc-flag:`-fdistinct-constructor-tables
+ <-fdistinct-constructor-tables=⟨cs⟩>` flag may now be provided with a list of
+ constructor names for which distinct info tables should be generated. This
+ avoids the default behavior of generating a distinct info table for *every*
+ usage of *every* constructor, which often results in more information than is
+ desired and significantly increases the size of executables.
+
+- The :ghc-flag:`-fno-distinct-constructor-tables
+ <-fno-distinct-constructor-tables=⟨cs⟩>` flag is introduced, which allows
+ users to refine the set of constructors for which distinct info tables should
+ be generated.
+
GHCi
~~~~
=====================================
docs/users_guide/debug-info.rst
=====================================
@@ -368,7 +368,8 @@ to a source location. This lookup table is generated by using the ``-finfo-table
an info table to an approximate source position of where that
info table statically originated from. If you
also want more precise information about constructor info tables then you
- should also use :ghc-flag:`-fdistinct-constructor-tables`.
+ should also use :ghc-flag:`-fdistinct-constructor-tables
+ <-fdistinct-constructor-tables=⟨cs⟩>`.
The :ghc-flag:`-finfo-table-map` flag will increase the binary size by quite
a lot, depending on how big your project is. For compiling a project the
@@ -391,7 +392,7 @@ to a source location. This lookup table is generated by using the ``-finfo-table
In a test compiling GHC itself, the size of the :ghc-flag:`-finfo-table-map`
enabled build results was reduced by over 20% when compression was enabled.
-.. ghc-flag:: -fdistinct-constructor-tables
+.. ghc-flag:: -fdistinct-constructor-tables=⟨cs⟩
:shortdesc: Generate a fresh info table for each usage
of a data constructor.
:type: dynamic
@@ -405,6 +406,41 @@ to a source location. This lookup table is generated by using the ``-finfo-table
each info table will correspond to the usage of a data constructor rather
than the data constructor itself.
+ :since: 9.10
+
+ The entries in the info table map resulting from this flag may significantly
+ increase the size of executables. However, generating distinct info tables
+ for *every* usage of *every* data constructor often results in more
+ information than necessary. Instead, we would like to generate these
+ distinct tables for some specific constructors. To do this, the names of the
+ constructors we are interested in may be supplied to this flag in a
+ comma-separated list. If no constructor names are supplied (i.e. just
+ ``-fdistinct-constructor-tables`` is given) then fresh info tables will be
+ generated for every usage of every constructor.
+
+ For example, to only generate distinct info tables for the ``Just`` and
+ ``Right`` constructors, use ``-fdistinct-constructor-tables=Just,Right``.
+
+.. ghc-flag:: -fno-distinct-constructor-tables=⟨cs⟩
+ :shortdesc: Avoid generating a fresh info table for each usage of a data
+ constructor.
+ :type: dynamic
+ :category: debugging
+
+ :since: 9.10
+
+ 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⟩>`).
+ 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.
+
+ For example, to generate distinct constructor tables for all data
+ constructors except those named ``MyConstr``, pass both
+ ``-fdistinct-constructor-tables`` and
+ ``-fno-distinct-constructor-tables=MyConstr``.
Querying the Info Table Map
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/be2375db58f739b13b43859a5ee6ff14c1c00bf5
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/be2375db58f739b13b43859a5ee6ff14c1c00bf5
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/20230724/3a7cd3e1/attachment-0001.html>
More information about the ghc-commits
mailing list