module RnBinds (
rnTopBinds,
rnLocalBindsAndThen, rnValBindsAndThen, rnValBinds, trimWith,
- rnMethodBinds, renameSigs,
+ rnMethodBinds, renameSigs, mkSigTvFn,
rnMatchGroup, rnGRHSs
) where
rnLPat, rnPatsAndThen, patSigErr, checkPrecMatch )
import RnEnv ( bindLocatedLocalsRn, lookupLocatedBndrRn,
lookupLocatedInstDeclBndr, newIPNameRn,
- lookupLocatedSigOccRn, bindPatSigTyVars, bindPatSigTyVarsFV,
+ lookupLocatedSigOccRn, bindPatSigTyVarsFV,
bindLocalFixities, bindSigTyVarsFV,
warnUnusedLocalBinds, mapFvRn, extendTyVarEnvFVRn,
)
import Digraph ( SCC(..), stronglyConnComp )
import Bag
import Outputable
-import Maybes ( orElse, isJust )
+import Maybes ( orElse )
import Util ( filterOut )
import Monad ( foldM )
\end{code}
; let bndrs = collectPatBinders pat'
- ; (grhss', fvs) <- bindSigTyVarsFV (concatMap sig_fn bndrs) $
- rnGRHSs PatBindRhs grhss
+ ; (grhss', fvs) <- rnGRHSs PatBindRhs grhss
+ -- No scoped type variables for pattern bindings
; return (L loc (PatBind { pat_lhs = pat', pat_rhs = grhss',
pat_rhs_ty = placeHolderType, bind_fvs = trim fvs }),
; let plain_name = unLoc new_name
; (matches', fvs) <- bindSigTyVarsFV (sig_fn plain_name) $
+ -- bindSigTyVars tests for Opt_ScopedTyVars
rnMatchGroup (FunRhs plain_name) matches
; checkPrecMatch inf plain_name matches'
; return (L loc (FunBind { fun_id = new_name, fun_infix = inf, fun_matches = matches',
- bind_fvs = trim fvs, fun_co_fn = idCoercion }),
+ bind_fvs = trim fvs, fun_co_fn = idHsWrapper, fun_tick = Nothing }),
[plain_name], fvs)
}
\end{code}
\begin{code}
rnMethodBinds :: Name -- Class name
+ -> (Name -> [Name]) -- Signature tyvar function
-> [Name] -- Names for generic type variables
-> LHsBinds RdrName
-> RnM (LHsBinds Name, FreeVars)
-rnMethodBinds cls gen_tyvars binds
+rnMethodBinds cls sig_fn gen_tyvars binds
= foldM do_one (emptyBag,emptyFVs) (bagToList binds)
where do_one (binds,fvs) bind = do
- (bind', fvs_bind) <- rnMethodBind cls gen_tyvars bind
+ (bind', fvs_bind) <- rnMethodBind cls sig_fn gen_tyvars bind
return (bind' `unionBags` binds, fvs_bind `plusFV` fvs)
-rnMethodBind cls gen_tyvars (L loc (FunBind { fun_id = name, fun_infix = inf,
- fun_matches = MatchGroup matches _ }))
- = setSrcSpan loc $
- lookupLocatedInstDeclBndr cls name `thenM` \ sel_name ->
- let plain_name = unLoc sel_name in
+rnMethodBind cls sig_fn gen_tyvars (L loc (FunBind { fun_id = name, fun_infix = inf,
+ fun_matches = MatchGroup matches _ }))
+ = setSrcSpan loc $
+ lookupLocatedInstDeclBndr cls name `thenM` \ sel_name ->
+ let plain_name = unLoc sel_name in
-- We use the selector name as the binder
+ bindSigTyVarsFV (sig_fn plain_name) $
mapFvRn (rn_match plain_name) matches `thenM` \ (new_matches, fvs) ->
let
new_group = MatchGroup new_matches placeHolderType
in
checkPrecMatch inf plain_name new_group `thenM_`
- returnM (unitBag (L loc (FunBind { fun_id = sel_name, fun_infix = inf, fun_matches = new_group,
- bind_fvs = fvs, fun_co_fn = idCoercion })),
+ returnM (unitBag (L loc (FunBind {
+ fun_id = sel_name, fun_infix = inf,
+ fun_matches = new_group,
+ bind_fvs = fvs, fun_co_fn = idHsWrapper,
+ fun_tick = Nothing })),
fvs `addOneFV` plain_name)
-- The 'fvs' field isn't used for method binds
where
-- Can't handle method pattern-bindings which bind multiple methods.
-rnMethodBind cls gen_tyvars mbind@(L loc (PatBind other_pat _ _ _))
+rnMethodBind cls sig_fn gen_tyvars mbind@(L loc (PatBind other_pat _ _ _))
= addLocErr mbind methodBindErr `thenM_`
returnM (emptyBag, emptyFVs)
\end{code}
+
%************************************************************************
%* *
\subsubsection[dep-Sigs]{Signatures (and user-pragmas for values)}