[Git][ghc/ghc][wip/romes/12935] Now for SRTs

Rodrigo Mesquita (@alt-romes) gitlab at gitlab.haskell.org
Fri Jun 28 09:33:40 UTC 2024



Rodrigo Mesquita pushed to branch wip/romes/12935 at Glasgow Haskell Compiler / GHC


Commits:
839d6225 by Rodrigo Mesquita at 2024-06-28T10:31:52+01:00
Now for SRTs

- - - - -


3 changed files:

- compiler/GHC/Cmm/Info.hs
- compiler/GHC/Cmm/Info/Build.hs
- compiler/GHC/Cmm/UniqueRenamer.hs


Changes:

=====================================
compiler/GHC/Cmm/Info.hs
=====================================
@@ -68,7 +68,7 @@ mkEmptyContInfoTable info_lbl
 cmmToRawCmm :: Logger -> Profile -> Stream IO CmmGroupSRTs a
             -> IO (Stream IO RawCmmGroup a)
 cmmToRawCmm logger profile cmms
-  = do { detUqSupply <- newIORef (DUS 1)
+  = do { detUqSupply <- newIORef 1
        ; let do_one :: [CmmDeclSRTs] -> IO [RawCmmDecl]
              do_one cmm = do
                -- NB. strictness fixes a space leak.  DO NOT REMOVE.
@@ -76,7 +76,12 @@ cmmToRawCmm logger profile cmms
                  -- We have to store the deterministic unique supply
                  -- to produce uniques across cmm decls.
                  nextUq <- readIORef detUqSupply
-                 let (a, us) = runUniqueDSM 'i' nextUq $ concatMapM (mkInfoTable profile) cmm
+                 -- By using a local namespace 'i' here, we can have other
+                 -- deterministic supplies starting from the same unique in
+                 -- other parts of the Cmm backend
+                 -- See Note [Cmm Local Deterministic Uniques] (TODO)
+                 let (a, us) = runUniqueDSM 'i' nextUq $
+                               concatMapM (mkInfoTable profile) cmm
                  writeIORef detUqSupply us
                  return a
        ; return (Stream.mapM do_one cmms)


=====================================
compiler/GHC/Cmm/Info/Build.hs
=====================================
@@ -37,7 +37,6 @@ import GHC.Data.Maybe
 import GHC.Utils.Outputable
 import GHC.Utils.Panic
 import GHC.Runtime.Heap.Layout
-import GHC.Types.Unique.Supply
 import GHC.Types.CostCentre
 import GHC.StgToCmm.Heap
 
@@ -51,6 +50,7 @@ import Control.Monad.Trans.Class
 import Data.List (unzip4)
 
 import GHC.Types.Name.Set
+import GHC.Cmm.UniqueRenamer
 
 {- Note [SRTs]
    ~~~~~~~~~~~
@@ -887,7 +887,10 @@ doSRTs
   -> IO (ModuleSRTInfo, [CmmDeclSRTs])
 
 doSRTs cfg moduleSRTInfo procs data_ = do
-  us <- mkSplitUniqSupply 'u' -- ROMES:TODO: We could use a deterministic supply here? All names from here on out should be deterministic. Perhaps I could also grep for all supplies created after this point in its closure or somethinkg...
+
+  -- Use local namespace 'u' here.
+  -- See Note [Cmm Local Deterministic Uniques]
+  let runUDSM x = let (a,b) = runUniqueDSM 'u' 1 x in pprTrace "doSRTS" (ppr b) a
 
   let profile = cmmProfile cfg
 
@@ -941,7 +944,7 @@ doSRTs cfg moduleSRTInfo procs data_ = do
           ) ]
 
       (result, moduleSRTInfo') =
-        initUs_ us $
+        runUDSM $
         flip runStateT moduleSRTInfo $ do
           nonCAFs <- mapM (doSCC cfg staticFuns static_data_env) sccs
           cAFs <- forM cafsWithSRTs $ \(l, cafLbl, cafs) ->
@@ -990,7 +993,7 @@ doSCC
   -> LabelMap CLabel -- ^ which blocks are static function entry points
   -> DataCAFEnv      -- ^ static data
   -> SCC (SomeLabel, CAFfyLabel, Set CAFfyLabel)
-  -> StateT ModuleSRTInfo UniqSM
+  -> StateT ModuleSRTInfo UniqDSM
         ( [CmmDeclSRTs]          -- generated SRTs
         , [(Label, CLabel)]      -- SRT fields for info tables
         , [(Label, [SRTEntry])]  -- SRTs to attach to static functions
@@ -1045,7 +1048,7 @@ oneSRT
   -> Bool                       -- ^ True <=> this SRT is for a CAF
   -> Set CAFfyLabel             -- ^ SRT for this set
   -> DataCAFEnv                 -- Static data labels in this group
-  -> StateT ModuleSRTInfo UniqSM
+  -> StateT ModuleSRTInfo UniqDSM
        ( [CmmDeclSRTs]                -- SRT objects we built
        , [(Label, CLabel)]            -- SRT fields for these blocks' itbls
        , [(Label, [SRTEntry])]        -- SRTs to attach to static functions
@@ -1112,7 +1115,7 @@ oneSRT cfg staticFuns lbls caf_lbls isCAF cafs static_data_env = do
     -- update the SRTMap for the label to point to a closure. It's
     -- important that we don't do this for static functions or CAFs,
     -- see Note [Invalid optimisation: shortcutting].
-    updateSRTMap :: Maybe SRTEntry -> StateT ModuleSRTInfo UniqSM ()
+    updateSRTMap :: Maybe SRTEntry -> StateT ModuleSRTInfo UniqDSM ()
     updateSRTMap srtEntry =
       srtTrace "updateSRTMap"
         (pdoc platform srtEntry <+> "isCAF:" <+> ppr isCAF <+>
@@ -1236,7 +1239,7 @@ oneSRT cfg staticFuns lbls caf_lbls isCAF cafs static_data_env = do
 buildSRTChain
    :: Profile
    -> [SRTEntry]
-   -> UniqSM
+   -> UniqDSM
         ( [CmmDeclSRTs] -- The SRT object(s)
         , SRTEntry      -- label to use in the info table
         )
@@ -1254,9 +1257,9 @@ buildSRTChain profile cafSet =
     mAX_SRT_SIZE = 16
 
 
-buildSRT :: Profile -> [SRTEntry] -> UniqSM (CmmDeclSRTs, SRTEntry)
+buildSRT :: Profile -> [SRTEntry] -> UniqDSM (CmmDeclSRTs, SRTEntry)
 buildSRT profile refs = do
-  id <- getUniqueM
+  id <- getUniqueDSM
   let
     lbl = mkSRTLabel id
     platform = profilePlatform profile


=====================================
compiler/GHC/Cmm/UniqueRenamer.hs
=====================================
@@ -2,7 +2,7 @@
 module GHC.Cmm.UniqueRenamer
   ( detRenameUniques
   , UniqDSM, runUniqueDSM
-  , DUniqSupply(..), getUniqueDSM
+  , DUniqSupply, getUniqueDSM
 
   -- Careful! Not for general use!
   , DetUniqFM, emptyDetUFM)
@@ -287,7 +287,7 @@ panicMapKeysNotInjective _ _ = error "this should be impossible because the func
 -- there, but without the unboxing it feels? Maybe not, since we carry the
 -- mappings too.
 
-newtype DUniqSupply = DUS Word64 -- supply uniques iteratively
+type DUniqSupply = Word64 -- supply uniques iteratively
 type DUniqResult result = (# result, DUniqSupply #)
 
 pattern DUniqResult :: a -> b -> (# a, b #)
@@ -317,7 +317,7 @@ instance Applicative UniqDSM where
   {-# INLINE (*>) #-}
 
 getUniqueDSM :: UniqDSM Unique
-getUniqueDSM = UDSM (\tag (DUS us0) -> DUniqResult (mkUniqueGrimily $ tag .|. us0) (DUS $ us0+1))
+getUniqueDSM = UDSM (\tag us0 -> DUniqResult (mkUniqueGrimily $ tag .|. us0) (us0+1))
 
 runUniqueDSM :: Char {- tag -} -> DUniqSupply {- first unique -}
              -> UniqDSM a -> (a, DUniqSupply)
@@ -326,3 +326,9 @@ runUniqueDSM c firstUniq (UDSM f) =
    in case f tag firstUniq of
         DUniqResult uq us -> (uq, us)
 
+{-
+Note [Cmm Local Deterministic Uniques]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+TODO!!!!!
+TODO!!!!!
+-}



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/839d6225e0ff437397ab03c80b4e7a134efca434

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/839d6225e0ff437397ab03c80b4e7a134efca434
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/20240628/cf7bf705/attachment-0001.html>


More information about the ghc-commits mailing list