Commit cb22348f authored by Ben Gamari's avatar Ben Gamari 🐢 Committed by Marge Bot

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.
parent 8c0740b7
......@@ -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
......
......@@ -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.
......
......@@ -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
......
......@@ -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
......
......@@ -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)
Markdown is supported
0%
or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment