[Git][ghc/ghc][wip/caf-cleanups] Add few cleanups of the CAF logic

[Ben Gamari]

Ben Gamari pushed to branch wip/caf-cleanups at Glasgow Haskell Compiler / GHC


Commits:
f5c3ea83 by Ben Gamari at 2020-05-09T20:05:38-04:00
Add few cleanups of the CAF logic

- - - - -


4 changed files:

- compiler/GHC/Cmm/Info/Build.hs
- compiler/GHC/Driver/Main.hs
- compiler/GHC/Iface/Make.hs
- compiler/GHC/Types/Var/Set.hs


Changes:

=====================================
compiler/GHC/Cmm/Info/Build.hs
=====================================
@@ -12,6 +12,7 @@ import GHC.Prelude hiding (succ)
 
 import GHC.Types.Id
 import GHC.Types.Id.Info
+import GHC.Types.Var.Set
 import GHC.Cmm.BlockId
 import GHC.Cmm.Dataflow.Block
 import GHC.Cmm.Dataflow.Graph
@@ -459,7 +460,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 +737,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


=====================================
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.


=====================================
compiler/GHC/Iface/Make.hs
=====================================
@@ -46,6 +46,7 @@ import GHC.Hs
 import GHC.Driver.Types
 import GHC.Driver.Session
 import GHC.Types.Var.Env
+import GHC.Types.Var.Set
 import GHC.Types.Var
 import GHC.Types.Name
 import GHC.Types.Avail
@@ -100,7 +101,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 +118,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


=====================================
compiler/GHC/Types/Var/Set.hs
=====================================
@@ -42,6 +42,9 @@ module GHC.Types.Var.Set (
         sizeDVarSet, seqDVarSet,
         partitionDVarSet,
         dVarSetToVarSet,
+
+        -- ** non-CAFfy sets
+        NonCaffySet(..)
     ) where
 
 #include "HsVersions.h"
@@ -352,3 +355,8 @@ transCloDVarSet fn seeds
        | otherwise            = go (acc `unionDVarSet` new_vs) new_vs
        where
          new_vs = fn candidates `minusDVarSet` acc
+
+-- | '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)



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

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/f5c3ea832be002ad9fad95f96446ac5275fbff87
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/20200509/7139e292/attachment-0001.html>