Add few cleanups of the CAF logic

Give the NameSet of non-CAFfy names a proper newtype to distinguish it
from all of the other NameSets floating about.

5 files changed, 23 insertions, 13 deletions

diff --git a/compiler/GHC/Cmm/Info/Build.hs b/compiler/GHC/Cmm/Info/Build.hs
index 6eabd638b9..fc3d21e2ca 100644
--- a/compiler/GHC/Cmm/Info/Build.hs
+++ b/compiler/GHC/Cmm/Info/Build.hs
@@ -459,7 +459,7 @@ type CAFSet = Set CAFLabel
 type CAFEnv = LabelMap CAFSet
 
 mkCAFLabel :: CLabel -> CAFLabel
-mkCAFLabel lbl = CAFLabel $! toClosureLbl lbl
+mkCAFLabel lbl = CAFLabel (toClosureLbl lbl)
 
 -- This is a label that we can put in an SRT.  It *must* be a closure label,
 -- pointing to either a FUN_STATIC, THUNK_STATIC, or CONSTR.
@@ -736,10 +736,11 @@ getStaticFuns decls =
 type SRTMap = Map CAFLabel (Maybe SRTEntry)
 
 
--- | Given SRTMap of a module returns the set of non-CAFFY names in the module.
--- Any Names not in the set are CAFFY.
-srtMapNonCAFs :: SRTMap -> NameSet
-srtMapNonCAFs srtMap = mkNameSet (mapMaybe get_name (Map.toList srtMap))
+-- | Given 'SRTMap' of a module, returns the set of non-CAFFY names in the
+-- module.  Any 'Name's not in the set are CAFFY.
+srtMapNonCAFs :: SRTMap -> NonCaffySet
+srtMapNonCAFs srtMap =
+    NonCaffySet $ mkNameSet (mapMaybe get_name (Map.toList srtMap))
   where
     get_name (CAFLabel l, Nothing) = hasHaskellName l
     get_name (_l, Just _srt_entry) = Nothing
diff --git a/compiler/GHC/Driver/Main.hs b/compiler/GHC/Driver/Main.hs
index d01264ca55..6cc61246b9 100644
--- a/compiler/GHC/Driver/Main.hs
+++ b/compiler/GHC/Driver/Main.hs
@@ -1384,7 +1384,7 @@ hscWriteIface dflags iface no_change mod_location = do
 
 -- | Compile to hard-code.
 hscGenHardCode :: HscEnv -> CgGuts -> ModLocation -> FilePath
-               -> IO (FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)], NameSet)
+               -> IO (FilePath, Maybe FilePath, [(ForeignSrcLang, FilePath)], NonCaffySet)
                -- ^ @Just f@ <=> _stub.c is f
 hscGenHardCode hsc_env cgguts location output_filename = do
         let CgGuts{ -- This is the last use of the ModGuts in a compilation.
@@ -1541,7 +1541,7 @@ doCodeGen   :: HscEnv -> Module -> [TyCon]
             -> CollectedCCs
             -> [StgTopBinding]
             -> HpcInfo
-            -> IO (Stream IO CmmGroupSRTs NameSet)
+            -> IO (Stream IO CmmGroupSRTs NonCaffySet)
          -- Note we produce a 'Stream' of CmmGroups, so that the
          -- backend can be run incrementally.  Otherwise it generates all
          -- the C-- up front, which has a significant space cost.
diff --git a/compiler/GHC/Iface/Make.hs b/compiler/GHC/Iface/Make.hs
index 15d1c720ea..bb80d5d79b 100644
--- a/compiler/GHC/Iface/Make.hs
+++ b/compiler/GHC/Iface/Make.hs
@@ -100,7 +100,7 @@ mkPartialIface hsc_env mod_details
 
 -- | Fully instantiate a interface
 -- Adds fingerprints and potentially code generator produced information.
-mkFullIface :: HscEnv -> PartialModIface -> Maybe NameSet -> IO ModIface
+mkFullIface :: HscEnv -> PartialModIface -> Maybe NonCaffySet -> IO ModIface
 mkFullIface hsc_env partial_iface mb_non_cafs = do
     let decls
           | gopt Opt_OmitInterfacePragmas (hsc_dflags hsc_env)
@@ -117,9 +117,9 @@ mkFullIface hsc_env partial_iface mb_non_cafs = do
 
     return full_iface
 
-updateDeclCafInfos :: [IfaceDecl] -> Maybe NameSet -> [IfaceDecl]
+updateDeclCafInfos :: [IfaceDecl] -> Maybe NonCaffySet -> [IfaceDecl]
 updateDeclCafInfos decls Nothing = decls
-updateDeclCafInfos decls (Just non_cafs) = map update_decl decls
+updateDeclCafInfos decls (Just (NonCaffySet non_cafs)) = map update_decl decls
   where
     update_decl decl
       | IfaceId nm ty details infos <- decl
diff --git a/compiler/GHC/Iface/UpdateCafInfos.hs b/compiler/GHC/Iface/UpdateCafInfos.hs
index befb95c6ef..1abe2ee659 100644
--- a/compiler/GHC/Iface/UpdateCafInfos.hs
+++ b/compiler/GHC/Iface/UpdateCafInfos.hs
@@ -23,7 +23,7 @@ import GHC.Utils.Outputable
 -- | Update CafInfos of all occurences (in rules, unfoldings, class instances)
 updateModDetailsCafInfos
   :: DynFlags
-  -> NameSet -- ^ Non-CAFFY names in the module. Names not in this set are CAFFY.
+  -> NonCaffySet -- ^ Non-CAFFY names in the module. Names not in this set are CAFFY.
   -> ModDetails -- ^ ModDetails to update
   -> ModDetails
 
@@ -31,7 +31,7 @@ updateModDetailsCafInfos dflags _ mod_details
   | gopt Opt_OmitInterfacePragmas dflags
   = mod_details
 
-updateModDetailsCafInfos _ non_cafs mod_details =
+updateModDetailsCafInfos _ (NonCaffySet non_cafs) mod_details =
   {- pprTrace "updateModDetailsCafInfos" (text "non_cafs:" <+> ppr non_cafs) $ -}
   let
     ModDetails{ md_types = type_env -- for unfoldings
diff --git a/compiler/GHC/Types/Name/Set.hs b/compiler/GHC/Types/Name/Set.hs
index c011bcbf23..73353eaa75 100644
--- a/compiler/GHC/Types/Name/Set.hs
+++ b/compiler/GHC/Types/Name/Set.hs
@@ -4,6 +4,7 @@
 -}
 
 {-# LANGUAGE CPP #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
 module GHC.Types.Name.Set (
         -- * Names set type
         NameSet,
@@ -28,7 +29,10 @@ module GHC.Types.Name.Set (
 
         -- ** Manipulating defs and uses
         emptyDUs, usesOnly, mkDUs, plusDU,
-        findUses, duDefs, duUses, allUses
+        findUses, duDefs, duUses, allUses,
+
+        -- * Non-CAFfy names
+        NonCaffySet(..)
     ) where
 
 #include "HsVersions.h"
@@ -213,3 +217,8 @@ findUses dus uses
         = rhs_uses `unionNameSet` uses
         | otherwise     -- No def is used
         = uses
+
+-- | 'Id's which have no CAF references. This is a result of analysis of C--.
+-- It is always safe to use an empty 'NonCaffySet'. TODO Refer to Note.
+newtype NonCaffySet = NonCaffySet NameSet
+  deriving (Semigroup, Monoid)