Add selectors for common fields (DataCon/PatSyn) to ConLike
[ghc.git] / compiler / basicTypes / NameEnv.hs
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 {-# LANGUAGE CPP #-}
9 module NameEnv (
10 -- * Var, Id and TyVar environments (maps)
11 NameEnv,
12
13 -- ** Manipulating these environments
14 mkNameEnv,
15 emptyNameEnv, unitNameEnv, nameEnvElts, nameEnvUniqueElts,
16 extendNameEnv_C, extendNameEnv_Acc, extendNameEnv,
17 extendNameEnvList, extendNameEnvList_C,
18 foldNameEnv, filterNameEnv, anyNameEnv,
19 plusNameEnv, plusNameEnv_C, alterNameEnv,
20 lookupNameEnv, lookupNameEnv_NF, delFromNameEnv, delListFromNameEnv,
21 elemNameEnv, mapNameEnv, disjointNameEnv,
22
23 -- ** Dependency analysis
24 depAnal
25 ) where
26
27 #include "HsVersions.h"
28
29 import Digraph
30 import Name
31 import Unique
32 import UniqFM
33 import Maybes
34
35 {-
36 ************************************************************************
37 * *
38 \subsection{Name environment}
39 * *
40 ************************************************************************
41 -}
42
43 depAnal :: (node -> [Name]) -- Defs
44 -> (node -> [Name]) -- Uses
45 -> [node]
46 -> [SCC node]
47 -- Peform dependency analysis on a group of definitions,
48 -- where each definition may define more than one Name
49 --
50 -- The get_defs and get_uses functions are called only once per node
51 depAnal get_defs get_uses nodes
52 = stronglyConnCompFromEdgedVertices (map mk_node keyed_nodes)
53 where
54 keyed_nodes = nodes `zip` [(1::Int)..]
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
60 {-
61 ************************************************************************
62 * *
63 \subsection{Name environment}
64 * *
65 ************************************************************************
66 -}
67
68 type NameEnv a = UniqFM a -- Domain is Name
69
70 emptyNameEnv :: NameEnv a
71 mkNameEnv :: [(Name,a)] -> NameEnv a
72 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 extendNameEnv :: NameEnv a -> Name -> a -> NameEnv a
78 plusNameEnv :: NameEnv a -> NameEnv a -> NameEnv a
79 plusNameEnv_C :: (a->a->a) -> NameEnv a -> NameEnv a -> NameEnv a
80 extendNameEnvList :: NameEnv a -> [(Name,a)] -> NameEnv a
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 elemNameEnv :: Name -> NameEnv a -> Bool
85 unitNameEnv :: Name -> a -> NameEnv a
86 lookupNameEnv :: NameEnv a -> Name -> Maybe a
87 lookupNameEnv_NF :: NameEnv a -> Name -> a
88 foldNameEnv :: (a -> b -> b) -> b -> NameEnv a -> b
89 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 emptyNameEnv = emptyUFM
96 unitNameEnv x y = unitUFM x y
97 extendNameEnv x y z = addToUFM x y z
98 extendNameEnvList x l = addListToUFM x l
99 lookupNameEnv x y = lookupUFM x y
100 alterNameEnv = alterUFM
101 mkNameEnv l = listToUFM l
102 elemNameEnv x y = elemUFM x y
103 foldNameEnv a b c = foldUFM a b c
104 plusNameEnv x y = plusUFM x y
105 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 nameEnvUniqueElts x = ufmToList x
109 extendNameEnv_Acc x y z a b = addToUFM_Acc x y z a b
110 extendNameEnvList_C x y z = addListToUFM_C x y z
111 delFromNameEnv x y = delFromUFM x y
112 delListFromNameEnv x y = delListFromUFM x y
113 filterNameEnv x y = filterUFM x y
114 anyNameEnv f x = foldUFM ((||) . f) False x
115 disjointNameEnv x y = isNullUFM (intersectUFM x y)
116
117 lookupNameEnv_NF env n = expectJust "lookupNameEnv_NF" (lookupNameEnv env n)