Fix #6961 Add stack build --info-table-profiling

.stan.toml

@@ -138,17 +138,6 @@
   scope = "all"
   type = "Exclude"
 
-# Anti-pattern: Data.ByteString.Char8.pack
-[[ignore]]
-  id = "OBS-STAN-0203-EmXRiW-573:17"
-# ✦ Description:   Usage of 'pack' function that doesn't handle Unicode characters
-# ✦ Category:      #AntiPattern
-# ✦ File:          src/Stack/Build/Backpack.hs
-#
-#   572 ┃
-#   573 ┃         input = S8.pack (L.intercalate "," sorted)
-#   574 ┃                 ^^^^^^^
-
 # Anti-pattern: Data.ByteString.Char8.pack
 [[ignore]]
   id = "OBS-STAN-0203-erw24B-1150:3"
@@ -204,17 +193,6 @@
 #  351 ┃   hashRepoName = Hash.hash . BS.pack . takeWhile (\c -> c /= ':' && c /= '@')
 #  352 ┃                              ^^^^^^^
 
-# Anti-pattern: Slow 'nub' for lists
-[[ignore]]
-  id = "OBS-STAN-0209-EmXRiW-328:19"
-# ✦ Description:   Usage of 'nub' on lists that runs in quadratic time
-# ✦ Category:      #AntiPattern
-# ✦ File:          src/Stack/Build/Backpack.hs
-#
-#   327 ┃
-#   328 ┃                   L.nub $ collectInheritedSigs sigPkg adrMap' Set.empty
-#   329 ┃                   ^^^^^
-
 # Data types with non-strict fields
 # Defining lazy fields in data types can lead to unexpected space leaks
 # Stack uses lazy fields in many places
@@ -280,36 +258,36 @@
 
 # Anti-pattern: unsafe functions
 [[ignore]]
-  id = "OBS-STAN-0212-FNS1cF-68:17"
+  id = "OBS-STAN-0212-FNS1cF-69:17"
 # ✦ Description:   Usage of unsafe functions breaks referential transparency
 # ✦ Category:      #Unsafe #AntiPattern
 # ✦ File:          src\Stack\BuildOpts.hs
 #
-#   67 ┃
-#   68 ┃   buildMonoid = undefined :: BuildOptsMonoid
-#   69 ┃                 ^^^^^^^^^
+#   68 ┃
+#   69 ┃   buildMonoid = undefined :: BuildOptsMonoid
+#   70 ┃                 ^^^^^^^^^
 
 # Anti-pattern: unsafe functions
 [[ignore]]
-  id = "OBS-STAN-0212-FNS1cF-81:14"
+  id = "OBS-STAN-0212-FNS1cF-82:14"
 # ✦ Description:   Usage of unsafe functions breaks referential transparency
 # ✦ Category:      #Unsafe #AntiPattern
 # ✦ File:          src\Stack\BuildOpts.hs
 #
-#   79 ┃
-#   80 ┃   toMonoid = undefined :: TestOptsMonoid
-#   81 ┃              ^^^^^^^^^
+#   81 ┃
+#   82 ┃   toMonoid = undefined :: TestOptsMonoid
+#   83 ┃              ^^^^^^^^^
 
 # Anti-pattern: unsafe functions
 [[ignore]]
-  id = "OBS-STAN-0212-FNS1cF-92:15"
+  id = "OBS-STAN-0212-FNS1cF-93:15"
 # ✦ Description:   Usage of unsafe functions breaks referential transparency
 # ✦ Category:      #Unsafe #AntiPattern
 # ✦ File:          src/Stack/BuildOpts.hs
 #
-#   90 ┃
-#   91 ┃   beoMonoid = undefined :: BenchmarkOptsMonoid
-#   92 ┃               ^^^^^^^^^
+#   92 ┃
+#   93 ┃   beoMonoid = undefined :: BenchmarkOptsMonoid
+#   94 ┃               ^^^^^^^^^
 
 # Anti-pattern: Pattern matching on '_'
 # Pattern matching on '_' for sum types can create maintainability issues

