Commit 839a0880 authored by chak@cse.unsw.edu.au.'s avatar chak@cse.unsw.edu.au.

Don't lift ATs out of classes and instances before tc

Wed Aug  9 15:31:08 EDT 2006  Manuel M T Chakravarty <chak@cse.unsw.edu.au>
  * Don't lift ATs out of classes and instances before tc
parent d9948cdc
......@@ -111,10 +111,8 @@ rnSrcDecls (HsGroup { hs_valds = val_decls,
<- mapFvRn (wrapLocFstM rnDefaultDecl) default_decls ;
let {
rn_at_decls = concat
[ats | L _ (InstDecl _ _ _ ats) <- rn_inst_decls] ;
rn_group = HsGroup { hs_valds = rn_val_decls,
hs_tyclds = rn_tycl_decls ++ rn_at_decls,
hs_tyclds = rn_tycl_decls,
hs_instds = rn_inst_decls,
hs_fixds = rn_fix_decls,
hs_depds = [],
......@@ -284,10 +282,9 @@ rnSrcInstDecl (InstDecl inst_ty mbinds uprags ats)
let
at_doc = text "In the associated types in an instance declaration"
at_names = map (head . tyClDeclNames . unLoc) ats
(_, rdrCtxt, _, _) = splitHsInstDeclTy (unLoc inst_ty)
in
checkDupNames at_doc at_names `thenM_`
rnATDefs rdrCtxt ats `thenM` \ (ats', at_fvs) ->
rnATInsts ats `thenM` \ (ats', at_fvs) ->
-- Rename the bindings
-- The typechecker (not the renamer) checks that all
......@@ -333,30 +330,26 @@ rnSrcInstDecl (InstDecl inst_ty mbinds uprags ats)
-- to remove the context).
\end{code}
Renaming of the associated type definitions in instances.
Renaming of the associated types in instances.
* In the case of associated data and newtype definitions we add the instance
context.
* We raise an error if we encounter a kind signature in an instance.
\begin{code}
rnATDefs :: HsContext RdrName -> [LTyClDecl RdrName]
-> RnM ([LTyClDecl Name], FreeVars)
rnATDefs ctxt atDecls =
mapFvRn (wrapLocFstM rnAtDef) atDecls
rnATInsts :: [LTyClDecl RdrName] -> RnM ([LTyClDecl Name], FreeVars)
rnATInsts atDecls =
mapFvRn (wrapLocFstM rnATInst) atDecls
where
rnAtDef tydecl@TyFunction {} =
rnATInst tydecl@TyFunction {} =
do
addErr noKindSig
rnTyClDecl tydecl
rnAtDef tydecl@TySynonym {} = rnTyClDecl tydecl
rnAtDef tydecl@TyData {tcdCtxt = L l tyCtxt} =
rnATInst tydecl@TySynonym {} = rnTyClDecl tydecl
rnATInst tydecl@TyData {} =
do
checkM (not . isKindSigDecl $ tydecl) $ addErr noKindSig
rnTyClDecl (tydecl {tcdCtxt = L l (ctxt ++ tyCtxt)})
-- The source loc is somewhat half hearted... -=chak
rnAtDef _ =
panic "RnSource.rnATDefs: not a type declaration"
rnTyClDecl tydecl
rnATInst _ =
panic "RnSource.rnATInsts: not a type declaration"
noKindSig = text "Instances cannot have kind signatures"
\end{code}
......
......@@ -127,13 +127,8 @@ tcTyAndClassDecls boot_details decls
; traceTc (text "tcTyAndCl" <+> ppr mod)
; (syn_tycons, alg_tyclss) <- fixM (\ ~(rec_syn_tycons, rec_alg_tyclss) ->
do { let { -- Calculate variances and rec-flag
; (syn_decls, alg_decls_pre) = partition (isSynDecl . unLoc) decls
; alg_decls = alg_decls_pre ++
concat [tcdATs decl -- add AT decls
| declLoc <- alg_decls_pre
, let decl = unLoc declLoc
, isClassDecl decl] }
; (syn_decls, alg_decls) = partition (isSynDecl . unLoc)
decls }
-- Extend the global env with the knot-tied results
-- for data types and classes
--
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment