NameEnv.hs 5.45 KB
Newer Older
Austin Seipp's avatar
Austin Seipp committed
1 2 3 4
{-
(c) The University of Glasgow 2006
(c) The GRASP/AQUA Project, Glasgow University, 1992-1998

5
\section[NameEnv]{@NameEnv@: name environments}
Austin Seipp's avatar
Austin Seipp committed
6
-}
7

8
{-# LANGUAGE CPP #-}
9
module NameEnv (
10 11 12 13 14
        -- * Var, Id and TyVar environments (maps)
        NameEnv,

        -- ** Manipulating these environments
        mkNameEnv,
15 16
        emptyNameEnv, isEmptyNameEnv,
        unitNameEnv, nameEnvElts, nameEnvUniqueElts,
17
        extendNameEnv_C, extendNameEnv_Acc, extendNameEnv,
Simon Marlow's avatar
Simon Marlow committed
18
        extendNameEnvList, extendNameEnvList_C,
niteria's avatar
niteria committed
19
        filterNameEnv, anyNameEnv,
20 21
        plusNameEnv, plusNameEnv_C, alterNameEnv,
        lookupNameEnv, lookupNameEnv_NF, delFromNameEnv, delListFromNameEnv,
22
        elemNameEnv, mapNameEnv, disjointNameEnv,
23

24 25 26 27 28 29
        DNameEnv,

        emptyDNameEnv,
        lookupDNameEnv,
        mapDNameEnv,
        alterDNameEnv,
30 31
        -- ** Dependency analysis
        depAnal
32 33 34 35
    ) where

#include "HsVersions.h"

36
import Digraph
Simon Marlow's avatar
Simon Marlow committed
37
import Name
38
import Unique
39
import UniqFM
40
import UniqDFM
Simon Marlow's avatar
Simon Marlow committed
41
import Maybes
42

Austin Seipp's avatar
Austin Seipp committed
43 44 45
{-
************************************************************************
*                                                                      *
46
\subsection{Name environment}
Austin Seipp's avatar
Austin Seipp committed
47 48 49
*                                                                      *
************************************************************************
-}
50

niteria's avatar
niteria committed
51 52 53 54 55 56 57 58 59 60
{-
Note [depAnal determinism]
~~~~~~~~~~~~~~~~~~~~~~~~~~
depAnal is deterministic provided it gets the nodes in a deterministic order.
The order of lists that get_defs and get_uses return doesn't matter, as these
are only used to construct the edges, and stronglyConnCompFromEdgedVertices is
deterministic even when the edges are not in deterministic order as explained
in Note [Deterministic SCC] in Digraph.
-}

61
depAnal :: (node -> [Name])      -- Defs
62 63 64 65 66 67 68 69 70 71 72
        -> (node -> [Name])      -- Uses
        -> [node]
        -> [SCC node]
-- Peform dependency analysis on a group of definitions,
-- where each definition may define more than one Name
--
-- The get_defs and get_uses functions are called only once per node
depAnal get_defs get_uses nodes
  = stronglyConnCompFromEdgedVertices (map mk_node keyed_nodes)
  where
    keyed_nodes = nodes `zip` [(1::Int)..]
Icelandjack's avatar
Icelandjack committed
73
    mk_node (node, key) = (node, key, mapMaybe (lookupNameEnv key_map) (get_uses node))
74 75

    key_map :: NameEnv Int   -- Maps a Name to the key of the decl that defines it
76
    key_map = mkNameEnv [(name,key) | (node, key) <- keyed_nodes, name <- get_defs node]
77

Austin Seipp's avatar
Austin Seipp committed
78 79 80
{-
************************************************************************
*                                                                      *
81
\subsection{Name environment}
Austin Seipp's avatar
Austin Seipp committed
82 83 84
*                                                                      *
************************************************************************
-}
85

86
type NameEnv a = UniqFM a       -- Domain is Name
87

88
emptyNameEnv       :: NameEnv a
89
isEmptyNameEnv     :: NameEnv a -> Bool
90 91
mkNameEnv          :: [(Name,a)] -> NameEnv a
nameEnvElts        :: NameEnv a -> [a]
92
nameEnvUniqueElts  :: NameEnv a -> [(Unique, a)]
93
alterNameEnv       :: (Maybe a-> Maybe a) -> NameEnv a -> Name -> NameEnv a
94
extendNameEnv_C    :: (a->a->a) -> NameEnv a -> Name -> a -> NameEnv a
95
extendNameEnv_Acc  :: (a->b->b) -> (a->b) -> NameEnv b -> Name -> a -> NameEnv b
96 97 98
extendNameEnv      :: NameEnv a -> Name -> a -> NameEnv a
plusNameEnv        :: NameEnv a -> NameEnv a -> NameEnv a
plusNameEnv_C      :: (a->a->a) -> NameEnv a -> NameEnv a -> NameEnv a
99
extendNameEnvList  :: NameEnv a -> [(Name,a)] -> NameEnv a
Simon Marlow's avatar
Simon Marlow committed
100
extendNameEnvList_C :: (a->a->a) -> NameEnv a -> [(Name,a)] -> NameEnv a
101
delFromNameEnv     :: NameEnv a -> Name -> NameEnv a
102
delListFromNameEnv :: NameEnv a -> [Name] -> NameEnv a
103 104 105
elemNameEnv        :: Name -> NameEnv a -> Bool
unitNameEnv        :: Name -> a -> NameEnv a
lookupNameEnv      :: NameEnv a -> Name -> Maybe a
106
lookupNameEnv_NF   :: NameEnv a -> Name -> a
107
filterNameEnv      :: (elt -> Bool) -> NameEnv elt -> NameEnv elt
108
anyNameEnv         :: (elt -> Bool) -> NameEnv elt -> Bool
109
mapNameEnv         :: (elt1 -> elt2) -> NameEnv elt1 -> NameEnv elt2
110
disjointNameEnv    :: NameEnv a -> NameEnv a -> Bool
111

112
nameEnvElts x         = eltsUFM x
113
emptyNameEnv          = emptyUFM
114
isEmptyNameEnv        = isNullUFM
115
unitNameEnv x y       = unitUFM x y
116 117 118
extendNameEnv x y z   = addToUFM x y z
extendNameEnvList x l = addListToUFM x l
lookupNameEnv x y     = lookupUFM x y
119
alterNameEnv          = alterUFM
120
mkNameEnv     l       = listToUFM l
121 122 123
elemNameEnv x y          = elemUFM x y
plusNameEnv x y          = plusUFM x y
plusNameEnv_C f x y      = plusUFM_C f x y
124
extendNameEnv_C f x y z  = addToUFM_C f x y z
125
mapNameEnv f x           = mapUFM f x
126 127 128 129 130 131
nameEnvUniqueElts x      = ufmToList x
extendNameEnv_Acc x y z a b  = addToUFM_Acc x y z a b
extendNameEnvList_C x y z = addListToUFM_C x y z
delFromNameEnv x y      = delFromUFM x y
delListFromNameEnv x y  = delListFromUFM x y
filterNameEnv x y       = filterUFM x y
132 133
anyNameEnv f x          = foldUFM ((||) . f) False x
disjointNameEnv x y     = isNullUFM (intersectUFM x y)
134

135
lookupNameEnv_NF env n = expectJust "lookupNameEnv_NF" (lookupNameEnv env n)
136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152

-- Deterministic NameEnv
-- See Note [Deterministic UniqFM] in UniqDFM for explanation why we need
-- DNameEnv.
type DNameEnv a = UniqDFM a

emptyDNameEnv :: DNameEnv a
emptyDNameEnv = emptyUDFM

lookupDNameEnv :: DNameEnv a -> Name -> Maybe a
lookupDNameEnv = lookupUDFM

mapDNameEnv :: (a -> b) -> DNameEnv a -> DNameEnv b
mapDNameEnv = mapUDFM

alterDNameEnv :: (Maybe a -> Maybe a) -> DNameEnv a -> Name -> DNameEnv a
alterDNameEnv = alterUDFM