\section[RnSource]{Main pass of renamer}
\begin{code}
-module RnSource ( rnDecl, rnTyClDecl, rnIfaceRuleDecl, rnInstDecl, rnSourceDecls,
+module RnSource ( rnTyClDecl, rnIfaceRuleDecl, rnInstDecl, rnSourceDecls,
rnHsType, rnHsSigType, rnHsTypeFVs, rnHsSigTypeFVs
) where
import HsSyn
import HscTypes ( GlobalRdrEnv )
import HsTypes ( hsTyVarNames, pprHsContext )
-import RdrName ( RdrName, isRdrDataCon, rdrNameOcc, mkRdrNameWkr, elemRdrEnv )
+import RdrName ( RdrName, isRdrDataCon, elemRdrEnv )
import RdrHsSyn ( RdrNameContext, RdrNameHsType, RdrNameConDecl, RdrNameTyClDecl,
extractRuleBndrsTyVars, extractHsTyRdrTyVars,
extractHsCtxtRdrTyVars, extractGenericPatTyVars
import RnMonad
import Class ( FunDep, DefMeth (..) )
-import Name ( Name, OccName, nameOccName, NamedThing(..) )
+import DataCon ( dataConId )
+import Name ( Name, NamedThing(..) )
import NameSet
import PrelInfo ( derivableClassKeys, cCallishClassKeys )
import PrelNames ( deRefStablePtr_RDR, newStablePtr_RDR,
bindIO_RDR, returnIO_RDR
)
+import TysWiredIn ( tupleCon )
import List ( partition, nub )
import Outputable
import SrcLoc ( SrcLoc )
import CmdLineOpts ( DynFlag(..) )
-- Warn of unused for-all'd tyvars
import Unique ( Uniquable(..) )
+import Maybes ( maybeToBool )
import ErrUtils ( Message )
import CStrings ( isCLabelString )
import ListSetOps ( removeDupsEq )
\end{code}
-@rnDecl@ `renames' declarations.
+@rnSourceDecl@ `renames' declarations.
It simultaneously performs dependency analysis and precedence parsing.
It also does the following error checks:
\begin{enumerate}
%*********************************************************
%* *
-\subsection{Value declarations}
+\subsection{Source code declarations}
%* *
%*********************************************************
-- The decls get reversed, but that's ok
rnSourceDecls gbl_env local_fixity_env decls
- = initRnMS gbl_env local_fixity_env SourceMode (go emptyFVs [] decls)
+ = initRnMS gbl_env emptyRdrEnv local_fixity_env SourceMode (go emptyFVs [] decls)
where
-- Fixity and deprecations have been dealt with already; ignore them
go fvs ds' [] = returnRn (ds', fvs)
go fvs ds' (FixD _:ds) = go fvs ds' ds
go fvs ds' (DeprecD _:ds) = go fvs ds' ds
- go fvs ds' (d:ds) = rnDecl d `thenRn` \(d', fvs') ->
+ go fvs ds' (d:ds) = rnSourceDecl d `thenRn` \(d', fvs') ->
go (fvs `plusFV` fvs') (d':ds') ds
-\end{code}
-
-%*********************************************************
-%* *
-\subsection{Value declarations}
-%* *
-%*********************************************************
-\begin{code}
--- rnDecl does all the work
-rnDecl :: RdrNameHsDecl -> RnMS (RenamedHsDecl, FreeVars)
+rnSourceDecl :: RdrNameHsDecl -> RnMS (RenamedHsDecl, FreeVars)
-rnDecl (ValD binds) = rnTopBinds binds `thenRn` \ (new_binds, fvs) ->
- returnRn (ValD new_binds, fvs)
+rnSourceDecl (ValD binds) = rnTopBinds binds `thenRn` \ (new_binds, fvs) ->
+ returnRn (ValD new_binds, fvs)
-rnDecl (TyClD tycl_decl)
+rnSourceDecl (TyClD tycl_decl)
= rnTyClDecl tycl_decl `thenRn` \ new_decl ->
rnClassBinds tycl_decl new_decl `thenRn` \ (new_decl', fvs) ->
returnRn (TyClD new_decl', fvs `plusFV` tyClDeclFVs new_decl')
-rnDecl (InstD inst)
+rnSourceDecl (InstD inst)
= rnInstDecl inst `thenRn` \ new_inst ->
rnInstBinds inst new_inst `thenRn` \ (new_inst', fvs) ->
returnRn (InstD new_inst', fvs `plusFV` instDeclFVs new_inst')
-rnDecl (RuleD rule)
- | isIfaceRuleDecl rule
- = rnIfaceRuleDecl rule `thenRn` \ new_rule ->
- returnRn (RuleD new_rule, ruleDeclFVs new_rule)
- | otherwise
+rnSourceDecl (RuleD rule)
= rnHsRuleDecl rule `thenRn` \ (new_rule, fvs) ->
returnRn (RuleD new_rule, fvs)
-rnDecl (DefD (DefaultDecl tys src_loc))
+rnSourceDecl (DefD (DefaultDecl tys src_loc))
= pushSrcLocRn src_loc $
mapFvRn (rnHsTypeFVs doc_str) tys `thenRn` \ (tys', fvs) ->
returnRn (DefD (DefaultDecl tys' src_loc), fvs)
where
doc_str = text "a `default' declaration"
-rnDecl (ForD (ForeignDecl name imp_exp ty ext_nm cconv src_loc))
+rnSourceDecl (ForD (ForeignDecl name imp_exp ty ext_nm cconv src_loc))
= pushSrcLocRn src_loc $
lookupOccRn name `thenRn` \ name' ->
let
\begin{code}
rnInstDecl (InstDecl inst_ty mbinds uprags maybe_dfun_rdr_name src_loc)
+ -- Used for both source and interface file decls
= pushSrcLocRn src_loc $
rnHsSigType (text "an instance decl") inst_ty `thenRn` \ inst_ty' ->
returnRn (InstDecl inst_ty' EmptyMonoBinds [] maybe_dfun_name src_loc)
-- Compare rnClassBinds
-rnInstBinds (InstDecl _ mbinds uprags _ _ )
- (InstDecl inst_ty _ _ maybe_dfun_rdr_name src_loc)
- = let
+rnInstBinds (InstDecl _ mbinds uprags _ _ )
+ (InstDecl inst_ty _ _ maybe_dfun_name src_loc)
+ -- Used for both source decls only
+ = ASSERT( not (maybeToBool maybe_dfun_name) ) -- Source decl!
+ let
meth_doc = text "the bindings in an instance declaration"
meth_names = collectLocatedMonoBinders mbinds
inst_tyvars = case inst_ty of
renameSigsFVs (okInstDclSig binder_set) uprags
) `thenRn` \ (uprags', prag_fvs) ->
- returnRn (InstDecl inst_ty mbinds' uprags' maybe_dfun_rdr_name src_loc,
+ returnRn (InstDecl inst_ty mbinds' uprags' maybe_dfun_name src_loc,
meth_fvs `plusFV` prag_fvs)
\end{code}
-- For H98 we do *not* universally quantify on the RHS of a synonym
-- Silently discard context... but the tyvars in the rest won't be in scope
+ -- In interface files all types are quantified, so this is a no-op
unquantify glaExts (HsForAllTy Nothing ctxt ty) | glaExts = ty
unquantify glaExys ty = ty
rnTyClDecl (ClassDecl {tcdCtxt = context, tcdName = cname,
tcdTyVars = tyvars, tcdFDs = fds, tcdSigs = sigs,
tcdSysNames = names, tcdLoc = src_loc})
+ -- Used for both source and interface file decls
= pushSrcLocRn src_loc $
lookupTopBndrRn cname `thenRn` \ cname' ->
returnRn (ClassOpSig op_name dm_stuff' new_ty locn)
rnClassBinds :: RdrNameTyClDecl -> RenamedTyClDecl -> RnMS (RenamedTyClDecl, FreeVars)
- -- Rename the mbinds only; the rest is done already
-rnClassBinds (ClassDecl {tcdMeths = Nothing}) rn_cls_decl
- = returnRn (rn_cls_decl, emptyFVs) -- No meth binds; decl came from interface file
-
-rnClassBinds (ClassDecl {tcdMeths = Just mbinds}) -- Get mbinds from here
- rn_cls_decl@(ClassDecl {tcdTyVars = tyvars, tcdLoc = src_loc}) -- Everything else is here
+ -- Used for source file decls only
+rnClassBinds (ClassDecl {tcdMeths = Just mbinds}) -- Get mbinds from here
+ rn_cls_decl@(ClassDecl {tcdTyVars = tyvars, tcdLoc = src_loc}) -- Everything else is here
+ -- There are some default-method bindings (abeit possibly empty) so
+ -- this is a source-code class declaration
= -- The newLocals call is tiresome: given a generic class decl
-- class C a where
-- op :: a -> a
-- Unboxed tuples are allowed to have poly-typed arguments. These
-- sometimes crop up as a result of CPR worker-wrappering dictionaries.
-rnHsType doc (HsTupleTy (HsTupCon _ boxity) tys)
+rnHsType doc (HsTupleTy (HsTupCon _ boxity arity) tys)
-- Don't do lookupOccRn, because this is built-in syntax
-- so it doesn't need to be in scope
= mapRn (rnHsType doc) tys `thenRn` \ tys' ->
- returnRn (HsTupleTy (HsTupCon n' boxity) tys')
+ returnRn (HsTupleTy (HsTupCon tup_name boxity arity) tys')
where
- n' = tupleTyCon_name boxity (length tys)
+ tup_name = tupleTyCon_name boxity arity
rnHsType doc (HsAppTy ty1 ty2)
\end{code}
\begin{code}
--- We use lookupOcc here because this is interface file only stuff
--- and we need the workers...
-rnHsTupCon (HsTupCon n boxity)
- = lookupOccRn n `thenRn` \ n' ->
- returnRn (HsTupCon n' boxity)
-
-rnHsTupConWkr (HsTupCon n boxity)
- -- Tuple construtors are for the *worker* of the tuple
- -- Going direct saves needless messing about
- = lookupOccRn (mkRdrNameWkr n) `thenRn` \ n' ->
- returnRn (HsTupCon n' boxity)
-\end{code}
-
-\begin{code}
rnForAll doc forall_tyvars ctxt ty
= bindTyVarsRn doc forall_tyvars $ \ new_tyvars ->
rnContext doc ctxt `thenRn` \ new_ctxt ->
= rnHsType (text "ccall") ty `thenRn` \ ty' ->
returnRn (UfCCall cc ty')
-rnCoreExpr (UfTuple con args)
- = rnHsTupConWkr con `thenRn` \ con' ->
- mapRn rnCoreExpr args `thenRn` \ args' ->
- returnRn (UfTuple con' args')
+rnCoreExpr (UfTuple (HsTupCon _ boxity arity) args)
+ = mapRn rnCoreExpr args `thenRn` \ args' ->
+ returnRn (UfTuple (HsTupCon tup_name boxity arity) args')
+ where
+ tup_name = getName (dataConId (tupleCon boxity arity))
+ -- Get the *worker* name and use that
rnCoreExpr (UfApp fun arg)
= rnCoreExpr fun `thenRn` \ fun' ->
\begin{code}
rnCoreAlt (con, bndrs, rhs)
- = rnUfCon con bndrs `thenRn` \ con' ->
+ = rnUfCon con `thenRn` \ con' ->
bindCoreLocalsRn bndrs $ \ bndrs' ->
rnCoreExpr rhs `thenRn` \ rhs' ->
returnRn (con', bndrs', rhs')
rnNote UfInlineMe = returnRn UfInlineMe
-rnUfCon UfDefault _
+rnUfCon UfDefault
= returnRn UfDefault
-rnUfCon (UfTupleAlt tup_con) bndrs
- = rnHsTupCon tup_con `thenRn` \ (HsTupCon con' _) ->
- returnRn (UfDataAlt con')
- -- Makes the type checker a little easier
+rnUfCon (UfTupleAlt (HsTupCon _ boxity arity))
+ = returnRn (UfTupleAlt (HsTupCon tup_name boxity arity))
+ where
+ tup_name = getName (tupleCon boxity arity)
-rnUfCon (UfDataAlt con) _
+rnUfCon (UfDataAlt con)
= lookupOccRn con `thenRn` \ con' ->
returnRn (UfDataAlt con')
-rnUfCon (UfLitAlt lit) _
+rnUfCon (UfLitAlt lit)
= returnRn (UfLitAlt lit)
-rnUfCon (UfLitLitAlt lit ty) _
+rnUfCon (UfLitLitAlt lit ty)
= rnHsType (text "litlit") ty `thenRn` \ ty' ->
returnRn (UfLitLitAlt lit ty')
\end{code}
projects / ghc-hetmet.git / blobdiff