ChangeLog.md

@@ -14,6 +14,10 @@ Other enhancements:
 
 * Consider Cabal 3.18 to be a tested library and remove warnings.
 * Consider GHC 10.0 to be a tested compiler and remove warnings.
+* Add flag `--[no-]info-table-profiling` (default: disabled) to Stack's
+  `build` command. Set the flag to enable info table profiling, including the
+  creation of a new info table for every use of a data constructor in the source
+  program.
 
 Bug fixes:
 

doc/commands/bench_command.md

@@ -10,8 +10,9 @@ stack bench [TARGET] [--dry-run] [--pedantic] [--fast] [--ghc-options OPTIONS]
             [--only-configure] [--trace] [--profile] [--no-strip]
             [--[no-]library-profiling] [--[no-]executable-profiling]
             [--[no-]library-stripping] [--[no-]executable-stripping]
-            [--[no-]haddock] [--haddock-arguments HADDOCK_ARGS]
-            [--[no-]open] [--[no-]haddock-deps] [--[no-]haddock-internal]
+            [--[no-]info-table-profiling] [--[no-]haddock]
+            [--haddock-arguments HADDOCK_ARGS] [--[no-]open]
+            [--[no-]haddock-deps] [--[no-]haddock-internal]
             [--[no-]haddock-hyperlink-source] [--[no-]haddock-for-hackage]
             [--[no-]copy-bins] [--[no-]copy-compiler-tool] [--[no-]prefetch]
             [--[no-]keep-going] [--[no-]keep-tmp-files] [--[no-]force-dirty]

doc/commands/build_command.md

@@ -10,8 +10,8 @@ stack build [TARGET] [--dry-run] [--pedantic] [--fast] [--ghc-options OPTIONS]
             [--only-configure] [--[no-]semaphore] [--trace] [--profile]
             [--no-strip] [--[no-]library-profiling]
             [--[no-]executable-profiling] [--[no-]library-stripping]
-            [--[no-]executable-stripping] [--[no-]haddock]
-            [--haddock-arguments HADDOCK_ARGS] [--[no-]open]
+            [--[no-]executable-stripping] [--[no-]info-table-profiling]
+            [--[no-]haddock] [--haddock-arguments HADDOCK_ARGS] [--[no-]open]
             [--[no-]haddock-deps] [--[no-]haddock-internal]
             [--[no-]haddock-hyperlink-source] [--[no-]haddock-for-hackage]
             [--[no-]copy-bins] [--[no-]copy-compiler-tool] [--[no-]prefetch]
@@ -933,6 +933,18 @@ right. Later options can override the effect of earlier ones. Any GHC command
 line options for a package specified at Stack's command line are applied after
 those specified in Stack's configuration files.
 
+### `--[no-]info-table-profiling` flag
+
+:octicons-tag-24: UNRELEASED
+
+Default: Disabled
+
+Set the flag to enable info table profiling, including the creation of a new
+info table for every use of a data constructor in the source program.
+
+The flag affects the location of the local project installation directory. See
+the [`stack path --local-install-root`](path_command.md) command.
+
 ### `--[no-]library-profiling` flag
 
 Default: Disabled

doc/commands/haddock_command.md

@@ -10,8 +10,9 @@ stack haddock [TARGET] [--dry-run] [--pedantic] [--fast] [--ghc-options OPTIONS]
               [--only-configure] [--trace] [--profile] [--no-strip]
               [--[no-]library-profiling] [--[no-]executable-profiling]
               [--[no-]library-stripping] [--[no-]executable-stripping]
-              [--[no-]haddock] [--haddock-arguments HADDOCK_ARGS]
-              [--[no-]open] [--[no-]haddock-deps] [--[no-]haddock-internal]
+              [--[no-]info-table-profiling] [--[no-]haddock]
+              [--haddock-arguments HADDOCK_ARGS] [--[no-]open]
+              [--[no-]haddock-deps] [--[no-]haddock-internal]
               [--[no-]haddock-hyperlink-source] [--[no-]haddock-for-hackage]
               [--[no-]copy-bins] [--[no-]copy-compiler-tool] [--[no-]prefetch]
               [--[no-]keep-going] [--[no-]keep-tmp-files] [--[no-]force-dirty]

