[Git][ghc/ghc][wip/romes/12935] 3 commits: Try ALSO after SRT
Rodrigo Mesquita (@alt-romes)
gitlab at gitlab.haskell.org
Fri Jun 21 13:37:56 UTC 2024
Rodrigo Mesquita pushed to branch wip/romes/12935 at Glasgow Haskell Compiler / GHC
Commits:
c5dd7b42 by Rodrigo Mesquita at 2024-06-20T11:58:26+01:00
Try ALSO after SRT
- - - - -
1d77a6f6 by Rodrigo Mesquita at 2024-06-20T11:58:36+01:00
Revert "Try ALSO after SRT"
This reverts commit c5dd7b426cde768126402aac3f39617ccb99f5c5.
- - - - -
82b39d63 by Rodrigo Mesquita at 2024-06-21T14:37:45+01:00
Renaming before and after SRTs bc of procs and srts and ...
- - - - -
3 changed files:
- compiler/GHC/Cmm/Info/Build.hs
- compiler/GHC/Cmm/Pipeline.hs
- compiler/GHC/Cmm/UniqueRenamer.hs
Changes:
=====================================
compiler/GHC/Cmm/Info/Build.hs
=====================================
@@ -9,6 +9,10 @@ module GHC.Cmm.Info.Build
( CAFSet, CAFEnv, cafAnal, cafAnalData
, doSRTs, ModuleSRTInfo (..), emptySRT
, SRTMap, srtMapNonCAFs
+
+ -- * Some internal bits
+ , SRTEntry(..)
+ , CAFfyLabel(..)
) where
import GHC.Prelude hiding (succ)
=====================================
compiler/GHC/Cmm/Pipeline.hs
=====================================
@@ -47,7 +47,7 @@ cmmPipeline
-> CmmGroup -- Input C-- with Procedures
-> IO (ModuleSRTInfo, (DetUniqFM, CmmGroupSRTs)) -- Output CPS transformed C--
-cmmPipeline logger cmm_config srtInfo detRnEnv prog = do
+cmmPipeline logger cmm_config srtInfo detRnEnv0 prog = do
let forceRes (info, group) = info `seq` foldr seq () group
let platform = cmmPlatform cmm_config
withTimingSilent logger (text "Cmm pipeline") forceRes $ do
@@ -57,13 +57,21 @@ cmmPipeline logger cmm_config srtInfo detRnEnv prog = do
-- For example, the fix-up action in the ASM NCG should use determinist names for potential new blocks it has to create.
-- Therefore, in the ASM NCG `NatM` Monad we use a deterministic `UniqSuply` (which won't be shared about multiple threads)
-- TODO: Put these all into notes carefully organized
- let (rn_mapping, renamed_prog) = detRenameUniques detRnEnv prog -- TODO: if gopt Opt_DeterministicObjects dflags
+ let (detRnEnv1, renamed_prog) = detRenameUniques detRnEnv0 prog -- TODO: if gopt Opt_DeterministicObjects dflags
(procs, data_) <- {-# SCC "tops" #-} partitionWithM (cpsTop logger platform cmm_config) renamed_prog
+ -- We also have to rename `data_` since it is not fully determined from
+ -- the renamed CLabels in renamed_prog.
+ -- We may also generate new names in procs, so rename that too.
+ -- We need to do this before SRT generation because otherwise we may look
+ -- at the "old names" within the body of the function we are generating SRTs for.
+ -- Easy easy: rename before and after.
(srtInfo, cmms) <- {-# SCC "doSRTs" #-} doSRTs cmm_config srtInfo procs data_
- dumpWith logger Opt_D_dump_cmm_cps "Post CPS Cmm" FormatCMM (pdoc platform cmms)
+ -- Easy easy: here we go.
+ let (detRnEnv2, (srtInfo_renamed, cmms_renamed)) = detRenameUniques detRnEnv1 (srtInfo, cmms)
+ dumpWith logger Opt_D_dump_cmm_cps "Post CPS Cmm (uniq-renamed)" FormatCMM (pdoc platform cmms_renamed)
- return (srtInfo, (rn_mapping, cmms))
+ return (srtInfo_renamed, (detRnEnv2, cmms_renamed))
-- | The Cmm pipeline for a single 'CmmDecl'. Returns:
=====================================
compiler/GHC/Cmm/UniqueRenamer.hs
=====================================
@@ -15,10 +15,13 @@ import GHC.Cmm.Dataflow.Block
import GHC.Cmm.Dataflow.Graph
import GHC.Cmm.Dataflow.Label
import GHC.Cmm.Switch
+import GHC.Cmm.Info.Build
import GHC.Types.Unique
import GHC.Types.Unique.FM
import GHC.Utils.Outputable as Outputable
import Data.Tuple (swap)
+import qualified Data.Map as M
+import qualified Data.Set as S
{-
--------------------------------------------------------------------------------
@@ -76,8 +79,8 @@ renameDetUniq uq = do
return det_uniq
-- Rename local symbols deterministically (in order of appearance)
-detRenameUniques :: DetUniqFM -> CmmGroup -> (DetUniqFM, CmmGroup)
-detRenameUniques dufm group = swap $ runState (mapM uniqRename group) dufm
+detRenameUniques :: UniqRenamable a => DetUniqFM -> a -> (DetUniqFM, a)
+detRenameUniques dufm x = swap $ runState (uniqRename x) dufm
-- The most important function here, which does the actual renaming.
-- Arguably, maybe we should rename this to CLabelRenamer
@@ -110,20 +113,24 @@ instance UniqRenamable CmmTickScope where
-- ROMES:TODO: We may have to change this to get deterministic objects with ticks.
uniqRename = pure
--- * Traversals from here on out
-
--- ROMES:TODO: Delete RawCmmStatics instanceS?
-instance UniqRenamable (GenCmmDecl RawCmmStatics (LabelMap RawCmmStatics) CmmGraph) where
+instance (UniqRenamable a, UniqRenamable b) => UniqRenamable (GenCmmDecl a b CmmGraph) where
uniqRename (CmmProc h lbl regs g)
- = CmmProc <$> uniqRename h <*> uniqRename lbl <*> mapM uniqRename regs <*> uniqRename g
+ = CmmProc <$> uniqRename h <*> uniqRename lbl <*> uniqRename regs <*> uniqRename g
uniqRename (CmmData sec d)
= CmmData <$> uniqRename sec <*> uniqRename d
-instance UniqRenamable (GenCmmDecl CmmStatics CmmTopInfo CmmGraph) where
- uniqRename (CmmProc h lbl regs g)
- = CmmProc <$> uniqRename h <*> uniqRename lbl <*> mapM uniqRename regs <*> uniqRename g
- uniqRename (CmmData sec d)
- = CmmData <$> uniqRename sec <*> uniqRename d
+instance UniqRenamable ModuleSRTInfo where
+ uniqRename
+ ModuleSRTInfo{thisModule, dedupSRTs, flatSRTs, moduleSRTMap}
+ -- ROMES:TODO: I feel like we don't really need to do this for all of these maps, and can shortcut some of this
+ -- Nonetheless, in order to produce a working prototype, I'm just always renaming them all. We can optimise later.
+ = ModuleSRTInfo thisModule <$> uniqRename dedupSRTs <*> uniqRename flatSRTs <*> uniqRename moduleSRTMap
+
+instance UniqRenamable SRTEntry where
+ uniqRename (SRTEntry cl) = SRTEntry <$> uniqRename cl
+
+instance UniqRenamable CAFfyLabel where
+ uniqRename (CAFfyLabel cl) = CAFfyLabel <$> uniqRename cl
instance UniqRenamable CmmTopInfo where
uniqRename TopInfo{info_tbls, stack_info}
@@ -167,8 +174,7 @@ instance UniqRenamable CmmLit where
instance UniqRenamable a {- for 'Body' and on 'RawCmmStatics' -}
=> UniqRenamable (LabelMap a) where
- -- ROMES:TODO: Can a rename of the map have collisions and we lose values? Think harder...
- uniqRename lm = mapFromListWith (\_ _ -> error "very bad") <$> traverse (\(l,x) -> (,) <$> uniqRename l <*> uniqRename x) (mapToList lm)
+ uniqRename lm = mapFromListWith panicMapKeysNotInjective <$> traverse (\(l,x) -> (,) <$> uniqRename l <*> uniqRename x) (mapToList lm)
instance UniqRenamable CmmGraph where
uniqRename (CmmGraph e g) = CmmGraph <$> uniqRename e <*> uniqRename g
@@ -241,9 +247,25 @@ instance UniqRenamable CmmReg where
CmmLocal l -> CmmLocal <$> uniqRename l
CmmGlobal x -> pure $ CmmGlobal x
+instance UniqRenamable a => UniqRenamable [a] where
+ uniqRename = mapM uniqRename
+
instance (UniqRenamable a, UniqRenamable b) => UniqRenamable (a, b) where
uniqRename (a, b) = (,) <$> uniqRename a <*> uniqRename b
instance (UniqRenamable a) => UniqRenamable (Maybe a) where
uniqRename Nothing = pure Nothing
uniqRename (Just x) = Just <$> uniqRename x
+
+instance (Ord a, UniqRenamable a, UniqRenamable b) => UniqRenamable (M.Map a b) where
+ uniqRename m = M.fromListWith panicMapKeysNotInjective <$> traverse (\(l,x) -> (,) <$> uniqRename l <*> uniqRename x) (M.toList m)
+
+instance (Ord a, UniqRenamable a) => UniqRenamable (S.Set a) where
+ -- Because of renaming being injective the resulting set should have the same
+ -- size as the intermediate list.
+ uniqRename s = S.fromList <$> mapM uniqRename (S.toList s)
+
+-- | Utility panic used by UniqRenamable instances for Map-like datatypes
+panicMapKeysNotInjective :: a -> b -> c
+panicMapKeysNotInjective _ _ = error "this should be impossible because the function which maps keys should be injective"
+
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/70ff49b7efc8c1fca46cba6eff630c5d39a99213...82b39d632877ba5fedf8b5cc5a926c96deeb02c5
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/70ff49b7efc8c1fca46cba6eff630c5d39a99213...82b39d632877ba5fedf8b5cc5a926c96deeb02c5
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/20240621/ef34fc78/attachment-0001.html>
More information about the ghc-commits
mailing list