[Git][ghc/ghc][master] CmmToAsm: remove unused ModLocation from NatM_State

Marge Bot (@marge-bot) gitlab at gitlab.haskell.org
Wed Sep 7 20:43:39 UTC 2022



Marge Bot pushed to branch master at Glasgow Haskell Compiler / GHC


Commits:
04a738cb by Cheng Shao at 2022-09-07T16:43:22-04:00
CmmToAsm: remove unused ModLocation from NatM_State

- - - - -


3 changed files:

- compiler/GHC/CmmToAsm.hs
- compiler/GHC/CmmToAsm/Monad.hs
- testsuite/tests/regalloc/regalloc_unit_tests.hs


Changes:

=====================================
compiler/GHC/CmmToAsm.hs
=====================================
@@ -331,7 +331,7 @@ cmmNativeGenStream logger config modLoc ncgImpl h us cmm_stream ngs
                   dbgMap = debugToMap ndbgs
 
               -- Generate native code
-              (ngs',us') <- cmmNativeGens logger config modLoc ncgImpl h
+              (ngs',us') <- cmmNativeGens logger config ncgImpl h
                                           dbgMap us cmms ngs 0
 
               -- Link native code information into debug blocks
@@ -355,7 +355,6 @@ cmmNativeGens :: forall statics instr jumpDest.
                  (OutputableP Platform statics, Outputable jumpDest, Instruction instr)
               => Logger
               -> NCGConfig
-              -> ModLocation
               -> NcgImpl statics instr jumpDest
               -> BufHandle
               -> LabelMap DebugBlock
@@ -365,7 +364,7 @@ cmmNativeGens :: forall statics instr jumpDest.
               -> Int
               -> IO (NativeGenAcc statics instr, UniqSupply)
 
-cmmNativeGens logger config modLoc ncgImpl h dbgMap = go
+cmmNativeGens logger config ncgImpl h dbgMap = go
   where
     go :: UniqSupply -> [RawCmmDecl]
        -> NativeGenAcc statics instr -> Int
@@ -378,7 +377,7 @@ cmmNativeGens logger config modLoc ncgImpl h dbgMap = go
         let fileIds = ngs_dwarfFiles ngs
         (us', fileIds', native, imports, colorStats, linearStats, unwinds)
           <- {-# SCC "cmmNativeGen" #-}
-             cmmNativeGen logger modLoc ncgImpl us fileIds dbgMap
+             cmmNativeGen logger ncgImpl us fileIds dbgMap
                           cmm count
 
         -- Generate .file directives for every new file that has been
@@ -432,7 +431,6 @@ emitNativeCode logger config h sdoc = do
 cmmNativeGen
     :: forall statics instr jumpDest. (Instruction instr, OutputableP Platform statics, Outputable jumpDest)
     => Logger
-    -> ModLocation
     -> NcgImpl statics instr jumpDest
         -> UniqSupply
         -> DwarfFiles
@@ -448,7 +446,7 @@ cmmNativeGen
                 , LabelMap [UnwindPoint]                    -- unwinding information for blocks
                 )
 
-cmmNativeGen logger modLoc ncgImpl us fileIds dbgMap cmm count
+cmmNativeGen logger ncgImpl us fileIds dbgMap cmm count
  = do
         let config   = ncgConfig ncgImpl
         let platform = ncgPlatform config