doc/commands/test_command.md

@@ -10,8 +10,9 @@ stack test [TARGET] [--dry-run] [--pedantic] [--fast] [--ghc-options OPTIONS]
             [--only-configure] [--trace] [--profile] [--no-strip]
             [--[no-]library-profiling] [--[no-]executable-profiling]
             [--[no-]library-stripping] [--[no-]executable-stripping]
-            [--[no-]haddock] [--haddock-arguments HADDOCK_ARGS]
-            [--[no-]open] [--[no-]haddock-deps] [--[no-]haddock-internal]
+            [--[no-]info-table-profiling] [--[no-]haddock]
+            [--haddock-arguments HADDOCK_ARGS] [--[no-]open]
+            [--[no-]haddock-deps] [--[no-]haddock-internal]
             [--[no-]haddock-hyperlink-source] [--[no-]haddock-for-hackage]
             [--[no-]copy-bins] [--[no-]copy-compiler-tool] [--[no-]prefetch]
             [--[no-]keep-going] [--[no-]keep-tmp-files] [--[no-]force-dirty]

doc/configure/yaml/non-project.md

@@ -174,6 +174,8 @@ build:
   executable-profiling: false
   library-stripping: true
   executable-stripping: true
+  # Since Stack UNRELEASED:
+  info-table-profiling: false
 
   # NOTE: global usage of haddock can cause build failures when documentation is
   # incorrectly formatted. This could also affect scripts which use Stack.

src/Stack/Build/Source.hs

@@ -28,6 +28,7 @@ import qualified Data.Map.Merge.Lazy as Map
 import qualified Data.Map.Strict as M
 import qualified Data.Set as Set
 import qualified Distribution.PackageDescription as C
+import           Distribution.Version ( mkVersion )
 import qualified Pantry.SHA256 as SHA256
 import           Stack.Build.Cache ( tryGetBuildCache )
 import           Stack.Build.Haddock ( shouldHaddockDeps )
@@ -53,6 +54,7 @@ import           Stack.Types.BuildOptsCLI
                    )
 import           Stack.Types.CabalConfigKey ( CabalConfigKey (..) )
 import           Stack.Types.Cache ( FileCache, FileCacheInfo (..) )
+import           Stack.Types.Compiler ( getGhcVersion )
 import           Stack.Types.CompilerPaths ( HasCompiler, getCompilerPath )
 import           Stack.Types.Config ( Config (..), HasConfig (..), buildOptsL )
 import           Stack.Types.Curator ( Curator (..) )
@@ -108,15 +110,31 @@ loadSourceMap ::
   -> RIO env SourceMap
 loadSourceMap targets boptsCli sma = do
   logDebug "Applying and checking flags"
+  bconfig <- view buildConfigL
   let errsPackages = mapMaybe checkPackage packagesWithCliFlags
