rnMonoBindsAndThen, renameSigs, checkSigs )
import RnEnv ( lookupTopBndrRn, lookupOccRn, lookupSysBndr,
newLocalsRn, lookupGlobalOccRn,
- bindLocalsFVRn, bindPatSigTyVars,
+ bindLocalsFV, bindPatSigTyVarsFV,
bindTyVarsRn, extendTyVarEnvFVRn,
bindCoreLocalRn, bindCoreLocalsRn, bindLocalNames,
checkDupOrQualNames, checkDupNames, mapFvRn,
lookupTopSrcBndr_maybe, lookupTopSrcBndr,
- dataTcOccs, unknownNameErr
+ dataTcOccs, newIPName, unknownNameErr
)
import TcRnMonad
-import BasicTypes ( FixitySig(..) )
+import BasicTypes ( FixitySig(..), TopLevelFlag(..) )
import HscTypes ( ExternalPackageState(..), FixityEnv,
Deprecations(..), plusDeprecs )
import Module ( moduleEnvElts )
import NameSet
import NameEnv
import ErrUtils ( dumpIfSet )
-import PrelNames ( newStablePtrName, bindIOName, returnIOName )
+import PrelNames ( newStablePtrName, bindIOName, returnIOName
+ -- dotnet interop
+ , objectTyConName,
+ , unmarshalObjectName, marshalObjectName
+ , unmarshalStringName, marshalStringName
+ , checkDotnetResName
+ )
import List ( partition )
import Bag ( bagToList )
import Outputable
\begin{code}
-rnSrcDecls :: HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name, FreeVars)
+rnSrcDecls :: HsGroup RdrName -> RnM (TcGblEnv, HsGroup Name, DefUses)
rnSrcDecls (HsGroup { hs_valds = MonoBind binds sigs _,
hs_tyclds = tycl_decls,
updGblEnv (\gbl -> gbl { tcg_fix_env = fix_env })
$ do {
- failIfErrsM ; -- No point in continuing if (say) we have duplicate declarations
-
-- Rename other declarations
- (rn_val_decls, src_fvs1) <- rnTopMonoBinds binds sigs ;
- (rn_inst_decls, src_fvs2) <- mapFvRn rnSrcInstDecl inst_decls ;
- (rn_tycl_decls, src_fvs3) <- mapFvRn rnSrcTyClDecl tycl_decls ;
- (rn_rule_decls, src_fvs4) <- mapFvRn rnHsRuleDecl rule_decls ;
- (rn_foreign_decls, src_fvs5) <- mapFvRn rnHsForeignDecl foreign_decls ;
- (rn_default_decls, src_fvs6) <- mapFvRn rnDefaultDecl default_decls ;
- (rn_core_decls, src_fvs7) <- mapFvRn rnCoreDecl core_decls ;
+ (rn_val_decls, bind_dus) <- rnTopMonoBinds binds sigs ;
+
+ -- You might think that we could build proper def/use information
+ -- for type and class declarations, but they can be involved
+ -- in mutual recursion across modules, and we only do the SCC
+ -- analysis for them in the type checker.
+ -- So we content ourselves with gathering uses only; that
+ -- means we'll only report a declaration as unused if it isn't
+ -- mentioned at all. Ah well.
+ (rn_tycl_decls, src_fvs1) <- mapFvRn rnSrcTyClDecl tycl_decls ;
+ (rn_inst_decls, src_fvs2) <- mapFvRn rnSrcInstDecl inst_decls ;
+ (rn_rule_decls, src_fvs3) <- mapFvRn rnHsRuleDecl rule_decls ;
+ (rn_foreign_decls, src_fvs4) <- mapFvRn rnHsForeignDecl foreign_decls ;
+ (rn_default_decls, src_fvs5) <- mapFvRn rnDefaultDecl default_decls ;
+ (rn_core_decls, src_fvs6) <- mapFvRn rnCoreDecl core_decls ;
let {
rn_group = HsGroup { hs_valds = rn_val_decls,
hs_defds = rn_default_decls,
hs_ruleds = rn_rule_decls,
hs_coreds = rn_core_decls } ;
- src_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs3, src_fvs4,
- src_fvs5, src_fvs6, src_fvs7] } ;
- traceRn (text "rnSrcDecls" <+> ppr (nameSetToList src_fvs)) ;
+ other_fvs = plusFVs [src_fvs1, src_fvs2, src_fvs3,
+ src_fvs4, src_fvs5, src_fvs6] ;
+ src_dus = bind_dus `plusDU` usesOnly other_fvs
+ } ;
+
tcg_env <- getGblEnv ;
- return (tcg_env, rn_group, src_fvs)
+ return (tcg_env, rn_group, src_dus)
}}}
\end{code}
of the loop too, and it must be defined in this module.
\begin{code}
-rnTopBinds :: RdrNameHsBinds -> RnM (RenamedHsBinds, FreeVars)
-rnTopBinds EmptyBinds = returnM (EmptyBinds, emptyFVs)
-rnTopBinds (MonoBind bind sigs _) = rnTopMonoBinds bind sigs
- -- The parser doesn't produce other forms
-
-rnBinds :: RdrNameHsBinds -> RnM (RenamedHsBinds, FreeVars)
+rnBinds :: RdrNameHsBinds -> RnM (RenamedHsBinds, DefUses)
-- This version assumes that the binders are already in scope
-rnBinds EmptyBinds = returnM (EmptyBinds, emptyFVs)
-rnBinds (MonoBind bind sigs _) = rnMonoBinds bind sigs
- -- The parser doesn't produce other forms
+-- It's used only in 'mdo'
+rnBinds EmptyBinds = returnM (EmptyBinds, emptyDUs)
+rnBinds (MonoBind bind sigs _) = rnMonoBinds NotTopLevel bind sigs
+rnBinds b@(IPBinds bind _) = addErr (badIpBinds b) `thenM_`
+ returnM (EmptyBinds, emptyDUs)
rnBindsAndThen :: RdrNameHsBinds
-> (RenamedHsBinds -> RnM (result, FreeVars))
-> RnM (result, FreeVars)
-- This version (a) assumes that the binding vars are not already in scope
-- (b) removes the binders from the free vars of the thing inside
-rnBindsAndThen EmptyBinds thing_inside = thing_inside EmptyBinds
-rnBindsAndThen (MonoBind bind sigs _) thing_inside = rnMonoBindsAndThen bind sigs thing_inside
- -- The parser doesn't produce other forms
+-- The parser doesn't produce ThenBinds
+rnBindsAndThen EmptyBinds thing_inside = thing_inside EmptyBinds
+rnBindsAndThen (MonoBind bind sigs _) thing_inside = rnMonoBindsAndThen bind sigs thing_inside
+rnBindsAndThen (IPBinds binds is_with) thing_inside
+ = warnIf is_with withWarning `thenM_`
+ rnIPBinds binds `thenM` \ (binds',fv_binds) ->
+ thing_inside (IPBinds binds' is_with) `thenM` \ (thing, fvs_thing) ->
+ returnM (thing, fvs_thing `plusFV` fv_binds)
+\end{code}
+
+
+%************************************************************************
+%* *
+\subsubsection{@rnIPBinds@s: in implicit parameter bindings} *
+%* *
+%************************************************************************
+
+\begin{code}
+rnIPBinds [] = returnM ([], emptyFVs)
+rnIPBinds ((n, expr) : binds)
+ = newIPName n `thenM` \ name ->
+ rnExpr expr `thenM` \ (expr',fvExpr) ->
+ rnIPBinds binds `thenM` \ (binds',fvBinds) ->
+ returnM ((name, expr') : binds', fvExpr `plusFV` fvBinds)
+
\end{code}
returnM (ForeignImport name' ty' spec isDeprec src_loc,
fvs `plusFV` extras spec)
where
- extras (CImport _ _ _ _ CWrapper) = mkFVs [newStablePtrName,
- bindIOName, returnIOName]
+ extras (CImport _ _ _ _ CWrapper)
+ = mkFVs [ newStablePtrName
+ , bindIOName
+ , returnIOName
+ ]
+ extras (DNImport _)
+ = mkFVs [ bindIOName
+ , objectTyConName
+ , unmarshalObjectName
+ , marshalObjectName
+ , marshalStringName
+ , unmarshalStringName
+ , checkDotnetResName
+ ]
extras _ = emptyFVs
rnHsForeignDecl (ForeignExport name ty spec isDeprec src_loc)
--
-- But the (unqualified) method names are in scope
bindLocalNames binders (renameSigs uprags) `thenM` \ uprags' ->
- checkSigs okInstDclSig (mkNameSet binders) uprags' `thenM_`
+ checkSigs (okInstDclSig (mkNameSet binders)) uprags' `thenM_`
returnM (InstDecl inst_ty mbinds' uprags' maybe_dfun_name src_loc,
meth_fvs `plusFV` hsSigsFVs uprags')
returnM (IfaceRuleOut fn' rule)
rnHsRuleDecl (HsRule rule_name act vars lhs rhs src_loc)
- = addSrcLoc src_loc $
- bindPatSigTyVars (collectRuleBndrSigTys vars) $
+ = addSrcLoc src_loc $
+ bindPatSigTyVarsFV (collectRuleBndrSigTys vars) $
- bindLocalsFVRn doc (map get_var vars) $ \ ids ->
+ bindLocalsFV doc (map get_var vars) $ \ ids ->
mapFvRn rn_var (vars `zip` ids) `thenM` \ (vars', fv_vars) ->
rnExpr lhs `thenM` \ (lhs', fv_lhs) ->
in
checkDupOrQualNames sig_doc sig_rdr_names_w_locs `thenM_`
mappM (rnClassOp cname' fds') op_sigs `thenM` \ sigs' ->
- let
- binders = mkNameSet [ nm | (ClassOpSig nm _ _ _) <- sigs' ]
- in
- renameSigs non_op_sigs `thenM` \ non_ops' ->
- checkSigs okClsDclSig binders non_ops' `thenM_`
+ renameSigs non_op_sigs `thenM` \ non_ops' ->
+ checkSigs okClsDclSig non_ops' `thenM_`
-- Typechecker is responsible for checking that we only
-- give default-method bindings for things in this class.
-- The renamer *could* check this for class decls, but can't
rnNote (UfSCC cc) = returnM (UfSCC cc)
rnNote UfInlineCall = returnM UfInlineCall
rnNote UfInlineMe = returnM UfInlineMe
-
+rnNote (UfCoreNote s) = returnM (UfCoreNote s)
rnUfCon UfDefault
= returnM UfDefault
emptyConDeclsErr tycon
= sep [quotes (ppr tycon) <+> ptext SLIT("has no constructors"),
nest 4 (ptext SLIT("(-fglasgow-exts permits this)"))]
+
+withWarning
+ = sep [quotes (ptext SLIT("with")),
+ ptext SLIT("is deprecated, use"),
+ quotes (ptext SLIT("let")),
+ ptext SLIT("instead")]
+
+badIpBinds binds
+ = hang (ptext SLIT("Implicit-parameter bindings illegal in 'mdo':")) 4
+ (ppr binds)
\end{code}
+