#include "HsVersions.h"
-import {-# SOURCE #-} RnSource ( rnHsSigType, rnHsType )
import HsSyn
import HsBinds ( eqHsSig, sigName, hsSigDoc )
import RdrHsSyn
import RnHsSyn
import RnMonad
+import RnTypes ( rnHsSigType, rnHsType )
import RnExpr ( rnMatch, rnGRHSs, rnPat, checkPrecMatch )
-import RnEnv ( bindLocatedLocalsRn, lookupBndrRn,
- lookupGlobalOccRn, lookupSigOccRn,
+import RnEnv ( bindLocatedLocalsRn, lookupBndrRn, lookupInstDeclBndr,
+ lookupSigOccRn, bindPatSigTyVars,
warnUnusedLocalBinds, mapFvRn, extendTyVarEnvFVRn,
)
import CmdLineOpts ( DynFlag(..) )
rnTopMonoBinds mbinds sigs
- = mapRn lookupBndrRn binder_rdr_names `thenRn` \ binder_names ->
+ = mapRn lookupBndrRn binder_rdr_names `thenRn` \ binder_names ->
+ bindPatSigTyVars (collectSigTysFromMonoBinds mbinds) $
let
bndr_name_set = mkNameSet binder_names
in
= -- Extract all the binders in this group,
-- and extend current scope, inventing new names for the new binders
-- This also checks that the names form a set
- bindLocatedLocalsRn (text "a binding group")
- mbinders_w_srclocs $ \ new_mbinders ->
+ bindLocatedLocalsRn doc mbinders_w_srclocs $ \ new_mbinders ->
+ bindPatSigTyVars (collectSigTysFromMonoBinds mbinds) $
let
binder_set = mkNameSet new_mbinders
in
returnRn (result, delListFromNameSet all_fvs new_mbinders)
where
mbinders_w_srclocs = collectLocatedMonoBinders mbinds
+ doc = text "In the binding group for" <+> pp_bndrs mbinders_w_srclocs
+ pp_bndrs [(b,_)] = quotes (ppr b)
+ pp_bndrs bs = fsep (punctuate comma [ppr b | (b,_) <- bs])
\end{code}
names_bound_here = unitNameSet new_name
in
sigsForMe names_bound_here sigs `thenRn` \ sigs_for_me ->
- mapFvRn rnMatch matches `thenRn` \ (new_matches, fvs) ->
+ mapFvRn (rnMatch (FunRhs name)) matches `thenRn` \ (new_matches, fvs) ->
mapRn_ (checkPrecMatch inf new_name) new_matches `thenRn_`
returnRn
[(unitNameSet new_name,
a binder.
\begin{code}
-rnMethodBinds :: [Name] -- Names for generic type variables
+rnMethodBinds :: Name -- Class name
+ -> [Name] -- Names for generic type variables
-> RdrNameMonoBinds
-> RnMS (RenamedMonoBinds, FreeVars)
-rnMethodBinds gen_tyvars EmptyMonoBinds = returnRn (EmptyMonoBinds, emptyFVs)
+rnMethodBinds cls gen_tyvars EmptyMonoBinds = returnRn (EmptyMonoBinds, emptyFVs)
-rnMethodBinds gen_tyvars (AndMonoBinds mb1 mb2)
- = rnMethodBinds gen_tyvars mb1 `thenRn` \ (mb1', fvs1) ->
- rnMethodBinds gen_tyvars mb2 `thenRn` \ (mb2', fvs2) ->
+rnMethodBinds cls gen_tyvars (AndMonoBinds mb1 mb2)
+ = rnMethodBinds cls gen_tyvars mb1 `thenRn` \ (mb1', fvs1) ->
+ rnMethodBinds cls gen_tyvars mb2 `thenRn` \ (mb2', fvs2) ->
returnRn (mb1' `AndMonoBinds` mb2', fvs1 `plusFV` fvs2)
-rnMethodBinds gen_tyvars (FunMonoBind name inf matches locn)
+rnMethodBinds cls gen_tyvars (FunMonoBind name inf matches locn)
= pushSrcLocRn locn $
- lookupGlobalOccRn name `thenRn` \ sel_name ->
+ lookupInstDeclBndr cls name `thenRn` \ sel_name ->
-- We use the selector name as the binder
mapFvRn rn_match matches `thenRn` \ (new_matches, fvs) ->
where
-- Gruesome; bring into scope the correct members of the generic type variables
-- See comments in RnSource.rnSourceDecl(ClassDecl)
- rn_match match@(Match _ (TypePatIn ty : _) _ _)
- = extendTyVarEnvFVRn gen_tvs (rnMatch match)
+ rn_match match@(Match (TypePatIn ty : _) _ _)
+ = extendTyVarEnvFVRn gen_tvs (rnMatch (FunRhs name) match)
where
tvs = map rdrNameOcc (extractHsTyRdrNames ty)
gen_tvs = [tv | tv <- gen_tyvars, nameOccName tv `elem` tvs]
- rn_match match = rnMatch match
+ rn_match match = rnMatch (FunRhs name) match
-- Can't handle method pattern-bindings which bind multiple methods.
-rnMethodBinds gen_tyvars mbind@(PatMonoBind other_pat _ locn)
+rnMethodBinds cls gen_tyvars mbind@(PatMonoBind other_pat _ locn)
= pushSrcLocRn locn $
failWithRn (EmptyMonoBinds, emptyFVs) (methodBindErr mbind)
\end{code}
lookupSigOccRn v `thenRn` \ new_v ->
returnRn (FixSig (FixitySig new_v fix src_loc))
-renameSig (InlineSig v p src_loc)
+renameSig (InlineSig b v p src_loc)
= pushSrcLocRn src_loc $
lookupSigOccRn v `thenRn` \ new_v ->
- returnRn (InlineSig new_v p src_loc)
-
-renameSig (NoInlineSig v p src_loc)
- = pushSrcLocRn src_loc $
- lookupSigOccRn v `thenRn` \ new_v ->
- returnRn (NoInlineSig new_v p src_loc)
-\end{code}
-
-\begin{code}
-renameIE :: (RdrName -> RnMS Name) -> IE RdrName -> RnMS (IE Name, FreeVars)
-renameIE lookup_occ_nm (IEVar v)
- = lookup_occ_nm v `thenRn` \ new_v ->
- returnRn (IEVar new_v, unitFV new_v)
-
-renameIE lookup_occ_nm (IEThingAbs v)
- = lookup_occ_nm v `thenRn` \ new_v ->
- returnRn (IEThingAbs new_v, unitFV new_v)
-
-renameIE lookup_occ_nm (IEThingAll v)
- = lookup_occ_nm v `thenRn` \ new_v ->
- returnRn (IEThingAll new_v, unitFV new_v)
-
-renameIE lookup_occ_nm (IEThingWith v vs)
- = lookup_occ_nm v `thenRn` \ new_v ->
- mapRn lookup_occ_nm vs `thenRn` \ new_vs ->
- returnRn (IEThingWith new_v new_vs, plusFVs [ unitFV x | x <- new_v:new_vs ])
-
-renameIE lookup_occ_nm (IEModuleContents m)
- = returnRn (IEModuleContents m, emptyFVs)
+ returnRn (InlineSig b new_v p src_loc)
\end{code}
\begin{code}
dupSigDeclErr sig
= pushSrcLocRn loc $
- addErrRn (sep [ptext SLIT("Duplicate") <+> ptext what_it_is <> colon,
+ addErrRn (sep [ptext SLIT("Duplicate") <+> what_it_is <> colon,
ppr sig])
where
(what_it_is, loc) = hsSigDoc sig
unknownSigErr sig
= pushSrcLocRn loc $
- addErrRn (sep [ptext SLIT("Misplaced") <+> ptext what_it_is <> colon,
+ addErrRn (sep [ptext SLIT("Misplaced") <+> what_it_is <> colon,
ppr sig])
where
(what_it_is, loc) = hsSigDoc sig