StgToCmm.cgTopBinding: no isNCG, use binBlobThresh

This is a one line change. It is a fixup from MR!7325, was pointed out
in review of MR!7442, specifically: https://gitlab.haskell.org/ghc/ghc/-/merge_requests/7442#note_406581

The change removes isNCG check from cgTopBinding. Instead it changes the
type of binBlobThresh in DynFlags from Word to Maybe Word, where a Just
0 or a Nothing indicates an infinite threshold and thus the disable
CmmFileEmbed case in the original check.

This improves the cohesion of the module because more NCG related
Backend stuff is moved into, and checked in, StgToCmm.Config. Note, that
the meaning of a Just 0 or a Nothing in binBlobThresh is indicated in a
comment next to its field in GHC.StgToCmm.Config.

DynFlags: binBlobThresh: Word -> Maybe Word

StgToCmm.Config: binBlobThesh add not ncg check

DynFlags.binBlob: move Just 0 check to dflags init

StgToCmm.binBlob: only check isNCG, Just 0 check to dflags

StgToCmm.Config: strictify binBlobThresh

4 files changed, 22 insertions, 16 deletions

diff --git a/compiler/GHC/Driver/Config/StgToCmm.hs b/compiler/GHC/Driver/Config/StgToCmm.hs
index 9896fed3bc..1b05884bb7 100644
--- a/compiler/GHC/Driver/Config/StgToCmm.hs
+++ b/compiler/GHC/Driver/Config/StgToCmm.hs
@@ -22,7 +22,7 @@ initStgToCmmConfig dflags mod = StgToCmmConfig
   , stgToCmmTmpDir        = tmpDir          dflags
   , stgToCmmContext       = initSDocContext dflags defaultDumpStyle
   , stgToCmmDebugLevel    = debugLevel      dflags
-  , stgToCmmBinBlobThresh = binBlobThreshold               dflags
+  , stgToCmmBinBlobThresh = b_blob
   , stgToCmmMaxInlAllocSize = maxInlineAllocSize           dflags
   -- ticky options
   , stgToCmmDoTicky       = gopt Opt_Ticky                 dflags
@@ -63,6 +63,7 @@ initStgToCmmConfig dflags mod = StgToCmmConfig
           bk_end  = backend dflags
           ncg     = bk_end == NCG
           llvm    = bk_end == LLVM
+          b_blob  = if not ncg then Nothing else binBlobThreshold dflags
           x86ish  = case platformArch platform of
                       ArchX86    -> True
                       ArchX86_64 -> True
