2 % (c) The GRASP/AQUA Project, Glasgow University, 1992-1996
4 \section[RnUtils]{Functions used by both renaming passes}
7 #include "HsVersions.h"
10 RnEnv(..), QualNames(..),
11 UnqualNames(..), ScopeStack(..),
12 emptyRnEnv, extendGlobalRnEnv, extendLocalRnEnv,
13 lookupRnEnv, lookupTcRnEnv,
22 -- ToDo: nuke/move? WDP 96/04/05
23 GlobalNameMapper(..), GlobalNameMappers(..)
28 import Bag ( Bag, emptyBag, snocBag, unionBags )
29 import ErrUtils ( addShortErrLocLine, addErrLoc )
30 import FiniteMap ( FiniteMap, emptyFM, isEmptyFM,
31 lookupFM, addListToFM, addToFM )
32 import Maybes ( maybeToBool )
33 import Name ( RdrName(..), isQual, pprNonOp, getLocalName )
34 import PprStyle ( PprStyle(..) )
36 import RnHsSyn ( RnName )
37 import Util ( assertPanic )
39 type GlobalNameMapper = RnName -> Maybe Name
40 type GlobalNameMappers = (GlobalNameMapper, GlobalNameMapper)
43 *********************************************************
45 \subsection{RnEnv: renaming environment}
47 *********************************************************
49 Seperate FiniteMaps are kept for lookup up Qual names,
50 Unqual names and Local names.
53 type RnEnv = ((QualNames, UnqualNames, QualNames, UnqualNames), ScopeStack)
55 type QualNames = FiniteMap (FAST_STRING,Module) RnName
56 type UnqualNames = FiniteMap FAST_STRING RnName
57 type ScopeStack = FiniteMap FAST_STRING RnName
60 extendGlobalRnEnv :: RnEnv -> [(RdrName,RnName)] -> [(RdrName,RnName)]
61 -> (RnEnv, Bag (RdrName, RnName, RnName))
62 extendLocalRnEnv :: Bool -> RnEnv -> [RnName] -> (RnEnv, [RnName])
63 lookupRnEnv :: RnEnv -> RdrName -> Maybe RnName
64 lookupTcRnEnv :: RnEnv -> RdrName -> Maybe RnName
67 If the @RdrName@ is a @Qual@, @lookupValue@ looks it up in the global
68 value QualNames. If it is @Unqual@, it looks it up first in the
69 ScopeStack, and if it isn't found there, then in the global
72 @lookupTcRnEnv@ looks up tycons/classes in the alternative global
75 @extendGlobalRnEnv@ adds global names to the RnEnv. It takes seperate
76 value and tycon/class name lists. It returns any duplicate names
79 @extendRnEnv@ adds new local names to the ScopeStack in an RnEnv.
80 It optionally reports any shadowed names.
84 = ((emptyFM, emptyFM, emptyFM, emptyFM), emptyFM)
87 extendGlobalRnEnv ((qual, unqual, tc_qual, tc_unqual), stack) val_list tc_list
88 = ASSERT(isEmptyFM stack)
89 (((qual', unqual', tc_qual, tc_unqual), stack), tc_dups `unionBags` dups)
91 (qual', unqual', dups) = extend_global qual unqual val_list
92 (tc_qual', tc_unqual', tc_dups) = extend_global tc_qual tc_unqual tc_list
94 extend_global qual unqual rdr_list = (qual', unqual', dups)
96 (qual_list, unqual_list) = partition (isQual.fst) rdr_list
97 qual_in = map mk_qual qual_list
98 unqual_in = map mk_unqual unqual_list
99 mk_qual (Qual m s, rn) = ((s,m), rn)
100 mk_unqual (Unqual s, rn) = (s, rn)
102 (qual', qual_dups) = do_dups qual_in qual emptyBag (\ (s,m) -> Qual m s)
103 (unqual', unqual_dups) = do_dups unqual_in unqual emptyBag Unqual
105 dups = unqual_dups `unionBags` qual_dups
107 do_dups [] fm dups to_rdr = (fm, dups)
108 do_dups ((k,v):rest) fm dups to_rdr
109 = case lookupFM fm k of
110 Nothing -> do_dups rest (addToFM fm k v) dups to_rdr
111 Just cur -> do_dups rest fm (dups `snocBag` (to_rdr k, cur, v)) to_rdr
114 extendLocalRnEnv report_shadows (global, stack) new_local
115 = ((global, new_stack), dups)
117 (new_stack, dups) = extend new_local stack
120 = if report_shadows then
121 do_shadows names stack []
123 (addListToFM stack [ (getLocalName n, n) | n <- names], [])
125 do_shadows [] stack dups = (stack, dups)
126 do_shadows (name:names) stack dups
127 = do_shadows names (addToFM stack str name) ext_dups
129 str = getLocalName name
130 ext_dups = if maybeToBool (lookupFM stack str)
135 lookupRnEnv ((qual, unqual, _, _), stack) rdr
137 Unqual str -> lookup stack str (lookup unqual str Nothing)
138 Qual mod str -> lookup qual (str,mod) Nothing
140 lookup fm thing do_on_fail
141 = case lookupFM fm thing of
142 found@(Just name) -> found
143 Nothing -> do_on_fail
145 lookupTcRnEnv ((_, _, tc_qual, tc_unqual), _) rdr
147 Unqual str -> lookupFM tc_unqual str
148 Qual mod str -> lookupFM tc_qual (str,mod)
151 *********************************************************
153 \subsection{Errors used in RnMonad}
155 *********************************************************
158 unknownNameErr descriptor name locn
159 = addShortErrLocLine locn ( \ sty ->
160 ppBesides [ppStr "undefined ", ppStr descriptor, ppStr ": ", pprNonOp sty name] )
162 badClassOpErr clas op locn
163 = addErrLoc locn "" ( \ sty ->
164 ppBesides [ppChar '`', pprNonOp sty op, ppStr "' is not an operation of class `",
165 ppr sty clas, ppStr "'"] )
167 qualNameErr descriptor (name,locn)
168 = addShortErrLocLine locn ( \ sty ->
169 ppBesides [ppStr "invalid use of qualified ", ppStr descriptor, ppStr ": ", pprNonOp sty name ] )
171 dupNamesErr descriptor ((name1,locn1) : dup_things) sty
172 = ppAboves (item1 : map dup_item dup_things)
175 = ppBesides [ ppr PprForUser locn1,
176 ppStr ": multiple declarations of a ", ppStr descriptor, ppStr ": ",
179 dup_item (name, locn)
180 = ppBesides [ ppr PprForUser locn,
181 ppStr ": here was another declaration of `", pprNonOp sty name, ppStr "'" ]
183 shadowedNameWarn locn shadow
184 = addShortErrLocLine locn ( \ sty ->
185 ppBesides [ppStr "more than one value with the same name (shadowing): ", ppr sty shadow] )
187 multipleOccWarn (name, occs) sty
188 = ppBesides [ppStr "multiple names used to refer to `", ppr sty name, ppStr "': ",
189 ppInterleave ppComma (map (ppr sty) occs)]