-  eProject <- mapM applyOptsFlagsPP (M.toList sma.project)
-  eDeps <- mapM applyOptsFlagsDep (M.toList targetsAndSmaDeps)
+      compiler = sma.compiler
+      ghcVersion = getGhcVersion compiler
+      buildOpts = bconfig.config.build
+      infoTableProfSupported = ghcVersion >= mkVersion [9, 2, 1]
+      infoTableProfUnsupportedWarning =
+            prettyWarnL
+              [ "The"
+              , style Shell "--info-table-profiling"
+              , flow "flag was specified, which is supported by GHC 9.2.1 or \
+                     \later. GHC version"
+              , fromString (versionString ghcVersion)
+              , flow "was found. The flag will be ignored."
+              ]
+  isInfoTableProf <- if infoTableProfSupported
+    then pure buildOpts.infoTableProf
+    else infoTableProfUnsupportedWarning >> pure False
+  eProject <- mapM (applyOptsFlagsPP isInfoTableProf) (M.toList sma.project)
+  eDeps <- mapM (applyOptsFlagsDep isInfoTableProf) (M.toList targetsAndSmaDeps)
   let (errsProject, project') = partitionEithers eProject
       (errsDeps, deps') = partitionEithers eDeps
       errs = errsPackages <> errsProject <> errsDeps
   unless (null errs) $ prettyThrowM $ InvalidFlagSpecification errs
-  let compiler = sma.compiler
-      project = M.fromList project'
+  let project = M.fromList project'
       deps = M.fromList deps'
       globalPkgs = pruneGlobals sma.globals (Map.keysSet deps)
   logDebug "SourceMap constructed"
@@ -144,25 +162,30 @@ loadSourceMap targets boptsCli sma = do
           (const Nothing)
            maybeCommon
   applyOptsFlagsPP ::
-       (a, ProjectPackage)
+       Bool
+    -> (a, ProjectPackage)
     -> RIO env (Either UnusedFlags (a, ProjectPackage))
-  applyOptsFlagsPP (name, p@ProjectPackage{ projectCommon = common }) = do
-    let isTarget = M.member common.name targets.targets
-    eCommon <- applyOptsFlags isTarget True common
-    pure $ (\common' -> (name, p { projectCommon = common' })) <$> eCommon
+  applyOptsFlagsPP
+    isInfoTableProf (name, p@ProjectPackage{ projectCommon = common }) = do
+      let isTarget = M.member common.name targets.targets
+      eCommon <- applyOptsFlags isInfoTableProf isTarget True common
+      pure $ (\common' -> (name, p { projectCommon = common' })) <$> eCommon
   applyOptsFlagsDep ::
-       (a, DepPackage)
+       Bool
+    -> (a, DepPackage)
     -> RIO env (Either UnusedFlags (a, DepPackage))
-  applyOptsFlagsDep (name, d@DepPackage{ depCommon = common }) = do
-    let isTarget = M.member common.name targets.deps
-    eCommon <- applyOptsFlags isTarget False common
-    pure $ (\common' -> (name, d { depCommon = common' })) <$> eCommon
+  applyOptsFlagsDep
+    isInfoTableProf (name, d@DepPackage{ depCommon = common }) = do
+      let isTarget = M.member common.name targets.deps
+      eCommon <- applyOptsFlags isInfoTableProf isTarget False common
+      pure $ (\common' -> (name, d { depCommon = common' })) <$> eCommon
   applyOptsFlags ::
        Bool
     -> Bool
+    -> Bool
     -> CommonPackage
     -> RIO env (Either UnusedFlags CommonPackage)
-  applyOptsFlags isTarget isProjectPackage common = do
+  applyOptsFlags isInfoTableProf isTarget isProjectPackage common = do
     let name = common.name
         cliFlagsByName = Map.findWithDefault Map.empty (ACFByName name) cliFlags
         cliFlagsAll =
@@ -186,8 +209,12 @@ loadSourceMap targets boptsCli sma = do
       then do
         bconfig <- view buildConfigL
         let bopts = bconfig.config.build
-            ghcOptions =
-              generalGhcOptions bconfig boptsCli isTarget isProjectPackage
+            ghcOptions = generalGhcOptions
+              bconfig
+              boptsCli
+              isTarget
+              isProjectPackage
+              isInfoTableProf
             cabalConfigOpts = generalCabalConfigOpts
               bconfig
               boptsCli
@@ -245,7 +272,11 @@ hashSourceMapData boptsCli sm = do
       -- boot packages so we'll have different hashes when bare snapshot
       -- 'ghc-X.Y.Z' is used, no extra-deps and e.g. user wants builds with
       -- profiling or without
-      bootGhcOpts = map display (generalGhcOptions bc boptsCli False False)
+      ghcVersion = getGhcVersion sm.compiler
+      isInfoTableProf =
+        ghcVersion >= mkVersion [9, 2, 1] && bc.config.build.infoTableProf
+      bootGhcOpts =
+        map display (generalGhcOptions bc boptsCli False False isInfoTableProf)
       hashedContent =
            toLazyByteString $ compilerPath
         <> compilerInfo
