projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Fix Trac #1954: newtype deriving caused 'defined but not used' error
[ghc-hetmet.git]
/
compiler
/
typecheck
/
TcClassDcl.lhs
diff --git
a/compiler/typecheck/TcClassDcl.lhs
b/compiler/typecheck/TcClassDcl.lhs
index
23ee423
..
0fb82cb
100644
(file)
--- a/
compiler/typecheck/TcClassDcl.lhs
+++ b/
compiler/typecheck/TcClassDcl.lhs
@@
-179,7
+179,7
@@
tcClassDecl2 (L loc (ClassDecl {tcdLName = class_name, tcdSigs = sigs,
; let
(tyvars, _, _, op_items) = classBigSig clas
rigid_info = ClsSkol clas
; let
(tyvars, _, _, op_items) = classBigSig clas
rigid_info = ClsSkol clas
- prag_fn = mkPragFun sigs
+ prag_fn = mkPragFun sigs default_binds
sig_fn = mkTcSigFun sigs
clas_tyvars = tcSkolSigTyVars rigid_info tyvars
pred = mkClassPred clas (mkTyVarTys clas_tyvars)
sig_fn = mkTcSigFun sigs
clas_tyvars = tcSkolSigTyVars rigid_info tyvars
pred = mkClassPred clas (mkTyVarTys clas_tyvars)
@@
-234,16
+234,20
@@
tcDefMeth clas tyvars this_dict binds_in sig_fn prag_fn sel_id
; (dm_id_w_inline, spec_prags)
<- tcPrags NonRecursive False True dm_id (prag_fn sel_name)
; (dm_id_w_inline, spec_prags)
<- tcPrags NonRecursive False True dm_id (prag_fn sel_name)
+ ; warnTc (not (null spec_prags))
+ (ptext (sLit "Ignoring SPECIALISE pragmas on default method")
+ <+> quotes (ppr sel_name))
+
; tcInstanceMethodBody (instLoc this_dict)
tyvars [this_dict]
([], emptyBag)
dm_id_w_inline local_dm_id
; tcInstanceMethodBody (instLoc this_dict)
tyvars [this_dict]
([], emptyBag)
dm_id_w_inline local_dm_id
- dm_sig_fn spec_prags meth_bind }
+ dm_sig_fn IsDefaultMethod meth_bind }
---------------
tcInstanceMethodBody :: InstLoc -> [TcTyVar] -> [Inst]
-> ([Inst], LHsBinds Id) -> Id -> Id
---------------
tcInstanceMethodBody :: InstLoc -> [TcTyVar] -> [Inst]
-> ([Inst], LHsBinds Id) -> Id -> Id
- -> TcSigFun -> [LSpecPrag] -> LHsBind Name
+ -> TcSigFun -> TcSpecPrags -> LHsBind Name
-> TcM (Id, LHsBind Id)
tcInstanceMethodBody inst_loc tyvars dfun_dicts
(this_dict, this_bind) meth_id local_meth_id
-> TcM (Id, LHsBind Id)
tcInstanceMethodBody inst_loc tyvars dfun_dicts
(this_dict, this_bind) meth_id local_meth_id
@@
-524,7
+528,8
@@
mkGenericInstance clas (hs_ty, binds) = do
-- and wrap them as forall'd tyvars, so that kind inference
-- works in the standard way
let
-- and wrap them as forall'd tyvars, so that kind inference
-- works in the standard way
let
- sig_tvs = map (noLoc.UserTyVar) (nameSetToList (extractHsTyVars (noLoc hs_ty)))
+ sig_tvs = userHsTyVarBndrs $ map noLoc $ nameSetToList $
+ extractHsTyVars (noLoc hs_ty)
hs_forall_ty = noLoc $ mkExplicitHsForAllTy sig_tvs (noLoc []) (noLoc hs_ty)
-- Type-check the instance type, and check its form
hs_forall_ty = noLoc $ mkExplicitHsForAllTy sig_tvs (noLoc []) (noLoc hs_ty)
-- Type-check the instance type, and check its form