never executed always true always false
    1 {-
    2 (c) The University of Glasgow 2006
    3 (c) The GRASP/AQUA Project, Glasgow University, 1992-1998
    4 
    5 \section[NameEnv]{@NameEnv@: name environments}
    6 -}
    7 
    8 
    9 {-# LANGUAGE BangPatterns #-}
   10 {-# LANGUAGE ScopedTypeVariables #-}
   11 
   12 module GHC.Types.Name.Env (
   13         -- * Var, Id and TyVar environments (maps)
   14         NameEnv,
   15 
   16         -- ** Manipulating these environments
   17         mkNameEnv, mkNameEnvWith,
   18         emptyNameEnv, isEmptyNameEnv,
   19         unitNameEnv, nonDetNameEnvElts,
   20         extendNameEnv_C, extendNameEnv_Acc, extendNameEnv,
   21         extendNameEnvList, extendNameEnvList_C,
   22         filterNameEnv, anyNameEnv,
   23         plusNameEnv, plusNameEnv_C, plusNameEnv_CD, plusNameEnv_CD2, alterNameEnv,
   24         lookupNameEnv, lookupNameEnv_NF, delFromNameEnv, delListFromNameEnv,
   25         elemNameEnv, mapNameEnv, disjointNameEnv,
   26         seqEltsNameEnv,
   27 
   28         DNameEnv,
   29 
   30         emptyDNameEnv,
   31         lookupDNameEnv,
   32         delFromDNameEnv, filterDNameEnv,
   33         mapDNameEnv,
   34         adjustDNameEnv, alterDNameEnv, extendDNameEnv,
   35         eltsDNameEnv, extendDNameEnv_C,
   36         -- ** Dependency analysis
   37         depAnal
   38     ) where
   39 
   40 import GHC.Prelude
   41 
   42 import GHC.Data.Graph.Directed
   43 import GHC.Types.Name
   44 import GHC.Types.Unique.FM
   45 import GHC.Types.Unique.DFM
   46 import GHC.Data.Maybe
   47 
   48 {-
   49 ************************************************************************
   50 *                                                                      *
   51 \subsection{Name environment}
   52 *                                                                      *
   53 ************************************************************************
   54 -}
   55 
   56 {-
   57 Note [depAnal determinism]
   58 ~~~~~~~~~~~~~~~~~~~~~~~~~~
   59 depAnal is deterministic provided it gets the nodes in a deterministic order.
   60 The order of lists that get_defs and get_uses return doesn't matter, as these
   61 are only used to construct the edges, and stronglyConnCompFromEdgedVertices is
   62 deterministic even when the edges are not in deterministic order as explained
   63 in Note [Deterministic SCC] in GHC.Data.Graph.Directed.
   64 -}
   65 
   66 depAnal :: forall node.
   67            (node -> [Name])      -- Defs
   68         -> (node -> [Name])      -- Uses
   69         -> [node]
   70         -> [SCC node]
   71 -- Perform dependency analysis on a group of definitions,
   72 -- where each definition may define more than one Name
   73 --
   74 -- The get_defs and get_uses functions are called only once per node
   75 depAnal get_defs get_uses nodes
   76   = stronglyConnCompFromEdgedVerticesUniq graph_nodes
   77   where
   78     graph_nodes = (map mk_node keyed_nodes) :: [Node Int node]
   79     keyed_nodes = nodes `zip` [(1::Int)..]
   80     mk_node (node, key) =
   81       let !edges = (mapMaybe (lookupNameEnv key_map) (get_uses node))
   82       in DigraphNode node key edges
   83 
   84     key_map :: NameEnv Int   -- Maps a Name to the key of the decl that defines it
   85     key_map = mkNameEnv [(name,key) | (node, key) <- keyed_nodes, name <- get_defs node]
   86 
   87 {-
   88 ************************************************************************
   89 *                                                                      *
   90 \subsection{Name environment}
   91 *                                                                      *
   92 ************************************************************************
   93 -}
   94 
   95 -- | Name Environment
   96 type NameEnv a = UniqFM Name a       -- Domain is Name
   97 
   98 emptyNameEnv       :: NameEnv a
   99 isEmptyNameEnv     :: NameEnv a -> Bool
  100 mkNameEnv          :: [(Name,a)] -> NameEnv a
  101 mkNameEnvWith      :: (a -> Name) -> [a] -> NameEnv a
  102 nonDetNameEnvElts  :: NameEnv a -> [a]
  103 alterNameEnv       :: (Maybe a-> Maybe a) -> NameEnv a -> Name -> NameEnv a
  104 extendNameEnv_C    :: (a->a->a) -> NameEnv a -> Name -> a -> NameEnv a
  105 extendNameEnv_Acc  :: (a->b->b) -> (a->b) -> NameEnv b -> Name -> a -> NameEnv b
  106 extendNameEnv      :: NameEnv a -> Name -> a -> NameEnv a
  107 plusNameEnv        :: NameEnv a -> NameEnv a -> NameEnv a
  108 plusNameEnv_C      :: (a->a->a) -> NameEnv a -> NameEnv a -> NameEnv a
  109 plusNameEnv_CD     :: (a->a->a) -> NameEnv a -> a -> NameEnv a -> a -> NameEnv a
  110 plusNameEnv_CD2    :: (Maybe a->Maybe a->a) -> NameEnv a -> NameEnv a -> NameEnv a
  111 extendNameEnvList  :: NameEnv a -> [(Name,a)] -> NameEnv a
  112 extendNameEnvList_C :: (a->a->a) -> NameEnv a -> [(Name,a)] -> NameEnv a
  113 delFromNameEnv     :: NameEnv a -> Name -> NameEnv a
  114 delListFromNameEnv :: NameEnv a -> [Name] -> NameEnv a
  115 elemNameEnv        :: Name -> NameEnv a -> Bool
  116 unitNameEnv        :: Name -> a -> NameEnv a
  117 lookupNameEnv      :: NameEnv a -> Name -> Maybe a
  118 lookupNameEnv_NF   :: NameEnv a -> Name -> a
  119 filterNameEnv      :: (elt -> Bool) -> NameEnv elt -> NameEnv elt
  120 anyNameEnv         :: (elt -> Bool) -> NameEnv elt -> Bool
  121 mapNameEnv         :: (elt1 -> elt2) -> NameEnv elt1 -> NameEnv elt2
  122 disjointNameEnv    :: NameEnv a -> NameEnv a -> Bool
  123 seqEltsNameEnv     :: (elt -> ()) -> NameEnv elt -> ()
  124 
  125 nonDetNameEnvElts x         = nonDetEltsUFM x
  126 emptyNameEnv          = emptyUFM
  127 isEmptyNameEnv        = isNullUFM
  128 unitNameEnv x y       = unitUFM x y
  129 extendNameEnv x y z   = addToUFM x y z
  130 extendNameEnvList x l = addListToUFM x l
  131 lookupNameEnv x y     = lookupUFM x y
  132 alterNameEnv          = alterUFM
  133 mkNameEnv     l       = listToUFM l
  134 mkNameEnvWith f       = mkNameEnv . map (\a -> (f a, a))
  135 elemNameEnv x y          = elemUFM x y
  136 plusNameEnv x y          = plusUFM x y
  137 plusNameEnv_C f x y      = plusUFM_C f x y
  138 {-# INLINE plusNameEnv_CD #-}
  139 plusNameEnv_CD f x d y b = plusUFM_CD f x d y b
  140 plusNameEnv_CD2 f x y    = plusUFM_CD2 f x y
  141 extendNameEnv_C f x y z  = addToUFM_C f x y z
  142 mapNameEnv f x           = mapUFM f x
  143 extendNameEnv_Acc x y z a b  = addToUFM_Acc x y z a b
  144 extendNameEnvList_C x y z = addListToUFM_C x y z
  145 delFromNameEnv x y      = delFromUFM x y
  146 delListFromNameEnv x y  = delListFromUFM x y
  147 filterNameEnv x y       = filterUFM x y
  148 anyNameEnv f x          = foldUFM ((||) . f) False x
  149 disjointNameEnv x y     = disjointUFM x y
  150 seqEltsNameEnv seqElt x = seqEltsUFM seqElt x
  151 
  152 lookupNameEnv_NF env n = expectJust "lookupNameEnv_NF" (lookupNameEnv env n)
  153 
  154 -- | Deterministic Name Environment
  155 --
  156 -- See Note [Deterministic UniqFM] in "GHC.Types.Unique.DFM" for explanation why
  157 -- we need DNameEnv.
  158 type DNameEnv a = UniqDFM Name a
  159 
  160 emptyDNameEnv :: DNameEnv a
  161 emptyDNameEnv = emptyUDFM
  162 
  163 lookupDNameEnv :: DNameEnv a -> Name -> Maybe a
  164 lookupDNameEnv = lookupUDFM
  165 
  166 delFromDNameEnv :: DNameEnv a -> Name -> DNameEnv a
  167 delFromDNameEnv = delFromUDFM
  168 
  169 filterDNameEnv :: (a -> Bool) -> DNameEnv a -> DNameEnv a
  170 filterDNameEnv = filterUDFM
  171 
  172 mapDNameEnv :: (a -> b) -> DNameEnv a -> DNameEnv b
  173 mapDNameEnv = mapUDFM
  174 
  175 adjustDNameEnv :: (a -> a) -> DNameEnv a -> Name -> DNameEnv a
  176 adjustDNameEnv = adjustUDFM
  177 
  178 alterDNameEnv :: (Maybe a -> Maybe a) -> DNameEnv a -> Name -> DNameEnv a
  179 alterDNameEnv = alterUDFM
  180 
  181 extendDNameEnv :: DNameEnv a -> Name -> a -> DNameEnv a
  182 extendDNameEnv = addToUDFM
  183 
  184 extendDNameEnv_C :: (a -> a -> a) -> DNameEnv a -> Name -> a -> DNameEnv a
  185 extendDNameEnv_C = addToUDFM_C
  186 
  187 eltsDNameEnv :: DNameEnv a -> [a]
  188 eltsDNameEnv = eltsUDFM