@@ -303,8 +334,14 @@ generalCabalConfigOpts bconfig boptsCli name isTarget isLocal = concat
 
 -- | Get the configured options to pass from GHC, based on the build
 -- configuration and commandline.
-generalGhcOptions :: BuildConfig -> BuildOptsCLI -> Bool -> Bool -> [Text]
-generalGhcOptions bconfig boptsCli isTarget isLocal = concat
+generalGhcOptions ::
+     BuildConfig
+  -> BuildOptsCLI
+  -> Bool
+  -> Bool
+  -> Bool
+  -> [Text]
+generalGhcOptions bconfig boptsCli isTarget isLocal isInfoTableProf = concat
   [ Map.findWithDefault [] AGOEverything config.ghcOptionsByCat
   , if isLocal
       then Map.findWithDefault [] AGOLocals config.ghcOptionsByCat
@@ -317,6 +354,9 @@ generalGhcOptions bconfig boptsCli isTarget isLocal = concat
       then ["-fprof-auto", "-fprof-cafs"]
       else []
   , [ "-g" | not $ bopts.libStrip || bopts.exeStrip ]
+  , if isInfoTableProf
+      then ["-finfo-table-map", "-fdistinct-constructor-tables"]
+      else []
   , if includeExtraOptions
       then boptsCli.ghcOptions
       else []

src/Stack/BuildOpts.hs

@@ -35,6 +35,7 @@ defaultBuildOpts = BuildOpts
   , exeProfile = defaultFirstFalse buildMonoid.exeProfile
   , libStrip = defaultFirstTrue buildMonoid.libStrip
   , exeStrip = defaultFirstTrue buildMonoid.exeStrip
+  , infoTableProf = defaultFirstFalse buildMonoid.infoTableProf
   , buildHaddocks = False
   , haddockOpts = defaultHaddockOpts
   , openHaddocks = defaultFirstFalse buildMonoid.openHaddocks

src/Stack/Config/Build.hs

@@ -53,6 +53,7 @@ buildOptsFromMonoid buildMonoid = BuildOpts
       (  buildMonoid.exeStrip
       <> FirstTrue (if noStripping then Just False else Nothing)
       )
+  , infoTableProf = fromFirstFalse buildMonoid.infoTableProf
   , buildHaddocks = fromFirstFalse buildMonoid.buildHaddocks
   , haddockOpts = haddockOptsFromMonoid buildMonoid.haddockOpts
   , openHaddocks =

src/Stack/Options/BuildMonoidParser.hs

@@ -44,6 +44,7 @@ buildOptsMonoidParser hide0 = BuildOptsMonoid
   <*> exeProfiling
   <*> libStripping
   <*> exeStripping
+  <*> infoTableProfiling
   <*> haddock
   <*> haddockOptsParser hideBool
   <*> openHaddocks
@@ -131,6 +132,11 @@ buildOptsMonoidParser hide0 = BuildOptsMonoid
     "executable-stripping"
     "executable stripping for TARGETs and all its dependencies."
     hide
+  infoTableProfiling = firstBoolFlagsFalse
+    "info-table-profiling"
+    "info table profiling, including the creation of a new info table for \
+    \every use of a data constructor in the source program."
+    hide
   haddock = firstBoolFlagsFalse
     "haddock"
     "generating Haddock documentation for the package(s) in this \

src/Stack/Types/BuildOpts.hs

@@ -33,6 +33,8 @@ data BuildOpts = BuildOpts
   , exeProfile :: !Bool
   , libStrip :: !Bool
   , exeStrip :: !Bool
+  , infoTableProf :: !Bool
+    -- ^ Build with info table profiling?
   , buildHaddocks :: !Bool
     -- ^ Build Haddock documentation?
   , haddockOpts :: !HaddockOpts