HsDecl(..), TyClDecl(..), InstDecl(..), ConDecl(..),
Stmt(..), HsBinds(..), MonoBinds(..), Sig(..),
Pat(..), HsConDetails(..), HsOverLit, BangType(..),
- placeHolderType, HsType(..),
+ placeHolderType, HsType(..), HsExplicitForAll(..),
HsTyVarBndr(..), HsContext,
mkSimpleMatch, mkHsForAllTy
)
= Left $ InstD (InstDecl inst_ty binds sigs loc0)
where
(binds, sigs) = cvtBindsAndSigs decs
- inst_ty = HsForAllTy Nothing
- (cvt_context tys)
- (HsPredTy (cvt_pred ty))
+ inst_ty = mkImplicitHsForAllTy (cvt_context tys) (HsPredTy (cvt_pred ty))
cvt_top (Meta.SigD nm typ) = Left $ Hs.SigD (Sig (vName nm) (cvtType typ) loc0)
trans (VarT nm, args) = foldl HsAppTy (HsTyVar (tName nm)) args
trans (ConT tc, args) = foldl HsAppTy (HsTyVar (tconName tc)) args
- trans (ForallT tvs cxt ty, []) = mkHsForAllTy (Just (cvt_tvs tvs))
- (cvt_context cxt)
- (cvtType ty)
+ trans (ForallT tvs cxt ty, []) = mkExplicitHsForAllTy
+ (cvt_tvs tvs) (cvt_context cxt) (cvtType ty)
split_ty_app :: Meta.Type -> (Meta.Type, [Meta.Type])
split_ty_app ty = go ty []
\begin{code}
instance (OutputableBndr name) => Outputable (ConDecl name) where
ppr (ConDecl con tvs cxt con_details loc)
- = sep [pprHsForAll tvs cxt, ppr_con_details con con_details]
+ = sep [pprHsForAll Explicit tvs cxt, ppr_con_details con con_details]
ppr_con_details con (InfixCon ty1 ty2)
= hsep [ppr ty1, ppr con, ppr ty2]
\begin{code}
module HsTypes (
- HsType(..), HsTyVarBndr(..),
+ HsType(..), HsTyVarBndr(..), HsExplicitForAll(..),
, HsContext, HsPred(..)
- , mkHsForAllTy, mkHsDictTy, mkHsIParamTy
+ , mkExplicitHsForAllTy, mkImplicitHsForAllTy, mkHsDictTy, mkHsIParamTy
, hsTyVarName, hsTyVarNames, replaceTyVarName
, splitHsInstDeclTy
import BasicTypes ( IPName, Boxity, tupleParens )
import PrelNames ( unboundKey )
import SrcLoc ( noSrcLoc )
+import CmdLineOpts ( opt_PprStyle_Debug )
import Outputable
\end{code}
| HsIParam (IPName name) (HsType name)
data HsType name
- = HsForAllTy (Maybe [HsTyVarBndr name]) -- Nothing for implicitly quantified signatures
+ = HsForAllTy HsExplicitForAll -- Renamer leaves this flag unchanged, to record the way
+ -- the user wrote it originally, so that the printer can
+ -- print it as the user wrote it
+ [HsTyVarBndr name] -- With ImplicitForAll, this is the empty list
+ -- until the renamer fills in the variables
(HsContext name)
(HsType name)
| HsKindSig (HsType name) -- (ty :: kind)
Kind -- A type with a kind signature
+data HsExplicitForAll = Explicit | Implicit
-----------------------
-- Combine adjacent for-alls.
--
-- A valid type must have one for-all at the top of the type, or of the fn arg types
-mkHsForAllTy mtvs [] ty = mk_forall_ty mtvs ty
-mkHsForAllTy mtvs ctxt ty = HsForAllTy mtvs ctxt ty
+mkImplicitHsForAllTy ctxt ty = mkHsForAllTy Implicit [] ctxt ty
+mkExplicitHsForAllTy tvs ctxt ty = mkHsForAllTy Explicit tvs ctxt ty
+
+mkHsForAllTy :: HsExplicitForAll -> [HsTyVarBndr name] -> HsContext name -> HsType name -> HsType name
+-- Smart constructor for HsForAllTy
+mkHsForAllTy exp tvs [] ty = mk_forall_ty exp tvs ty
+mkHsForAllTy exp tvs ctxt ty = HsForAllTy exp tvs ctxt ty
-- mk_forall_ty makes a pure for-all type (no context)
-mk_forall_ty (Just []) ty = ty -- Explicit for-all with no tyvars
-mk_forall_ty mtvs1 (HsParTy ty) = mk_forall_ty mtvs1 ty
-mk_forall_ty mtvs1 (HsForAllTy mtvs2 ctxt ty) = mkHsForAllTy (mtvs1 `plus` mtvs2) ctxt ty
-mk_forall_ty mtvs1 ty = HsForAllTy mtvs1 [] ty
+mk_forall_ty Explicit [] ty = ty -- Explicit for-all with no tyvars
+mk_forall_ty exp tvs (HsParTy ty) = mk_forall_ty exp tvs ty
+mk_forall_ty exp1 tvs1 (HsForAllTy exp2 tvs2 ctxt ty) = mkHsForAllTy (exp1 `plus` exp2) (tvs1 ++ tvs2) ctxt ty
+mk_forall_ty exp tvs ty = HsForAllTy exp tvs [] ty
-mtvs1 `plus` Nothing = mtvs1
-Nothing `plus` mtvs2 = mtvs2
-(Just tvs1) `plus` (Just tvs2) = Just (tvs1 ++ tvs2)
+Implicit `plus` Implicit = Implicit
+exp1 `plus` exp2 = Explicit
mkHsDictTy cls tys = HsPredTy (HsClassP cls tys)
mkHsIParamTy v ty = HsPredTy (HsIParam v ty)
splitHsInstDeclTy inst_ty
= case inst_ty of
- HsForAllTy (Just tvs) cxt1 tau
+ HsForAllTy _ tvs cxt1 tau -- The type vars should have been
+ -- computed by now, even if they were implicit
-> (tvs, cxt1++cxt2, cls, tys)
where
(cxt2, cls, tys) = split_tau tau
pprHsTyVarBndr name kind | kind `eqKind` liftedTypeKind = ppr name
| otherwise = hsep [ppr name, dcolon, pprParendKind kind]
-pprHsForAll [] [] = empty
-pprHsForAll tvs cxt = ptext SLIT("forall") <+> interppSP tvs <+> pprHsContext cxt
+pprHsForAll exp tvs cxt
+ | show_forall = forall_part <+> pprHsContext cxt
+ | otherwise = pprHsContext cxt
+ where
+ show_forall = opt_PprStyle_Debug
+ || (not (null tvs) && is_explicit)
+ is_explicit = case exp of {Explicit -> True; Implicit -> False}
+ forall_part = ptext SLIT("forall") <+> interppSP tvs <> dot
pprHsContext :: (Outputable name) => HsContext name -> SDoc
pprHsContext [] = empty
-- (b) Drop top-level for-all type variables in user style
-- since they are implicit in Haskell
prepare sty (HsParTy ty) = prepare sty ty
-prepare sty (HsForAllTy _ cxt ty) | userStyle sty = (HsForAllTy Nothing cxt ty)
prepare sty ty = ty
-ppr_mono_ty ctxt_prec (HsForAllTy maybe_tvs ctxt ty)
+ppr_mono_ty ctxt_prec (HsForAllTy exp tvs ctxt ty)
= maybeParen ctxt_prec pREC_FUN $
- sep [pp_header, ppr_mono_ty pREC_TOP ty]
- where
- pp_header = case maybe_tvs of
- Just tvs -> pprHsForAll tvs ctxt
- Nothing -> pprHsContext ctxt
+ sep [pprHsForAll exp tvs ctxt, ppr_mono_ty pREC_TOP ty]
ppr_mono_ty ctxt_prec (HsTyVar name) = ppr name
ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2) = ppr_fun_ty ctxt_prec ty1 ty2
{- -*-haskell-*-
-----------------------------------------------------------------------------
-$Id: Parser.y,v 1.126 2003/10/09 11:59:02 simonpj Exp $
+$Id: Parser.y,v 1.127 2003/10/21 12:54:21 simonpj Exp $
Haskell grammar.
| sigtypes ',' sigtype { $3 : $1 }
sigtype :: { RdrNameHsType }
- : ctype { mkHsForAllTy Nothing [] $1 }
+ : ctype { mkImplicitHsForAllTy [] $1 }
+ -- Wrap an Implicit forall if there isn't one there already
sig_vars :: { [RdrName] }
: sig_vars ',' var { $3 : $1 }
-- A ctype is a for-all type
ctype :: { RdrNameHsType }
- : 'forall' tv_bndrs '.' ctype { mkHsForAllTy (Just $2) [] $4 }
- | context '=>' type { mkHsForAllTy Nothing $1 $3 }
+ : 'forall' tv_bndrs '.' ctype { mkExplicitHsForAllTy $2 [] $4 }
+ | context '=>' type { mkImplicitHsForAllTy $1 $3 }
-- A type of form (context => type) is an *implicit* HsForAllTy
| type { $1 }
ifaceExtRdrName (ExtPkg mod occ) = mkOrig mod occ
ifaceExtRdrName other = pprPanic "ParserCore.ifaceExtRdrName" (ppr other)
-add_forall tv (HsForAllTy (Just tvs) cxt t) = HsForAllTy (Just (tv:tvs)) cxt t
-add_forall tv t = HsForAllTy (Just [tv]) [] t
+add_forall tv (HsForAllTy exp tvs cxt t) = HsForAllTy exp (tv:tvs) cxt t
+add_forall tv t = HsForAllTy Explicit [tv] [] t
happyError :: P a
happyError s l = failP (show l ++ ": Parse error\n") (take 100 s) l
extract_pred (HsClassP cls tys) acc = foldr extract_ty (cls : acc) tys
extract_pred (HsIParam n ty) acc = extract_ty ty acc
-extract_ty (HsAppTy ty1 ty2) acc = extract_ty ty1 (extract_ty ty2 acc)
-extract_ty (HsListTy ty) acc = extract_ty ty acc
-extract_ty (HsPArrTy ty) acc = extract_ty ty acc
-extract_ty (HsTupleTy _ tys) acc = foldr extract_ty acc tys
-extract_ty (HsFunTy ty1 ty2) acc = extract_ty ty1 (extract_ty ty2 acc)
-extract_ty (HsPredTy p) acc = extract_pred p acc
-extract_ty (HsTyVar tv) acc = tv : acc
-extract_ty (HsForAllTy Nothing cx ty) acc = extract_ctxt cx (extract_ty ty acc)
-extract_ty (HsOpTy ty1 nam ty2) acc = extract_ty ty1 (extract_ty ty2 acc)
-extract_ty (HsParTy ty) acc = extract_ty ty acc
--- Generics
-extract_ty (HsNumTy num) acc = acc
-extract_ty (HsKindSig ty k) acc = extract_ty ty acc
-extract_ty (HsForAllTy (Just tvs) ctxt ty)
+extract_ty (HsAppTy ty1 ty2) acc = extract_ty ty1 (extract_ty ty2 acc)
+extract_ty (HsListTy ty) acc = extract_ty ty acc
+extract_ty (HsPArrTy ty) acc = extract_ty ty acc
+extract_ty (HsTupleTy _ tys) acc = foldr extract_ty acc tys
+extract_ty (HsFunTy ty1 ty2) acc = extract_ty ty1 (extract_ty ty2 acc)
+extract_ty (HsPredTy p) acc = extract_pred p acc
+extract_ty (HsTyVar tv) acc = tv : acc
+extract_ty (HsOpTy ty1 nam ty2) acc = extract_ty ty1 (extract_ty ty2 acc)
+extract_ty (HsParTy ty) acc = extract_ty ty acc
+extract_ty (HsNumTy num) acc = acc
+extract_ty (HsKindSig ty k) acc = extract_ty ty acc
+extract_ty (HsForAllTy exp [] cx ty) acc = extract_ctxt cx (extract_ty ty acc)
+extract_ty (HsForAllTy exp tvs cx ty)
acc = acc ++
(filter (`notElem` locals) $
- extract_ctxt ctxt (extract_ty ty []))
+ extract_ctxt cx (extract_ty ty []))
where
locals = hsTyVarNames tvs
| otherwise = ExtPkg (rdrNameModule rdr_name) (rdrNameOcc rdr_name)
hsIfaceType :: HsType RdrName -> IfaceType
-hsIfaceType (HsForAllTy mb_tvs cxt ty)
- = foldr (IfaceForAllTy . hsIfaceTv) rho tvs
+hsIfaceType (HsForAllTy exp tvs cxt ty)
+ = foldr (IfaceForAllTy . hsIfaceTv) rho tvs'
where
rho = foldr (IfaceFunTy . IfacePredTy . hsIfacePred) tau cxt
tau = hsIfaceType ty
- tvs = case mb_tvs of
- Just tvs -> tvs
- Nothing -> map UserTyVar (extractHsRhoRdrTyVars cxt ty)
+ tvs' = case exp of
+ Explicit -> tvs
+ Implicit -> map UserTyVar (extractHsRhoRdrTyVars cxt ty)
hsIfaceType ty@(HsTyVar _) = hs_tc_app ty []
hsIfaceType ty@(HsAppTy t1 t2) = hs_tc_app ty []
checkInstType :: RdrNameHsType -> P RdrNameHsType
checkInstType t
= case t of
- HsForAllTy tvs ctxt ty ->
+ HsForAllTy exp tvs ctxt ty ->
checkDictTy ty [] >>= \ dict_ty ->
- return (HsForAllTy tvs ctxt dict_ty)
+ return (HsForAllTy exp tvs ctxt dict_ty)
HsParTy ty -> checkInstType ty
ty -> checkDictTy ty [] >>= \ dict_ty->
- return (HsForAllTy Nothing [] dict_ty)
+ return (HsForAllTy Implicit [] [] dict_ty)
checkTyVars :: [RdrNameHsType] -> P [RdrNameHsTyVar]
checkTyVars tvs
-- but they aren't explicit forall points. Hence
-- we have to remove the implicit forall here.
let t' = case t of
- HsForAllTy Nothing [] ty -> ty
+ HsForAllTy Implicit _ [] ty -> ty
other -> other
in
return (SigPatIn e t')
get (HsNumTy n) = emptyNameSet
get (HsTyVar tv) = unitNameSet tv
get (HsKindSig ty k) = get ty
- get (HsForAllTy (Just tvs)
+ get (HsForAllTy _ tvs
ctxt ty) = (extractHsCtxtTyNames ctxt `unionNameSets` get ty)
`minusNameSet`
mkNameSet (hsTyVarNames tvs)
- get ty@(HsForAllTy Nothing _ _) = pprPanic "extractHsTyNames" (ppr ty)
extractHsTyNames_s :: [RenamedHsType] -> NameSet
extractHsTyNames_s tys = foldr (unionNameSets . extractHsTyNames) emptyNameSet tys
\begin{code}
rnHsType :: SDoc -> RdrNameHsType -> RnM RenamedHsType
-rnHsType doc (HsForAllTy Nothing ctxt ty)
+rnHsType doc (HsForAllTy Implicit _ ctxt ty)
-- Implicit quantifiction in source code (no kinds on tyvars)
-- Given the signature C => T we universally quantify
-- over FV(T) \ {in-scope-tyvars}
-- class C a where { op :: a -> a }
forall_tyvars = filter (not . (`elemLocalRdrEnv` name_env)) mentioned
in
- rnForAll doc (map UserTyVar forall_tyvars) ctxt ty
+ rnForAll doc Implicit (map UserTyVar forall_tyvars) ctxt ty
-rnHsType doc (HsForAllTy (Just forall_tyvars) ctxt tau)
+rnHsType doc (HsForAllTy Explicit forall_tyvars ctxt tau)
-- Explicit quantification.
-- Check that the forall'd tyvars are actually
-- mentioned in the type, and produce a warning if not
warn_guys = filter (`notElem` mentioned) forall_tyvar_names
in
mappM_ (forAllWarn doc tau) warn_guys `thenM_`
- rnForAll doc forall_tyvars ctxt tau
+ rnForAll doc Explicit forall_tyvars ctxt tau
rnHsType doc (HsTyVar tyvar)
= lookupOccRn tyvar `thenM` \ tyvar' ->
\begin{code}
-rnForAll doc forall_tyvars ctxt ty
+rnForAll doc exp forall_tyvars ctxt ty
= bindTyVarsRn doc forall_tyvars $ \ new_tyvars ->
rnContext doc ctxt `thenM` \ new_ctxt ->
rnHsType doc ty `thenM` \ new_ty ->
- returnM (mkHsForAllTy (Just new_tyvars) new_ctxt new_ty)
+ returnM (HsForAllTy exp new_tyvars new_ctxt new_ty)
\end{code}
where
check_one (TySigInfo id sig_tyvars sig_theta sig_tau _ _ src_loc)
= addSrcLoc src_loc $
- addErrCtxt (ptext SLIT("When checking the type signature for")
+ addErrCtxt (ptext SLIT("In the type signature for")
<+> quotes (ppr id)) $
addErrCtxtM (sigCtxt id sig_tyvars sig_theta sig_tau) $
checkSigTyVarsWrt (idFreeTyVars id) sig_tyvars
#include "HsVersions.h"
-import HsSyn ( TyClDecl(..), Sig(..), MonoBinds(..), HsType(..),
+import HsSyn ( TyClDecl(..), Sig(..), MonoBinds(..), HsType(..),
HsExpr(..), HsLit(..), Pat(WildPat), HsTyVarBndr(..),
+ HsExplicitForAll(..),
mkSimpleMatch, andMonoBinds, andMonoBindList,
- isPragSig, placeHolderType, mkHsForAllTy
+ isPragSig, placeHolderType, mkExplicitHsForAllTy
)
import BasicTypes ( RecFlag(..), NewOrData(..) )
import RnHsSyn ( RenamedTyClDecl, RenamedSig,
eqPatType :: HsType Name -> HsType Name -> Bool
-- A very simple equality function, only for
-- type patterns in generic function definitions.
-eqPatType (HsTyVar v1) (HsTyVar v2) = v1==v2
-eqPatType (HsAppTy s1 t1) (HsAppTy s2 t2) = s1 `eqPatType` s2 && t2 `eqPatType` t2
+eqPatType (HsTyVar v1) (HsTyVar v2) = v1==v2
+eqPatType (HsAppTy s1 t1) (HsAppTy s2 t2) = s1 `eqPatType` s2 && t2 `eqPatType` t2
+eqPatType (HsOpTy s1 op1 t1) (HsOpTy s2 op2 t2) = s1 `eqPatType` s2 && t2 `eqPatType` t2 && op1 == op2
+eqPatType (HsNumTy n1) (HsNumTy n2) = n1 == n2
+eqPatType (HsParTy t1) t2 = t1 `eqPatType` t2
+eqPatType t1 (HsParTy t2) = t1 `eqPatType` t2
eqPatType _ _ = False
---------------------------------
-- works in the standard way
let
sig_tvs = map UserTyVar (nameSetToList (extractHsTyVars hs_ty))
- hs_forall_ty = mkHsForAllTy (Just sig_tvs) [] hs_ty
+ hs_forall_ty = mkExplicitHsForAllTy sig_tvs [] hs_ty
in
-- Type-check the instance type, and check its form
tcHsSigType GenPatCtxt hs_forall_ty `thenM` \ forall_inst_ty ->
ptext SLIT("All the type patterns for a generic type constructor must be identical")
]
where
- ppr_inst_ty (tc,inst) = ppr (simpleInstInfoTy inst)
+ ppr_inst_ty (tc,inst) = ppr tc <+> ppr (simpleInstInfoTy inst)
mixedGenericErr op
= ptext SLIT("Can't mix generic and non-generic equations for class method") <+> quotes (ppr op)
= hang (ptext SLIT("In the scrutinee of a case expression:")) 4 (ppr expr)
exprSigCtxt expr
- = hang (ptext SLIT("When checking the type signature of the expression:"))
+ = hang (ptext SLIT("In the type signature of the expression:"))
4 (ppr expr)
exprCtxt expr
get_tag_rhs = ExprWithTySig
(HsLam (mkSimpleHsAlt (VarPat a_RDR)
(HsApp (HsVar getTag_RDR) a_Expr)))
- (HsForAllTy (Just (map UserTyVar tvs)) [] con2tag_ty)
+ (mkExplicitHsForAllTy (map UserTyVar tvs) [] con2tag_ty)
con2tag_ty = foldl HsAppTy (HsTyVar (getRdrName tycon))
(map HsTyVar tvs)
TyThing(..), TcTyThing(..),
getInLocalScope
)
-import TcMType ( newKindVar, tcInstType, newMutTyVar,
+import TcMType ( newKindVar, newOpenTypeKind, tcInstType, newMutTyVar,
zonkTcType, zonkTcKindToKind,
checkValidType, UserTypeCtxt(..), pprHsSigCtxt
)
-import TcUnify ( unifyKind, unifyFunKind, unifyTypeKind )
+import TcUnify ( unifyKind, unifyFunKind )
import TcType ( Type, PredType(..), ThetaType, TyVarDetails(..),
TcTyVar, TcKind, TcThetaType, TcTauType,
- mkTyVarTy, mkTyVarTys, mkFunTy,
+ mkTyVarTy, mkTyVarTys, mkFunTy, isTypeKind,
mkForAllTys, mkFunTys, tcEqType, isPredTy,
mkSigmaTy, mkPredTy, mkGenTyConApp, mkTyConApp, mkAppTys,
liftedTypeKind, unliftedTypeKind, eqKind,
\begin{code}
---------------------------
kcLiftedType :: HsType Name -> TcM (HsType Name)
- -- The type ty must be a *lifted* *type*
+-- The type ty must be a *lifted* *type*
kcLiftedType ty = kcCheckHsType ty liftedTypeKind
---------------------------
kcTypeType :: HsType Name -> TcM (HsType Name)
- -- The type ty must be a *type*, but it can be lifted or unlifted
+-- The type ty must be a *type*, but it can be lifted or unlifted
+-- Be sure to use checkExpectedKind, rather than simply unifying
+-- with (Type bx), because it gives better error messages
kcTypeType ty
= kcHsType ty `thenM` \ (ty', kind) ->
- unifyTypeKind kind `thenM_`
+ if isTypeKind kind then
+ return ty'
+ else
+ newOpenTypeKind `thenM` \ type_kind ->
+ checkExpectedKind (ppr ty) kind type_kind `thenM_`
returnM ty'
---------------------------
= kcHsPred pred `thenM` \ pred' ->
returnM (HsPredTy pred', liftedTypeKind)
-kcHsType (HsForAllTy (Just tv_names) context ty)
+kcHsType (HsForAllTy exp tv_names context ty)
= kcHsTyVars tv_names $ \ tv_names' ->
kcHsContext context `thenM` \ ctxt' ->
kcLiftedType ty `thenM` \ ty' ->
-- The body of a forall must be of kind *
-- In principle, I suppose, we could allow unlifted types,
-- but it seems simpler to stick to lifted types for now.
- returnM (HsForAllTy (Just tv_names') ctxt' ty', liftedTypeKind)
+ returnM (HsForAllTy exp tv_names' ctxt' ty', liftedTypeKind)
---------------------------
kcApps :: TcKind -- Function kind
= dsHsPred pred `thenM` \ pred' ->
returnM (mkPredTy pred')
-dsHsType full_ty@(HsForAllTy (Just tv_names) ctxt ty)
+dsHsType full_ty@(HsForAllTy exp tv_names ctxt ty)
= tcTyVarBndrs tv_names $ \ tyvars ->
mappM dsHsPred ctxt `thenM` \ theta ->
dsHsType ty `thenM` \ tau ->
\begin{code}
instDeclCtxt1 hs_inst_ty
= inst_decl_ctxt (case hs_inst_ty of
- HsForAllTy _ _ (HsPredTy pred) -> ppr pred
- HsPredTy pred -> ppr pred
- other -> ppr hs_inst_ty) -- Don't expect this
+ HsForAllTy _ _ _ (HsPredTy pred) -> ppr pred
+ HsPredTy pred -> ppr pred
+ other -> ppr hs_inst_ty) -- Don't expect this
instDeclCtxt2 dfun_ty
= inst_decl_ctxt (ppr (mkClassPred cls tys))
where
newTyVar, newSigTyVar,
newTyVarTy, -- Kind -> TcM TcType
newTyVarTys, -- Int -> Kind -> TcM [TcType]
- newKindVar, newKindVars, newBoxityVar,
+ newKindVar, newKindVars, newOpenTypeKind,
putTcTyVar, getTcTyVar,
newMutTyVar, readMutTyVar, writeMutTyVar,
)
import TcType ( TcType, TcThetaType, TcTauType, TcPredType,
TcTyVarSet, TcKind, TcTyVar, TyVarDetails(..),
- tcEqType, tcCmpPred, isClassPred,
+ tcEqType, tcCmpPred, isClassPred, mkTyConApp, typeCon,
tcSplitPhiTy, tcSplitPredTy_maybe, tcSplitAppTy_maybe,
tcSplitTyConApp_maybe, tcSplitForAllTys,
tcIsTyVarTy, tcSplitSigmaTy, tcIsTyVarTy,
newMutTyVar (mkSystemTvNameEncoded uniq FSLIT("bx"))
superBoxity VanillaTv `thenM` \ kv ->
returnM (TyVarTy kv)
+
+newOpenTypeKind :: TcM TcKind
+newOpenTypeKind = newBoxityVar `thenM` \ bx_var ->
+ returnM (mkTyConApp typeCon [bx_var])
\end{code}
Kind, -- Stuff to do with kinds is insensitive to pre/post Tc
unliftedTypeKind, liftedTypeKind, openTypeKind, mkArrowKind, mkArrowKinds,
superBoxity, liftedBoxity, hasMoreBoxityInfo, defaultKind, superKind,
- isTypeKind, isAnyTypeKind,
+ isTypeKind, isAnyTypeKind, typeCon,
Type, PredType(..), ThetaType,
mkForAllTy, mkForAllTys,
import Type ( -- Re-exports
tyVarsOfType, tyVarsOfTypes, tyVarsOfPred,
tyVarsOfTheta, Kind, Type, PredType(..),
- ThetaType, unliftedTypeKind,
+ ThetaType, unliftedTypeKind, typeCon,
liftedTypeKind, openTypeKind, mkArrowKind,
mkArrowKinds, mkForAllTy, mkForAllTys,
defaultKind, isTypeKind, isAnyTypeKind,
-- Various unifications
unifyTauTy, unifyTauTyList, unifyTauTyLists,
- unifyKind, unifyKinds, unifyTypeKind, unifyFunKind,
+ unifyKind, unifyKinds, unifyFunKind,
--------------------------------
-- Holes
)
import Inst ( newDicts, instToId, tcInstCall )
import TcMType ( getTcTyVar, putTcTyVar, tcInstType, newKindVar,
- newTyVarTy, newTyVarTys, newBoxityVar,
+ newTyVarTy, newTyVarTys, newOpenTypeKind,
zonkTcType, zonkTcTyVars, zonkTcTyVarsAndFV )
import TcSimplify ( tcSimplifyCheck )
import TysWiredIn ( listTyCon, parrTyCon, tupleTyCon )
= getTcTyVar tyvar `thenM` \ maybe_ty ->
case maybe_ty of
Just ty' -> unifyTypeKind ty'
- Nothing -> newBoxityVar `thenM` \ bx_var ->
- putTcTyVar tyvar (mkTyConApp typeCon [bx_var]) `thenM_`
+ Nothing -> newOpenTypeKind `thenM` \ kind ->
+ putTcTyVar tyvar kind `thenM_`
returnM ()
unifyTypeKind ty
projects / ghc-hetmet.git / commitdiff