diff --git a/compiler/GHC/Driver/Session.hs b/compiler/GHC/Driver/Session.hs
index d4d41accf6..f75a5e0d92 100644
--- a/compiler/GHC/Driver/Session.hs
+++ b/compiler/GHC/Driver/Session.hs
@@ -488,9 +488,10 @@ data DynFlags = DynFlags {
   specConstrCount       :: Maybe Int,   -- ^ Max number of specialisations for any one function
   specConstrRecursive   :: Int,         -- ^ Max number of specialisations for recursive types
                                         --   Not optional; otherwise ForceSpecConstr can diverge.
-  binBlobThreshold      :: Word,        -- ^ Binary literals (e.g. strings) whose size is above
+  binBlobThreshold      :: Maybe Word,  -- ^ Binary literals (e.g. strings) whose size is above
                                         --   this threshold will be dumped in a binary file
-                                        --   by the assembler code generator (0 to disable)
+                                        --   by the assembler code generator. 0 and Nothing disables
+                                        --   this feature. See 'GHC.StgToCmm.Config'.
   liberateCaseThreshold :: Maybe Int,   -- ^ Threshold for LiberateCase
   floatLamArgs          :: Maybe Int,   -- ^ Arg count for lambda floating
                                         --   See 'GHC.Core.Opt.Monad.FloatOutSwitches'
@@ -1122,7 +1123,7 @@ defaultDynFlags mySettings llvmConfig =
         simplPhases             = 2,
         maxSimplIterations      = 4,
         ruleCheck               = Nothing,
-        binBlobThreshold        = 500000, -- 500K is a good default (see #16190)
+        binBlobThreshold        = Just 500000, -- 500K is a good default (see #16190)
         maxRelevantBinds        = Just 6,
         maxValidHoleFits   = Just 6,
         maxRefHoleFits     = Just 6,
@@ -2699,8 +2700,9 @@ dynamic_flags_deps = [
                 -- If the number is missing, use 1
 
   , make_ord_flag defFlag "fbinary-blob-threshold"
-      (intSuffix (\n d -> d { binBlobThreshold = fromIntegral n }))
-
+      (intSuffix (\n d -> d { binBlobThreshold = case fromIntegral n of
+                                                    0 -> Nothing
+                                                    x -> Just x}))
   , make_ord_flag defFlag "fmax-relevant-binds"
       (intSuffix (\n d -> d { maxRelevantBinds = Just n }))
   , make_ord_flag defFlag "fno-max-relevant-binds"
diff --git a/compiler/GHC/StgToCmm.hs b/compiler/GHC/StgToCmm.hs
index 3075182af6..21a037aeee 100644
--- a/compiler/GHC/StgToCmm.hs
+++ b/compiler/GHC/StgToCmm.hs
@@ -15,8 +15,6 @@ module GHC.StgToCmm ( codeGen ) where
 
 import GHC.Prelude as Prelude
 
-import GHC.Driver.Backend
-
 import GHC.StgToCmm.Prof (initCostCentres, ldvEnter)
 import GHC.StgToCmm.Monad
 import GHC.StgToCmm.Env
@@ -183,12 +181,11 @@ cgTopBinding logger tmpfs cfg = \case
         -- emit either a CmmString literal or dump the string in a file and emit a
         -- CmmFileEmbed literal.
         -- See Note [Embedding large binary blobs] in GHC.CmmToAsm.Ppr
-        let bin_blob_threshold = stgToCmmBinBlobThresh cfg
-            isNCG    = platformDefaultBackend (stgToCmmPlatform cfg) == NCG
-            isSmall  = fromIntegral (BS.length str) <= bin_blob_threshold
-            asString = bin_blob_threshold == 0 || isSmall
+        let asString = case stgToCmmBinBlobThresh cfg of
+              Just bin_blob_threshold -> fromIntegral (BS.length str) <= bin_blob_threshold
+              Nothing                -> True
 
-            (lit,decl) = if not isNCG || asString
+            (lit,decl) = if asString
               then mkByteStringCLit label str
               else mkFileEmbedLit label $ unsafePerformIO $ do
                      bFile <- newTempName logger tmpfs (stgToCmmTmpDir cfg) TFL_CurrentModule ".dat"
diff --git a/compiler/GHC/StgToCmm/Config.hs b/compiler/GHC/StgToCmm/Config.hs
index b3014fd302..d73dd753e6 100644
--- a/compiler/GHC/StgToCmm/Config.hs
+++ b/compiler/GHC/StgToCmm/Config.hs
@@ -23,9 +23,15 @@ data StgToCmmConfig = StgToCmmConfig
   , stgToCmmTmpDir        :: !TempDir            -- ^ Temp Dir for files used in compilation
   , stgToCmmContext       :: !SDocContext        -- ^ Context for StgToCmm phase
   , stgToCmmDebugLevel    :: !Int                -- ^ The verbosity of debug messages
-  , stgToCmmBinBlobThresh :: !Word               -- ^ Binary literals (e.g. strings) whose size is above this
-                                                 -- threshold will be dumped in a binary file by the assembler
-                                                 -- code generator (0 to disable)
+  , stgToCmmBinBlobThresh :: !(Maybe Word)        -- ^ Threshold at which Binary literals (e.g. strings)
+                                                 -- are either dumped to a file and a CmmFileEmbed literal
+                                                 -- is emitted (over threshold), or become a CmmString
+                                                 -- Literal (under or at threshold). CmmFileEmbed is only supported
+                                                 -- with the NCG, thus a Just means two things: We have a threshold,
+                                                 -- and will be using the NCG. Conversely, a Nothing implies we are not
+                                                 -- using NCG and disables CmmFileEmbed. See Note
+                                                 -- [Embedding large binary blobs] in GHC.CmmToAsm.Ppr, and
+                                                 -- @cgTopBinding@ in GHC.StgToCmm.
   , stgToCmmMaxInlAllocSize :: !Int              -- ^ Max size, in bytes, of inline array allocations.
   ------------------------------ Ticky Options ----------------------------------
   , stgToCmmDoTicky        :: !Bool              -- ^ Ticky profiling enabled (cf @-ticky@)