bindTyVarsRn, extendTyVarEnvFVRn,
bindLocalNames, checkDupRdrNames, mapFvRn, lookupGreLocalRn,
)
-import RnNames (importsFromLocalDecls, extendRdrEnvRn)
-import HscTypes (GenAvailInfo(..))
+import RnNames ( getLocalNonValBinders, extendGlobalRdrEnvRn )
+import HscTypes ( GenAvailInfo(..) )
import RnHsDoc ( rnHsDoc, rnMbLHsDoc )
import TcRnMonad
import Name ( Name, nameOccName )
import NameSet
import NameEnv
-import UniqFM
+import LazyUniqFM
import OccName
import Outputable
+import FastString
import SrcLoc ( Located(..), unLoc, noLoc )
import DynFlags ( DynFlag(..) )
import Maybe ( isNothing )
\begin{code}
--- brings the binders of the group into scope in the appropriate places;
+-- Brings the binders of the group into scope in the appropriate places;
-- does NOT assume that anything is in scope already
--
--- the Bool determines whether (True) names in the group shadow existing
+-- The Bool determines whether (True) names in the group shadow existing
-- Unquals in the global environment (used in Template Haskell) or
-- (False) whether duplicates are reported as an error
rnSrcDecls :: Bool -> HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name)
local_fix_env <- makeMiniFixityEnv fix_decls;
-- (B) Bring top level binders (and their fixities) into scope,
- -- except for the value bindings, which get brought in below.
- inNewEnv (importsFromLocalDecls shadowP group local_fix_env) $ \ tcg_env -> do {
+ -- *except* for the value bindings, which get brought in below.
+ avails <- getLocalNonValBinders group ;
+ tc_envs <- extendGlobalRdrEnvRn shadowP avails local_fix_env ;
+ setEnvs tc_envs $ do {
failIfErrsM ; -- No point in continuing if (say) we have duplicate declarations
-- extend the record field env.
-- This depends on the data constructors and field names being in
-- scope from (B) above
- inNewEnv (extendRecordFieldEnv tycl_decls) $ \ tcg_env -> do {
+ inNewEnv (extendRecordFieldEnv tycl_decls) $ \ _ -> do {
-- (D) Rename the left-hand sides of the value bindings.
-- This depends on everything from (B) being in scope,
let { lhs_binders = map unLoc $ collectHsValBinders new_lhs;
lhs_avails = map Avail lhs_binders
} ;
- inNewEnv (extendRdrEnvRn shadowP (tcg_rdr_env tcg_env, tcg_fix_env tcg_env)
- lhs_avails local_fix_env
- >>= \ (new_rdr_env, new_fix_env) ->
- return (tcg_env { tcg_rdr_env = new_rdr_env,
- tcg_fix_env = new_fix_env
- })) $ \tcg_env -> do {
+ (tcg_env, tcl_env) <- extendGlobalRdrEnvRn shadowP lhs_avails local_fix_env ;
+ setEnvs (tcg_env, tcl_env) $ do {
-- Now everything is in scope, as the remaining renaming assumes.
-- (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
(map (\ (L loc (Deprecation rdr_name _)) -> L loc rdr_name) decls)
dupDeprecDecl (L loc _) rdr_name
- = vcat [ptext SLIT("Multiple deprecation declarations for") <+> quotes (ppr rdr_name),
- ptext SLIT("also at ") <+> ppr loc]
+ = vcat [ptext (sLit "Multiple deprecation declarations for") <+> quotes (ppr rdr_name),
+ ptext (sLit "also at ") <+> ppr loc]
\end{code}
-- we add it to the free-variable list. It might, for example,
-- be imported from another module
-fo_decl_msg name = ptext SLIT("In the foreign declaration for") <+> ppr name
+fo_decl_msg name = ptext (sLit "In the foreign declaration for") <+> ppr name
\end{code}
returnM (RuleBndrSig (L loc id) t', fvs)
badRuleVar name var
- = sep [ptext SLIT("Rule") <+> doubleQuotes (ftext name) <> colon,
- ptext SLIT("Forall'd variable") <+> quotes (ppr var) <+>
- ptext SLIT("does not appear on left hand side")]
+ = sep [ptext (sLit "Rule") <+> doubleQuotes (ftext name) <> colon,
+ ptext (sLit "Forall'd variable") <+> quotes (ppr var) <+>
+ ptext (sLit "does not appear on left hand side")]
\end{code}
Note [Rule LHS validity checking]
-}
badRuleLhsErr name lhs bad_e
- = sep [ptext SLIT("Rule") <+> ftext name <> colon,
- nest 4 (vcat [ptext SLIT("Illegal expression:") <+> ppr bad_e,
- ptext SLIT("in left-hand side:") <+> ppr lhs])]
+ = sep [ptext (sLit "Rule") <+> ftext name <> colon,
+ nest 4 (vcat [ptext (sLit "Illegal expression:") <+> ppr bad_e,
+ ptext (sLit "in left-hand side:") <+> ppr lhs])]
$$
- ptext SLIT("LHS must be of form (f e1 .. en) where f is not forall'd")
+ ptext (sLit "LHS must be of form (f e1 .. en) where f is not forall'd")
\end{code}
; (derivs', deriv_fvs) <- rn_derivs derivs
; condecls' <- rnConDecls (unLoc tycon') condecls
-- No need to check for duplicate constructor decls
- -- since that is done by RnNames.extendRdrEnvRn
+ -- since that is done by RnNames.extendGlobalRdrEnvRn
; returnM (TyData {tcdND = new_or_data, tcdCtxt = context',
tcdLName = tycon', tcdTyVars = tyvars',
tcdTyPats = typats', tcdKindSig = Nothing,
; (derivs', deriv_fvs) <- rn_derivs derivs
; condecls' <- rnConDecls (unLoc tycon') condecls
-- No need to check for duplicate constructor decls
- -- since that is done by RnNames.extendRdrEnvRn
+ -- since that is done by RnNames.extendGlobalRdrEnvRn
; returnM (TyData {tcdND = new_or_data, tcdCtxt = noLoc [],
tcdLName = tycon', tcdTyVars = tyvars',
tcdTyPats = Nothing, tcdKindSig = sig,
; return (tyvars', context', fds', ats', ats_fvs, sigs') }
-- No need to check for duplicate associated type decls
- -- since that is done by RnNames.extendRdrEnvRn
+ -- since that is done by RnNames.extendGlobalRdrEnvRn
-- Check the signatures
-- First process the class op sigs (op_sigs), then the fixity sigs (non_op_sigs).
gen_rdr_tyvars_w_locs = [ tv | tv <- extractGenericPatTyVars mbinds,
not (unLoc tv `elemLocalRdrEnv` name_env) ]
-- No need to check for duplicate method signatures
- -- since that is done by RnNames.extendRdrEnvRn
+ -- since that is done by RnNames.extendGlobalRdrEnvRn
-- and the methods are already in scope
; gen_tyvars <- newLocalsRn gen_rdr_tyvars_w_locs
; rnMethodBinds (unLoc cname') (mkSigTvFn sigs') gen_tyvars mbinds }
at_doc = text "In the associated types for class" <+> ppr cname
badGadtStupidTheta tycon
- = vcat [ptext SLIT("No context is allowed on a GADT-style data declaration"),
- ptext SLIT("(You can put a context on each contructor, though.)")]
+ = vcat [ptext (sLit "No context is allowed on a GADT-style data declaration"),
+ ptext (sLit "(You can put a context on each contructor, though.)")]
\end{code}
%*********************************************************
rnConDeclDetails doc (RecCon fields)
= do { new_fields <- mappM (rnField doc) fields
-- No need to check for duplicate fields
- -- since that is done by RnNames.extendRdrEnvRn
+ -- since that is done by RnNames.extendGlobalRdrEnvRn
; return (RecCon new_fields) }
rnField doc (ConDeclField name ty haddock_doc)
noPatterns = text "Default definition for an associated synonym cannot have"
<+> text "type pattern"
-repeatedTyVar tv = ptext SLIT("Illegal repeated type variable") <+>
+repeatedTyVar tv = ptext (sLit "Illegal repeated type variable") <+>
quotes (ppr tv)
-- This data decl will parse OK
checkConName name = checkErr (isRdrDataCon name) (badDataCon name)
badDataCon name
- = hsep [ptext SLIT("Illegal data constructor name"), quotes (ppr name)]
+ = hsep [ptext (sLit "Illegal data constructor name"), quotes (ppr name)]
\end{code}
checkTH e what = returnM () -- OK
#else
checkTH e what -- Raise an error in a stage-1 compiler
- = addErr (vcat [ptext SLIT("Template Haskell") <+> text what <+>
- ptext SLIT("illegal in a stage-1 compiler"),
+ = addErr (vcat [ptext (sLit "Template Haskell") <+> text what <+>
+ ptext (sLit "illegal in a stage-1 compiler"),
nest 2 (ppr e)])
#endif
\end{code}
projects / ghc-hetmet.git / blobdiff