rnTopBinds :: HsValBinds RdrName
-> RnM (HsValBinds Name, DefUses)
rnTopBinds b =
- do nl <- rnTopBindsLHS emptyOccEnv b
+ do nl <- rnTopBindsLHS emptyFsEnv b
let bound_names = map unLoc (collectHsValBinders nl)
bindLocalNames bound_names $ rnTopBindsRHS bound_names nl
makeMiniFixityEnv :: [LFixitySig RdrName] -> RnM MiniFixityEnv
-makeMiniFixityEnv decls = foldlM add_one emptyOccEnv decls
+makeMiniFixityEnv decls = foldlM add_one emptyFsEnv decls
where
add_one env (L loc (FixitySig (L name_loc name) fixity)) = do
{ -- this fixity decl is a duplicate iff
-- the ReaderName's OccName's FastString is already in the env
-- (we only need to check the local fix_env because
-- definitions of non-local will be caught elsewhere)
- let {occ = rdrNameOcc name;
- fix_item = L loc fixity};
+ let { fs = occNameFS (rdrNameOcc name)
+ ; fix_item = L loc fixity };
- case lookupOccEnv env occ of
- Nothing -> return $ extendOccEnv env occ fix_item
+ case lookupFsEnv env fs of
+ Nothing -> return $ extendFsEnv env fs fix_item
Just (L loc' _) -> do
{ setSrcSpan loc $
addLocErr (L name_loc name) (dupFixityDecl loc')
newLocalsRn, newIPNameRn,
bindLocalNames, bindLocalNamesFV,
- MiniFixityEnv, bindLocalNamesFV_WithFixities,
+ MiniFixityEnv, emptyFsEnv, extendFsEnv, lookupFsEnv,
+ bindLocalNamesFV_WithFixities,
bindLocatedLocalsFV, bindLocatedLocalsRn,
bindSigTyVarsFV, bindPatSigTyVars, bindPatSigTyVarsFV,
bindTyVarsRn, extendTyVarEnvFVRn,
- bindLocalFixities,
checkDupRdrNames, checkDupNames, checkShadowedNames,
checkDupAndShadowedRdrNames,
%*********************************************************
\begin{code}
-lookupLocalDataTcNames :: RdrName -> RnM [Name]
--- GHC extension: look up both the tycon and data con
--- for con-like things
--- Complain if neither is in scope
-lookupLocalDataTcNames rdr_name
- | Just n <- isExact_maybe rdr_name
- -- Special case for (:), which doesn't get into the GlobalRdrEnv
- = return [n] -- For this we don't need to try the tycon too
- | otherwise
- = do { mb_gres <- mapM lookupGreLocalRn (dataTcOccs rdr_name)
- ; case [gre_name gre | Just gre <- mb_gres] of
- [] -> do {
- -- run for error reporting
- ; unboundName rdr_name
- ; return [] }
- names -> return names
- }
+--------------------------------
+type FastStringEnv a = UniqFM a -- Keyed by FastString
+
+
+emptyFsEnv :: FastStringEnv a
+lookupFsEnv :: FastStringEnv a -> FastString -> Maybe a
+extendFsEnv :: FastStringEnv a -> FastString -> a -> FastStringEnv a
+
+emptyFsEnv = emptyUFM
+lookupFsEnv = lookupUFM
+extendFsEnv = addToUFM
--------------------------------
-type MiniFixityEnv = OccEnv (Located Fixity)
+type MiniFixityEnv = FastStringEnv (Located Fixity)
-- Mini fixity env for the names we're about
-- to bind, in a single binding group
--
+ -- It is keyed by the *FastString*, not the *OccName*, because
+ -- the single fixity decl infix 3 T
+ -- affects both the data constructor T and the type constrctor T
+ --
-- We keep the location so that if we find
-- a duplicate, we can report it sensibly
-bindLocalFixities :: [FixitySig RdrName] -> (UniqFM (Located Fixity) -> RnM a) -> RnM a
--- Used for nested fixity decls:
--- bind the names that are in scope already;
--- pass the rest to the continuation for later
--- as a FastString->(Located Fixity) map
---
--- No need to worry about type constructors here,
--- Should check for duplicates?
-bindLocalFixities fixes thing_inside
- | null fixes = thing_inside emptyUFM
- | otherwise = do ls <- mappM rn_sig fixes
- let (now, later) = nowAndLater ls
- extendFixityEnv now $ thing_inside later
- where
- rn_sig (FixitySig lv@(L loc v) fix) = do
- vopt <- lookupBndrRn_maybe v
- case vopt of
- Just new_v -> returnM (Left (new_v, (FixItem (rdrNameOcc v) fix)))
- Nothing -> returnM (Right (occNameFS $ rdrNameOcc v, (L loc fix)))
-
- nowAndLater :: [Either (Name, FixItem) (FastString, Located Fixity)]
- -> ([(Name,FixItem)], UniqFM (Located Fixity))
- nowAndLater ls =
- foldr (\ cur -> \ (now, later) ->
- case cur of
- Left (n, f) -> ((n, f) : now, later)
- Right (fs, f) -> (now, addToUFM later fs f))
- ([], emptyUFM) ls
-
+--------------------------------
-- Used for nested fixity decls to bind names along with their fixities.
-- the fixities are given as a UFM from an OccName's FastString to a fixity decl
-- Also check for unused binders
boundFixities = foldr
(\ name -> \ acc ->
-- check whether this name has a fixity decl
- case lookupOccEnv fixities (nameOccName name) of
+ case lookupFsEnv fixities (occNameFS (nameOccName name)) of
Just (L _ fix) -> (name, FixItem (nameOccName name) fix) : acc
Nothing -> acc) [] names
-- bind the names; extend the fixity env; do the thing inside
lookupTyFixityRn (L loc n) = lookupFixityRn n
---------------
+lookupLocalDataTcNames :: RdrName -> RnM [Name]
+-- GHC extension: look up both the tycon and data con
+-- for con-like things
+-- Complain if neither is in scope
+lookupLocalDataTcNames rdr_name
+ | Just n <- isExact_maybe rdr_name
+ -- Special case for (:), which doesn't get into the GlobalRdrEnv
+ = return [n] -- For this we don't need to try the tycon too
+ | otherwise
+ = do { mb_gres <- mapM lookupGreLocalRn (dataTcOccs rdr_name)
+ ; case [gre_name gre | Just gre <- mb_gres] of
+ [] -> do {
+ -- run for error reporting
+ ; unboundName rdr_name
+ ; return [] }
+ names -> return names
+ }
+
dataTcOccs :: RdrName -> [RdrName]
-- If the input is a data constructor, return both it and a type
-- constructor. This is useful when we aren't sure which we are
* the ImportAvails
created by its bindings.
-Note [Shadowing in extendRdrEnvRn]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Note [Shadowing in extendGlobalRdrEnvRn]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Usually when etending the GlobalRdrEnv we complain if a new binding
duplicates an existing one. By adding the bindings one at a time,
this check also complains if we add two new bindings for the same name.
-- Delete new_occs from global and local envs
-- We are going to shadow them
+ -- See Note [Shadowing in extendGlobalRdrEnvRn]
new_occs = map (nameOccName . gre_name) gres
rdr_env1 = hideSomeUnquals rdr_env new_occs
lcl_env1 = lcl_env { tcl_rdr = delListFromOccEnv (tcl_rdr lcl_env) new_occs }
; (rdr_env', fix_env') <- foldlM extend (rdr_env2, fix_env) gres
; let gbl_env' = gbl_env { tcg_rdr_env = rdr_env', tcg_fix_env = fix_env' }
+ ; traceRn (text "extendGlobalRdrEnvRn" <+> (ppr new_fixities $$ ppr fix_env $$ ppr fix_env'))
; return (gbl_env', lcl_env2) }
where
gres = gresFromAvails LocalDef avails
simple_extend (rdr_env, fix_env) gre
= (extendGlobalRdrEnv rdr_env gre, fix_env')
where
- -- If there is a fixity decl for the gre,
- -- add it to the fixity env
+ -- If there is a fixity decl for the gre, add it to the fixity env
name = gre_name gre
- occ = nameOccName name
- fix_env' = case lookupOccEnv new_fixities occ of
+ occ = nameOccName name
+ fix_env' = case lookupFsEnv new_fixities (occNameFS occ) of
Nothing -> fix_env
Just (L _ fi) -> extendNameEnv fix_env name (FixItem occ fi)
\end{code}
-- (I) Compute the results and return
let {rn_group = HsGroup { hs_valds = rn_val_decls,
- hs_tyclds = rn_tycl_decls,
- hs_instds = rn_inst_decls,
+ hs_tyclds = rn_tycl_decls,
+ hs_instds = rn_inst_decls,
hs_derivds = rn_deriv_decls,
- hs_fixds = rn_fix_decls,
- hs_depds = [], -- deprecs are returned in the tcg_env (see below)
- -- not in the HsGroup
- hs_fords = rn_foreign_decls,
- hs_defds = rn_default_decls,
- hs_ruleds = rn_rule_decls,
+ hs_fixds = rn_fix_decls,
+ hs_depds = [], -- deprecs are returned in the tcg_env
+ -- (see below) not in the HsGroup
+ hs_fords = rn_foreign_decls,
+ hs_defds = rn_default_decls,
+ hs_ruleds = rn_rule_decls,
hs_docs = rn_docs } ;
other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs6, src_fvs3,
-- Rename the fixity decls, so we can put
-- the renamed decls in the renamed syntax tree
-- Errors if the thing being fixed is not defined locally.
+--
+-- The returned FixitySigs are not actually used for anything,
+-- except perhaps the GHCi API
rnSrcFixityDecls fix_decls
= do fix_decls <- mapM rn_decl fix_decls
return (concat fix_decls)
-- GHC extension: look up both the tycon and data con
-- for con-like things; hence returning a list
-- If neither are in scope, report an error; otherwise
- -- add both to the fixity env
+ -- return a fixity sig for each (slightly odd)
rn_decl (L loc (FixitySig (L name_loc rdr_name) fixity))
= setSrcSpan name_loc $
-- this lookup will fail if the definition isn't local
projects / ghc-hetmet.git / commitdiff