@@ -478,7 +476,7 @@ cmmNativeGen logger modLoc ncgImpl us fileIds dbgMap cmm count
         -- generate native code from cmm
         let ((native, lastMinuteImports, fileIds', nativeCfgWeights), usGen) =
                 {-# SCC "genMachCode" #-}
-                initUs us $ genMachCode config modLoc
+                initUs us $ genMachCode config
                                         (cmmTopCodeGen ncgImpl)
                                         fileIds dbgMap opt_cmm cmmCfg
 
@@ -902,7 +900,6 @@ apply_mapping ncgImpl ufm (CmmProc info lbl live (ListGraph blocks))
 
 genMachCode
         :: NCGConfig
-        -> ModLocation
         -> (RawCmmDecl -> NatM [NatCmmDecl statics instr])
         -> DwarfFiles
         -> LabelMap DebugBlock
@@ -915,10 +912,10 @@ genMachCode
                 , CFG
                 )
 
-genMachCode config modLoc cmmTopCodeGen fileIds dbgMap cmm_top cmm_cfg
+genMachCode config cmmTopCodeGen fileIds dbgMap cmm_top cmm_cfg
   = do  { initial_us <- getUniqueSupplyM
         ; let initial_st           = mkNatM_State initial_us 0 config
-                                                  modLoc fileIds dbgMap cmm_cfg
+                                                  fileIds dbgMap cmm_cfg
               (new_tops, final_st) = initNat initial_st (cmmTopCodeGen cmm_top)
               final_delta          = natm_delta final_st
               final_imports        = natm_imports final_st


=====================================
compiler/GHC/CmmToAsm/Monad.hs
=====================================
@@ -32,7 +32,6 @@ module GHC.CmmToAsm.Monad (
         getPicBaseMaybeNat,
         getPicBaseNat,
         getCfgWeights,
-        getModLoc,
         getFileId,
         getDebugBlock,
 
@@ -111,7 +110,6 @@ data NatM_State
                 natm_imports     :: [(CLabel)],
                 natm_pic         :: Maybe Reg,
                 natm_config      :: NCGConfig,
-                natm_modloc      :: ModLocation,
                 natm_fileid      :: DwarfFiles,
                 natm_debug_map   :: LabelMap DebugBlock,
                 natm_cfg         :: CFG
@@ -128,17 +126,16 @@ newtype NatM result = NatM (NatM_State -> (result, NatM_State))
 unNat :: NatM a -> NatM_State -> (a, NatM_State)
 unNat (NatM a) = a
 
-mkNatM_State :: UniqSupply -> Int -> NCGConfig -> ModLocation ->
+mkNatM_State :: UniqSupply -> Int -> NCGConfig ->
                 DwarfFiles -> LabelMap DebugBlock -> CFG -> NatM_State
 mkNatM_State us delta config
-        = \loc dwf dbg cfg ->
+        = \dwf dbg cfg ->
                 NatM_State
                         { natm_us = us
                         , natm_delta = delta
                         , natm_imports = []
                         , natm_pic = Nothing
                         , natm_config = config
-                        , natm_modloc = loc
                         , natm_fileid = dwf
                         , natm_debug_map = dbg
                         , natm_cfg = cfg
@@ -309,10 +306,6 @@ getPicBaseNat rep
                         reg <- getNewRegNat rep
                         NatM (\state -> (reg, state { natm_pic = Just reg }))
 
-getModLoc :: NatM ModLocation
-getModLoc
-        = NatM $ \ st -> (natm_modloc st, st)
-
 -- | Get native code generator configuration
 getConfig :: NatM NCGConfig
 getConfig = NatM $ \st -> (natm_config st, st)


=====================================
testsuite/tests/regalloc/regalloc_unit_tests.hs
=====================================
@@ -152,7 +152,7 @@ compileCmmForRegAllocStats logger home_unit dflags cmmFile ncgImplF us = do
 
     -- compile and discard the generated code, returning regalloc stats
     mapM (\ (count, thisCmm) ->
-        cmmNativeGen logger thisModLoc ncgImpl
+        cmmNativeGen logger ncgImpl
             usb dwarfFileIds dbgMap thisCmm count >>=
                 (\(_, _, _, _, colorStats, linearStats, _) ->
                 -- scrub unneeded output from cmmNativeGen
@@ -167,7 +167,6 @@ compileCmmForRegAllocStats logger home_unit dflags cmmFile ncgImplF us = do
           thisMod = mkModule
                         (stringToUnit . show . uniqFromSupply $ usc)
                         (mkModuleName . show . uniqFromSupply $ usd)
-          thisModLoc = mkHiOnlyModLocation (initFinderOpts dflags) "hi" "dyn_hi" "" cmmFile
 
 
 -- | The register allocator should be able to see that each variable only



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/04a738cb23e82b32caf38b7965f5042e6af6ee88
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/20220907/743405c0/attachment-0001.html>


More information about the ghc-commits mailing list