Make cost centre symbol names deterministic.

Previously, non-CAF cost centre symbol names contained a unique,
leading to non-deterministic object files which, among other issues,
can lead to an inconsistency causing linking failure when using cached
builds sourced from multiple machines, such as with nix. Now, each
cost centre symbol is annotated with the type of cost centre it
is (CAF, expression annotation, declaration annotation, or HPC) and,
when a single module has multiple cost centres with the same name and
type, a 0-based index.

Reviewers: bgamari, simonmar

Reviewed By: bgamari

Subscribers: niteria, simonmar, RyanGlScott, osa1, rwbarton, thomie, carter

GHC Trac Issues: #4012, #12935

Differential Revision: https://phabricator.haskell.org/D4388

1 files changed, 11 insertions, 10 deletions

diff --git a/compiler/deSugar/Coverage.hs b/compiler/deSugar/Coverage.hs
index b2e9ea2cf6..1c118a84b6 100644
--- a/compiler/deSugar/Coverage.hs
+++ b/compiler/deSugar/Coverage.hs
@@ -27,6 +27,7 @@ import NameSet hiding (FreeVars)
 import Name
 import Bag
 import CostCentre
+import CostCentreState
 import CoreSyn
 import Id
 import VarSet
@@ -34,7 +35,6 @@ import Data.List
 import FastString
 import HscTypes
 import TyCon
-import UniqSupply
 import BasicTypes
 import MonadUtils
 import Maybes
@@ -75,7 +75,6 @@ addTicksToBinds hsc_env mod mod_loc exports tyCons binds
     Just orig_file <- ml_hs_file mod_loc,
     not ("boot" `isSuffixOf` orig_file) = do
 
-     us <- mkSplitUniqSupply 'C' -- for cost centres
      let  orig_file2 = guessSourceFile binds orig_file
 
           tickPass tickish (binds,st) =
@@ -98,7 +97,7 @@ addTicksToBinds hsc_env mod mod_loc exports tyCons binds
 
           initState = TT { tickBoxCount = 0
                          , mixEntries   = []
-                         , uniqSupply   = us
+                         , ccIndices    = newCostCentreState
                          }
 
           (binds1,st) = foldr tickPass (binds, initState) passes
@@ -1002,7 +1001,7 @@ liftL f (L loc a) = do
 
 data TickTransState = TT { tickBoxCount:: Int
                          , mixEntries  :: [MixEntry_]
-                         , uniqSupply  :: UniqSupply
+                         , ccIndices   :: CostCentreState
                          }
 
 data TickTransEnv = TTE { fileName     :: FastString
@@ -1077,10 +1076,11 @@ instance Monad TM where
 instance HasDynFlags TM where
   getDynFlags = TM $ \ env st -> (tte_dflags env, noFVs, st)
 
-instance MonadUnique TM where
-  getUniqueSupplyM = TM $ \_ st -> (uniqSupply st, noFVs, st)
-  getUniqueM = TM $ \_ st -> let (u, us') = takeUniqFromSupply (uniqSupply st)
-                             in (u, noFVs, st { uniqSupply = us' })
+-- | Get the next HPC cost centre index for a given centre name
+getCCIndexM :: FastString -> TM CostCentreIndex
+getCCIndexM n = TM $ \_ st -> let (idx, is') = getCCIndex n $
+                                                 ccIndices st
+                              in (idx, noFVs, st { ccIndices = is' })
 
 getState :: TM TickTransState
 getState = TM $ \ _ st -> (st, noFVs, st)
@@ -1208,8 +1208,9 @@ mkTickish boxLabel countEntries topOnly pos fvs decl_path = do
       return $ HpcTick (this_mod env) c
 
     ProfNotes -> do
-      ccUnique <- getUniqueM
-      let cc = mkUserCC (mkFastString cc_name) (this_mod env) pos ccUnique
+      let nm = mkFastString cc_name
+      flavour <- HpcCC <$> getCCIndexM nm
+      let cc = mkUserCC nm (this_mod env) pos flavour
           count = countEntries && gopt Opt_ProfCountEntries dflags
       return $ ProfNote cc count True{-scopes-}