projects
/
ghc-hetmet.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
Massive patch for the first months work adding System FC to GHC #26
[ghc-hetmet.git]
/
compiler
/
typecheck
/
TcTyClsDecls.lhs
diff --git
a/compiler/typecheck/TcTyClsDecls.lhs
b/compiler/typecheck/TcTyClsDecls.lhs
index
9e0b6cc
..
75d582e
100644
(file)
--- a/
compiler/typecheck/TcTyClsDecls.lhs
+++ b/
compiler/typecheck/TcTyClsDecls.lhs
@@
-11,7
+11,7
@@
module TcTyClsDecls (
#include "HsVersions.h"
import HsSyn ( TyClDecl(..), HsConDetails(..), HsTyVarBndr(..),
#include "HsVersions.h"
import HsSyn ( TyClDecl(..), HsConDetails(..), HsTyVarBndr(..),
- ConDecl(..), Sig(..), , NewOrData(..), ResType(..),
+ ConDecl(..), Sig(..), NewOrData(..), ResType(..),
tyClDeclTyVars, isSynDecl, hsConArgs,
LTyClDecl, tcdName, hsTyVarName, LHsTyVarBndr
)
tyClDeclTyVars, isSynDecl, hsConArgs,
LTyClDecl, tcdName, hsTyVarName, LHsTyVarBndr
)
@@
-301,7
+301,7
@@
kcTyClDecl decl@(TyData {tcdND = new_or_data, tcdCtxt = ctxt, tcdCons = cons})
details' <- kc_con_details details
res' <- case res of
ResTyH98 -> return ResTyH98
details' <- kc_con_details details
res' <- case res of
ResTyH98 -> return ResTyH98
- ResTyGADT ty -> return . ResTyGADT =<< kcHsSigType ty
+ ResTyGADT ty -> do { ty' <- kcHsSigType ty; return (ResTyGADT ty') }
return (ConDecl name expl ex_tvs' ex_ctxt' details' res')
kc_con_details (PrefixCon btys)
return (ConDecl name expl ex_tvs' ex_ctxt' details' res')
kc_con_details (PrefixCon btys)
@@
-323,7
+323,6
@@
kcTyClDecl decl@(TyData {tcdND = new_or_data, tcdCtxt = ctxt, tcdCons = cons})
kcTyClDecl decl@(ClassDecl {tcdCtxt = ctxt, tcdSigs = sigs})
= kcTyClDeclBody decl $ \ tvs' ->
do { is_boot <- tcIsHsBoot
kcTyClDecl decl@(ClassDecl {tcdCtxt = ctxt, tcdSigs = sigs})
= kcTyClDeclBody decl $ \ tvs' ->
do { is_boot <- tcIsHsBoot
- ; checkTc (not is_boot) badBootClassDeclErr
; ctxt' <- kcHsContext ctxt
; sigs' <- mappM (wrapLocM kc_sig) sigs
; return (decl {tcdTyVars = tvs', tcdCtxt = ctxt', tcdSigs = sigs'}) }
; ctxt' <- kcHsContext ctxt
; sigs' <- mappM (wrapLocM kc_sig) sigs
; return (decl {tcdTyVars = tvs', tcdCtxt = ctxt', tcdSigs = sigs'}) }
@@
-631,7
+630,7
@@
checkValidTyCon tc
get_fields con = dataConFieldLabels con `zip` repeat con
-- dataConFieldLabels may return the empty list, which is fine
get_fields con = dataConFieldLabels con `zip` repeat con
-- dataConFieldLabels may return the empty list, which is fine
- -- XXX - autrijus - Make this far more complex to acommodate
+ -- Note: The complicated checkOne logic below is there to accomodate
-- for different return types. Add res_ty to the mix,
-- comparing them in two steps, all for good error messages.
-- Plan: Use Unify.tcMatchTys to compare the first candidate's
-- for different return types. Add res_ty to the mix,
-- comparing them in two steps, all for good error messages.
-- Plan: Use Unify.tcMatchTys to compare the first candidate's
@@
-824,6
+823,4
@@
newtypeFieldErr con_name n_flds
emptyConDeclsErr tycon
= sep [quotes (ppr tycon) <+> ptext SLIT("has no constructors"),
nest 2 $ ptext SLIT("(-fglasgow-exts permits this)")]
emptyConDeclsErr tycon
= sep [quotes (ppr tycon) <+> ptext SLIT("has no constructors"),
nest 2 $ ptext SLIT("(-fglasgow-exts permits this)")]
-
-badBootClassDeclErr = ptext SLIT("Illegal class declaration in hs-boot file")
\end{code}
\end{code}