NameEnv.hs 5.33 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
        emptyNameEnv, isEmptyNameEnv,
niteria's avatar
niteria committed
16
        unitNameEnv, nameEnvElts,
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 UniqFM
39
import UniqDFM
Simon Marlow's avatar
Simon Marlow committed
40
import Maybes
41

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

niteria's avatar
niteria committed
50 51 52 53 54 55 56 57 58 59
{-
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.
-}

60
depAnal :: (node -> [Name])      -- Defs
61 62 63 64 65 66 67 68 69 70 71
        -> (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
72
    mk_node (node, key) = (node, key, mapMaybe (lookupNameEnv key_map) (get_uses node))
73 74

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

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

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

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

110
nameEnvElts x         = eltsUFM x
111
emptyNameEnv          = emptyUFM
112
isEmptyNameEnv        = isNullUFM
113
unitNameEnv x y       = unitUFM x y
114 115 116
extendNameEnv x y z   = addToUFM x y z
extendNameEnvList x l = addListToUFM x l
lookupNameEnv x y     = lookupUFM x y
117
alterNameEnv          = alterUFM
118
mkNameEnv     l       = listToUFM l
119 120 121
elemNameEnv x y          = elemUFM x y
plusNameEnv x y          = plusUFM x y
plusNameEnv_C f x y      = plusUFM_C f x y
122
extendNameEnv_C f x y z  = addToUFM_C f x y z
123
mapNameEnv f x           = mapUFM f x
124 125 126 127 128
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
129 130
anyNameEnv f x          = foldUFM ((||) . f) False x
disjointNameEnv x y     = isNullUFM (intersectUFM x y)
131

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

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