NameEnv.hs 4.5 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 15 16
        -- * Var, Id and TyVar environments (maps)
        NameEnv,

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

        -- ** Dependency analysis
        depAnal
25 26 27 28
    ) where

#include "HsVersions.h"

29
import Digraph
Simon Marlow's avatar
Simon Marlow committed
30
import Name
31
import Unique
32
import UniqFM
Simon Marlow's avatar
Simon Marlow committed
33
import Maybes
34

Austin Seipp's avatar
Austin Seipp committed
35 36 37
{-
************************************************************************
*                                                                      *
38
\subsection{Name environment}
Austin Seipp's avatar
Austin Seipp committed
39 40 41
*                                                                      *
************************************************************************
-}
42

43
depAnal :: (node -> [Name])      -- Defs
44 45 46 47 48 49 50 51 52 53 54
        -> (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
55
    mk_node (node, key) = (node, key, mapMaybe (lookupNameEnv key_map) (get_uses node))
56 57

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

Austin Seipp's avatar
Austin Seipp committed
60 61 62
{-
************************************************************************
*                                                                      *
63
\subsection{Name environment}
Austin Seipp's avatar
Austin Seipp committed
64 65 66
*                                                                      *
************************************************************************
-}
67

68
type NameEnv a = UniqFM a       -- Domain is Name
69

70 71 72
emptyNameEnv       :: NameEnv a
mkNameEnv          :: [(Name,a)] -> NameEnv a
nameEnvElts        :: NameEnv a -> [a]
73
nameEnvUniqueElts  :: NameEnv a -> [(Unique, a)]
74
alterNameEnv       :: (Maybe a-> Maybe a) -> NameEnv a -> Name -> NameEnv a
75
extendNameEnv_C    :: (a->a->a) -> NameEnv a -> Name -> a -> NameEnv a
76
extendNameEnv_Acc  :: (a->b->b) -> (a->b) -> NameEnv b -> Name -> a -> NameEnv b
77 78 79
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
80
extendNameEnvList  :: NameEnv a -> [(Name,a)] -> NameEnv a
Simon Marlow's avatar
Simon Marlow committed
81
extendNameEnvList_C :: (a->a->a) -> NameEnv a -> [(Name,a)] -> NameEnv a
82
delFromNameEnv     :: NameEnv a -> Name -> NameEnv a
83
delListFromNameEnv :: NameEnv a -> [Name] -> NameEnv a
84 85 86
elemNameEnv        :: Name -> NameEnv a -> Bool
unitNameEnv        :: Name -> a -> NameEnv a
lookupNameEnv      :: NameEnv a -> Name -> Maybe a
87
lookupNameEnv_NF   :: NameEnv a -> Name -> a
88 89
foldNameEnv        :: (a -> b -> b) -> b -> NameEnv a -> b
filterNameEnv      :: (elt -> Bool) -> NameEnv elt -> NameEnv elt
90
anyNameEnv         :: (elt -> Bool) -> NameEnv elt -> Bool
91
mapNameEnv         :: (elt1 -> elt2) -> NameEnv elt1 -> NameEnv elt2
92
disjointNameEnv    :: NameEnv a -> NameEnv a -> Bool
93

94
nameEnvElts x         = eltsUFM x
95 96
emptyNameEnv          = emptyUFM
unitNameEnv x y       = unitUFM x y
97 98 99
extendNameEnv x y z   = addToUFM x y z
extendNameEnvList x l = addListToUFM x l
lookupNameEnv x y     = lookupUFM x y
100
alterNameEnv          = alterUFM
101
mkNameEnv     l       = listToUFM l
102 103 104 105
elemNameEnv x y          = elemUFM x y
foldNameEnv a b c        = foldUFM a b c
plusNameEnv x y          = plusUFM x y
plusNameEnv_C f x y      = plusUFM_C f x y
106
extendNameEnv_C f x y z  = addToUFM_C f x y z
107
mapNameEnv f x           = mapUFM f x
108 109 110 111 112 113
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
114 115
anyNameEnv f x          = foldUFM ((||) . f) False x
disjointNameEnv x y     = isNullUFM (intersectUFM x y)
116

117
lookupNameEnv_NF env n = expectJust "lookupNameEnv_NF" (lookupNameEnv env n)