Remove platform constant wrappers

Platform constant wrappers took a DynFlags parameter, hence implicitly
used the target platform constants. We removed them to allow support
for several platforms at once (#14335) and to avoid having to pass
the full DynFlags to every function (#17957).

Metric Decrease:
   T4801

1 files changed, 28 insertions, 23 deletions

diff --git a/compiler/GHC/CoreToByteCode.hs b/compiler/GHC/CoreToByteCode.hs
index 40866f7f8b..8ba378521d 100644
--- a/compiler/GHC/CoreToByteCode.hs
+++ b/compiler/GHC/CoreToByteCode.hs
@@ -19,13 +19,15 @@ import GHC.ByteCode.Instr
 import GHC.ByteCode.Asm
 import GHC.ByteCode.Types
 
+import GHC.Platform
+import GHC.Platform.Profile
+
 import GHC.Runtime.Interpreter
 import GHCi.FFI
 import GHCi.RemoteTypes
 import GHC.Types.Basic
 import GHC.Driver.Session
 import GHC.Utils.Outputable
-import GHC.Platform
 import GHC.Types.Name
 import GHC.Types.Id.Make
 import GHC.Types.Id
@@ -241,7 +243,7 @@ ppBCEnv p
 -- Create a BCO and do a spot of peephole optimisation on the insns
 -- at the same time.
 mkProtoBCO
-   :: DynFlags
+   :: Platform
    -> name
    -> BCInstrList
    -> Either  [AnnAlt Id DVarSet] (AnnExpr Id DVarSet)
@@ -252,7 +254,7 @@ mkProtoBCO
    -> Bool      -- True <=> is a return point, rather than a function
    -> [FFIInfo]
    -> ProtoBCO name
-mkProtoBCO dflags nm instrs_ordlist origin arity bitmap_size bitmap is_ret ffis
+mkProtoBCO platform nm instrs_ordlist origin arity bitmap_size bitmap is_ret ffis
    = ProtoBCO {
         protoBCOName = nm,
         protoBCOInstrs = maybe_with_stack_check,
@@ -271,7 +273,7 @@ mkProtoBCO dflags nm instrs_ordlist origin arity bitmap_size bitmap is_ret ffis
         -- (hopefully rare) cases when the (overestimated) stack use
         -- exceeds iNTERP_STACK_CHECK_THRESH.
         maybe_with_stack_check
-           | is_ret && stack_usage < fromIntegral (aP_STACK_SPLIM dflags) = peep_d
+           | is_ret && stack_usage < fromIntegral (pc_AP_STACK_SPLIM (platformConstants platform)) = peep_d
                 -- don't do stack checks at return points,
                 -- everything is aggregated up to the top BCO
                 -- (which must be a function).
@@ -312,7 +314,7 @@ schemeTopBind :: (Id, AnnExpr Id DVarSet) -> BcM (ProtoBCO Name)
 schemeTopBind (id, rhs)
   | Just data_con <- isDataConWorkId_maybe id,
     isNullaryRepDataCon data_con = do
-    dflags <- getDynFlags
+    platform <- profilePlatform <$> getProfile
         -- Special case for the worker of a nullary data con.
         -- It'll look like this:        Nil = /\a -> Nil a
         -- If we feed it into schemeR, we'll get
@@ -321,7 +323,7 @@ schemeTopBind (id, rhs)
         -- by just re-using the single top-level definition.  So
         -- for the worker itself, we must allocate it directly.
     -- ioToBc (putStrLn $ "top level BCO")
-    emitBc (mkProtoBCO dflags (getName id) (toOL [PACK data_con 0, ENTER])
+    emitBc (mkProtoBCO platform (getName id) (toOL [PACK data_con 0, ENTER])
                        (Right rhs) 0 0 [{-no bitmap-}] False{-not alts-})
 
   | otherwise
@@ -380,9 +382,9 @@ schemeR_wrk
     -> BcM (ProtoBCO Name)
 schemeR_wrk fvs nm original_body (args, body)
    = do
-     dflags <- getDynFlags
+     profile <- getProfile
      let
-         platform  = targetPlatform dflags
+         platform  = profilePlatform profile
          all_args  = reverse args ++ fvs
          arity     = length all_args
          -- all_args are the args in reverse order.  We're compiling a function
@@ -401,7 +403,7 @@ schemeR_wrk fvs nm original_body (args, body)
          bitmap = mkBitmap platform bits
      body_code <- schemeER_wrk sum_szsb_args p_init body
 
-     emitBc (mkProtoBCO dflags nm body_code (Right original_body)
+     emitBc (mkProtoBCO platform nm body_code (Right original_body)
                  arity bitmap_size bitmap False{-not alts-})
 
 -- introduce break instructions for ticked expressions
@@ -411,8 +413,7 @@ schemeER_wrk d p rhs
   = do  code <- schemeE d 0 p newRhs
         cc_arr <- getCCArray
         this_mod <- moduleName <$> getCurrentModule
-        dflags <- getDynFlags
-        let platform = targetPlatform dflags
+        platform <- profilePlatform <$> getProfile
         let idOffSets = getVarOffSets platform d p fvs
         let breakInfo = CgBreakInfo
                         { cgb_vars = idOffSets
@@ -879,8 +880,8 @@ mkConAppCode orig_d _ p con args_r_to_l =
     ASSERT( args_r_to_l `lengthIs` dataConRepArity con ) app_code
   where
     app_code = do
-        dflags <- getDynFlags
-        let platform = targetPlatform dflags
+        profile <- getProfile
+        let platform = profilePlatform profile
 
         -- The args are initially in reverse order, but mkVirtHeapOffsets
         -- expects them to be left-to-right.
@@ -891,7 +892,7 @@ mkConAppCode orig_d _ p con args_r_to_l =
                 , not (isVoidRep prim_rep)
                 ]
             (_, _, args_offsets) =
-                mkVirtHeapOffsetsWithPadding dflags StdHeader non_voids
+                mkVirtHeapOffsetsWithPadding profile StdHeader non_voids
 
             do_pushery !d (arg : args) = do
                 (push, arg_bytes) <- case arg of
@@ -1000,10 +1001,11 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple
 
   | otherwise
   = do
-     dflags <- getDynFlags
+     profile <- getProfile
      hsc_env <- getHscEnv
      let
-        platform = targetPlatform dflags
+        platform = profilePlatform profile
+
         profiling
           | Just interp <- hsc_interp hsc_env
           = interpreterProfiled interp
@@ -1064,7 +1066,7 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple
            -- algebraic alt with some binders
            | otherwise =
              let (tot_wds, _ptrs_wds, args_offsets) =
-                     mkVirtHeapOffsets dflags NoHeader
+                     mkVirtHeapOffsets profile NoHeader
                          [ NonVoid (bcIdPrimRep id, id)
                          | NonVoid id <- nonVoidIds real_bndrs
                          ]
@@ -1139,7 +1141,7 @@ doCase d s p (_,scrut) bndr alts is_unboxed_tuple
 
      let
          alt_bco_name = getName bndr
-         alt_bco = mkProtoBCO dflags alt_bco_name alt_final (Left alts)
+         alt_bco = mkProtoBCO platform alt_bco_name alt_final (Left alts)
                        0{-no arity-} bitmap_size bitmap True{-is alts-}
 --     trace ("case: bndr = " ++ showSDocDebug (ppr bndr) ++ "\ndepth = " ++ show d ++ "\nenv = \n" ++ showSDocDebug (ppBCEnv p) ++
 --            "\n      bitmap = " ++ show bitmap) $ do
@@ -1173,10 +1175,10 @@ generateCCall
     -> BcM BCInstrList
 generateCCall d0 s p (CCallSpec target cconv safety) fn args_r_to_l
  = do
-     dflags <- getDynFlags
+     profile <- getProfile
 
      let
-         platform = targetPlatform dflags
+         platform = profilePlatform profile
          -- useful constants
          addr_size_b :: ByteOff
          addr_size_b = wordSize platform
@@ -1198,17 +1200,17 @@ generateCCall d0 s p (CCallSpec target cconv safety) fn args_r_to_l
                     Just t
                      | t == arrayPrimTyCon || t == mutableArrayPrimTyCon
                        -> do rest <- pargs (d + addr_size_b) az
-                             code <- parg_ArrayishRep (fromIntegral (arrPtrsHdrSize dflags)) d p a
+                             code <- parg_ArrayishRep (fromIntegral (arrPtrsHdrSize profile)) d p a
                              return ((code,AddrRep):rest)
 
                      | t == smallArrayPrimTyCon || t == smallMutableArrayPrimTyCon
                        -> do rest <- pargs (d + addr_size_b) az
-                             code <- parg_ArrayishRep (fromIntegral (smallArrPtrsHdrSize dflags)) d p a
+                             code <- parg_ArrayishRep (fromIntegral (smallArrPtrsHdrSize profile)) d p a
                              return ((code,AddrRep):rest)
 
                      | t == byteArrayPrimTyCon || t == mutableByteArrayPrimTyCon
                        -> do rest <- pargs (d + addr_size_b) az
-                             code <- parg_ArrayishRep (fromIntegral (arrWordsHdrSize dflags)) d p a
+                             code <- parg_ArrayishRep (fromIntegral (arrWordsHdrSize profile)) d p a
                              return ((code,AddrRep):rest)
 
                     -- Default case: push taggedly, but otherwise intact.
@@ -2016,6 +2018,9 @@ instance HasDynFlags BcM where
 getHscEnv :: BcM HscEnv
 getHscEnv = BcM $ \st -> return (st, bcm_hsc_env st)
 
+getProfile :: BcM Profile
+getProfile = targetProfile <$> getDynFlags
+
 emitBc :: ([FFIInfo] -> ProtoBCO Name) -> BcM (ProtoBCO Name)
 emitBc bco
   = BcM $ \st -> return (st{ffis=[]}, bco (ffis st))