X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Ftypecheck%2FTcTyClsDecls.lhs;h=75d582e865bba09dddc9c9d428530a9fbceeaa8b;hb=cb8efb737dae6e41f28d471883df67724a33120f;hp=9e0b6cc6ed14a7a5f01da0a9a853d6d5fa7c60e0;hpb=0065d5ab628975892cea1ec7303f968c3338cbe1;p=ghc-hetmet.git diff --git a/compiler/typecheck/TcTyClsDecls.lhs b/compiler/typecheck/TcTyClsDecls.lhs index 9e0b6cc..75d582e 100644 --- a/compiler/typecheck/TcTyClsDecls.lhs +++ b/compiler/typecheck/TcTyClsDecls.lhs @@ -11,7 +11,7 @@ module TcTyClsDecls ( #include "HsVersions.h" import HsSyn ( TyClDecl(..), HsConDetails(..), HsTyVarBndr(..), - ConDecl(..), Sig(..), , NewOrData(..), ResType(..), + ConDecl(..), Sig(..), NewOrData(..), ResType(..), 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 - 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) @@ -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 - ; checkTc (not is_boot) badBootClassDeclErr ; 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 - -- 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 @@ -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)")] - -badBootClassDeclErr = ptext SLIT("Illegal class declaration in hs-boot file") \end{code}