-- Typechecking kinded types
tcHsKindedContext, tcHsKindedType, tcHsBangType,
- tcTyVarBndrs, dsHsType, tcLHsConSig, tcDataKindSig,
+ tcTyVarBndrs, dsHsType, tcLHsConResTy,
+ tcDataKindSig,
tcHsPatSigType, tcAddLetBoundTyVars,
#include "HsVersions.h"
-import HsSyn ( HsType(..), LHsType, HsTyVarBndr(..), LHsTyVarBndr, HsBang,
+import HsSyn ( HsType(..), LHsType, HsTyVarBndr(..), LHsTyVarBndr,
LHsContext, HsPred(..), LHsPred, LHsBinds, HsExplicitForAll(..),
- getBangStrictness, collectSigTysFromHsBinds )
+ collectSigTysFromHsBinds )
import RnHsSyn ( extractHsTyVars )
import TcRnMonad
import TcEnv ( tcExtendTyVarEnv, tcExtendKindEnvTvs,
import NameEnv
import PrelNames ( genUnitTyConName )
import TysWiredIn ( mkListTy, listTyCon, mkPArrTy, parrTyCon, tupleTyCon )
-import Bag ( bagToList )
-import BasicTypes ( Boxity(..) )
+import BasicTypes ( Boxity(..), RecFlag )
import SrcLoc ( Located(..), unLoc, noLoc, srcSpanStart )
import UniqSupply ( uniqsFromSupply )
import Outputable
GADT constructor signatures
\begin{code}
-tcLHsConSig :: LHsType Name
- -> TcM ([TcTyVar], TcThetaType,
- [HsBang], [TcType],
- TyCon, [TcType])
--- Take apart the type signature for a data constructor
--- The difference is that there can be bangs at the top of
--- the argument types, and kind-checking is the right place to check
-tcLHsConSig sig@(L span (HsForAllTy exp tv_names ctxt ty))
- = setSrcSpan span $
- addErrCtxt (gadtSigCtxt sig) $
- tcTyVarBndrs tv_names $ \ tyvars ->
- do { theta <- mappM dsHsLPred (unLoc ctxt)
- ; (bangs, arg_tys, tc, res_tys) <- tc_con_sig_tau ty
- ; return (tyvars, theta, bangs, arg_tys, tc, res_tys) }
-tcLHsConSig ty
- = do { (bangs, arg_tys, tc, res_tys) <- tc_con_sig_tau ty
- ; return ([], [], bangs, arg_tys, tc, res_tys) }
-
---------
-tc_con_sig_tau (L _ (HsFunTy arg ty))
- = do { (bangs, arg_tys, tc, res_tys) <- tc_con_sig_tau ty
- ; arg_ty <- tcHsBangType arg
- ; return (getBangStrictness arg : bangs,
- arg_ty : arg_tys, tc, res_tys) }
-
-tc_con_sig_tau ty
- = do { (tc, res_tys) <- tc_con_res ty []
- ; return ([], [], tc, res_tys) }
-
---------
+tcLHsConResTy :: LHsType Name -> TcM (TyCon, [TcType])
+tcLHsConResTy ty@(L span _)
+ = setSrcSpan span $
+ addErrCtxt (gadtResCtxt ty) $
+ tc_con_res ty []
+
tc_con_res (L _ (HsAppTy fun res_ty)) res_tys
= do { res_ty' <- dsHsType res_ty
; tc_con_res fun (res_ty' : res_tys) }
tc_con_res ty _ = failWithTc (badGadtDecl ty)
-gadtSigCtxt ty
- = hang (ptext SLIT("In the signature of a data constructor:"))
+gadtResCtxt ty
+ = hang (ptext SLIT("In the result type of a data constructor:"))
2 (ppr ty)
badGadtDecl ty
- = hang (ptext SLIT("Malformed constructor signature:"))
+ = hang (ptext SLIT("Malformed constructor result type:"))
2 (ppr ty)
typeCtxt ty = ptext SLIT("In the type") <+> quotes (ppr ty)
; return (tyvars, sig_ty) }
}
-tcAddLetBoundTyVars :: LHsBinds Name -> TcM a -> TcM a
+tcAddLetBoundTyVars :: [(RecFlag,LHsBinds Name)] -> TcM a -> TcM a
-- Turgid funciton, used for type variables bound by the patterns of a let binding
tcAddLetBoundTyVars binds thing_inside
- = go (collectSigTysFromHsBinds (bagToList binds)) thing_inside
+ = go (concatMap (collectSigTysFromHsBinds . snd) binds) thing_inside
where
go [] thing_inside = thing_inside
go (hs_ty:hs_tys) thing_inside