NameSet.lhs 5.74 KB
Newer Older
1
%
Simon Marlow's avatar
Simon Marlow committed
2
% (c) The University of Glasgow 2006
3 4 5 6
% (c) The GRASP/AQUA Project, Glasgow University, 1998
%

\begin{code}
7
{-# OPTIONS -w #-}
8 9 10
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and fix
-- any warnings in the module. See
11
--     http://hackage.haskell.org/trac/ghc/wiki/CodingStyle#Warnings
12 13
-- for details

14 15 16 17
module NameSet (
	-- Sets of Names
	NameSet,
	emptyNameSet, unitNameSet, mkNameSet, unionNameSets, unionManyNameSets,
18
	minusNameSet, elemNameSet, nameSetToList, addOneToNameSet, addListToNameSet, 
19
	delFromNameSet, delListFromNameSet, isEmptyNameSet, foldNameSet, filterNameSet,
20
	intersectsNameSet, intersectNameSet,
21 22 23
	
	-- Free variables
	FreeVars, isEmptyFVs, emptyFVs, plusFVs, plusFV, 
24 25 26 27 28
	mkFVs, addOneFV, unitFV, delFV, delFVs,

	-- Defs and uses
	Defs, Uses, DefUse, DefUses,
	emptyDUs, usesOnly, mkDUs, plusDU, 
29
	findUses, duDefs, duUses, allUses
30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45
    ) where

#include "HsVersions.h"

import Name
import UniqSet
\end{code}

%************************************************************************
%*									*
\subsection[Sets of names}
%*									*
%************************************************************************

\begin{code}
type NameSet = UniqSet Name
46 47 48 49 50 51 52 53 54 55 56 57 58
emptyNameSet	   :: NameSet
unitNameSet	   :: Name -> NameSet
addListToNameSet   :: NameSet -> [Name] -> NameSet
addOneToNameSet    :: NameSet -> Name -> NameSet
mkNameSet          :: [Name] -> NameSet
unionNameSets	   :: NameSet -> NameSet -> NameSet
unionManyNameSets  :: [NameSet] -> NameSet
minusNameSet 	   :: NameSet -> NameSet -> NameSet
elemNameSet	   :: Name -> NameSet -> Bool
nameSetToList	   :: NameSet -> [Name]
isEmptyNameSet	   :: NameSet -> Bool
delFromNameSet	   :: NameSet -> Name -> NameSet
delListFromNameSet :: NameSet -> [Name] -> NameSet
59
foldNameSet	   :: (Name -> b -> b) -> b -> NameSet -> b
60
filterNameSet	   :: (Name -> Bool) -> NameSet -> NameSet
61 62
intersectNameSet   :: NameSet -> NameSet -> NameSet
intersectsNameSet  :: NameSet -> NameSet -> Bool 	-- True if non-empty intersection
63
	-- (s1 `intersectsNameSet` s2) doesn't compute s2 if s1 is empty
64 65 66 67 68 69 70 71 72 73 74 75

isEmptyNameSet    = isEmptyUniqSet
emptyNameSet	  = emptyUniqSet
unitNameSet	  = unitUniqSet
mkNameSet         = mkUniqSet
addListToNameSet  = addListToUniqSet
addOneToNameSet	  = addOneToUniqSet
unionNameSets     = unionUniqSets
unionManyNameSets = unionManyUniqSets
minusNameSet	  = minusUniqSet
elemNameSet       = elementOfUniqSet
nameSetToList     = uniqSetToList
76
delFromNameSet    = delOneFromUniqSet
77
foldNameSet	  = foldUniqSet
78
filterNameSet	  = filterUniqSet
79
intersectNameSet  = intersectUniqSets
80 81

delListFromNameSet set ns = foldl delFromNameSet set ns
82 83

intersectsNameSet s1 s2 = not (isEmptyNameSet (s1 `intersectNameSet` s2))
84 85 86
\end{code}


87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117
%************************************************************************
%*									*
\subsection{Free variables}
%*									*
%************************************************************************

These synonyms are useful when we are thinking of free variables

\begin{code}
type FreeVars	= NameSet

plusFV   :: FreeVars -> FreeVars -> FreeVars
addOneFV :: FreeVars -> Name -> FreeVars
unitFV   :: Name -> FreeVars
emptyFVs :: FreeVars
plusFVs  :: [FreeVars] -> FreeVars
mkFVs	 :: [Name] -> FreeVars
delFV    :: Name -> FreeVars -> FreeVars
delFVs   :: [Name] -> FreeVars -> FreeVars

isEmptyFVs  = isEmptyNameSet
emptyFVs    = emptyNameSet
plusFVs     = unionManyNameSets
plusFV      = unionNameSets
mkFVs	    = mkNameSet
addOneFV    = addOneToNameSet
unitFV      = unitNameSet
delFV n s   = delFromNameSet s n
delFVs ns s = delListFromNameSet s ns
\end{code}

118 119 120 121 122 123 124 125 126 127 128 129 130

%************************************************************************
%*									*
		Defs and uses
%*									*
%************************************************************************

\begin{code}
type Defs = NameSet
type Uses = NameSet

type DefUses = [DefUse]
	-- In dependency order: earlier Defs scope over later Uses
131 132

type DefUse  = (Maybe Defs, Uses)
133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153
	-- For items (Just ds, us), the use of any member 
	-- of the ds implies that all the us are used too
	--
	-- Also, us may mention ds
	--
	-- Nothing => Nothing defined in this group, but
	-- 	      nevertheless all the uses are essential.
	--	      Used for instance declarations, for example

emptyDUs :: DefUses
emptyDUs = []

usesOnly :: Uses -> DefUses
usesOnly uses = [(Nothing, uses)]

mkDUs :: [(Defs,Uses)] -> DefUses
mkDUs pairs = [(Just defs, uses) | (defs,uses) <- pairs]

plusDU :: DefUses -> DefUses -> DefUses
plusDU = (++)

154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170
duDefs :: DefUses -> Defs
duDefs dus = foldr get emptyNameSet dus
  where
    get (Nothing, u1) d2 = d2
    get (Just d1, u1) d2 = d1 `unionNameSets` d2

duUses :: DefUses -> Uses
-- Just like allUses, but defs are not eliminated
duUses dus = foldr get emptyNameSet dus
  where
    get (d1, u1) u2 = u1 `unionNameSets` u2

allUses :: DefUses -> Uses
-- Collect all uses, regardless of
-- whether the group is itself used,
-- but remove defs on the way
allUses dus
171 172 173 174 175 176 177 178 179 180 181
  = foldr get emptyNameSet dus
  where
    get (Nothing,   rhs_uses) uses = rhs_uses `unionNameSets` uses
    get (Just defs, rhs_uses) uses = (rhs_uses `unionNameSets` uses)
				     `minusNameSet` defs

findUses :: DefUses -> Uses -> Uses
-- Given some DefUses and some Uses, 
-- find all the uses, transitively. 
-- The result is a superset of the input uses;
-- and includes things defined in the input DefUses
182
-- (but only if they are used)
183 184 185 186 187 188
findUses dus uses 
  = foldr get uses dus
  where
    get (Nothing, rhs_uses) uses
	= rhs_uses `unionNameSets` uses
    get (Just defs, rhs_uses) uses
189 190 191 192
	| defs `intersectsNameSet` uses 	-- Used
	|| not (all (reportIfUnused . nameOccName) (nameSetToList defs))
		-- At least one starts with an "_", 
		-- so treat the group as used
193 194 195
	= rhs_uses `unionNameSets` uses
	| otherwise	-- No def is used
	= uses
Simon Marlow's avatar
Simon Marlow committed
196
\end{code}