-- Splitters
-- These are important because they do not look through newtypes
tcView,
- tcSplitForAllTys, tcSplitPhiTy,
+ tcSplitForAllTys, tcSplitPhiTy, tcSplitPredFunTy_maybe,
tcSplitFunTy_maybe, tcSplitFunTys, tcFunArgTy, tcFunResultTy, tcSplitFunTysN,
tcSplitTyConApp, tcSplitTyConApp_maybe, tcTyConAppTyCon, tcTyConAppArgs,
tcSplitAppTy_maybe, tcSplitAppTy, tcSplitAppTys, repSplitAppTy_maybe,
getClassPredTys_maybe, getClassPredTys,
isClassPred, isTyVarClassPred, isEqPred,
mkDictTy, tcSplitPredTy_maybe,
- isPredTy, isDictTy, tcSplitDFunTy, tcSplitDFunHead, predTyUnique,
+ isPredTy, isDictTy, isDictLikeTy,
+ tcSplitDFunTy, tcSplitDFunHead, predTyUnique,
mkClassPred, isInheritablePred, isIPPred,
- dataConsStupidTheta, isRefineableTy, isRefineablePred,
+ isRefineableTy, isRefineablePred,
---------------------------------
-- Foreign import and export
unliftedTypeKind, liftedTypeKind, argTypeKind,
openTypeKind, mkArrowKind, mkArrowKinds,
isLiftedTypeKind, isUnliftedTypeKind, isSubOpenTypeKind,
- isSubArgTypeKind, isSubKind, defaultKind,
+ isSubArgTypeKind, isSubKind, splitKindFunTys, defaultKind,
kindVarRef, mkKindVar,
Type, PredType(..), ThetaType,
typeKind, tidyKind,
tyVarsOfType, tyVarsOfTypes, tyVarsOfPred, tyVarsOfTheta,
- tcTyVarsOfType, tcTyVarsOfTypes, exactTyVarsOfType, exactTyVarsOfTypes,
+ tcTyVarsOfType, tcTyVarsOfTypes, tcTyVarsOfPred, exactTyVarsOfType,
+ exactTyVarsOfTypes,
pprKind, pprParendKind,
pprType, pprParendType, pprTypeApp, pprTyThingCategory,
import Class
import Var
import ForeignCall
-import Unify
import VarSet
import Type
import Coercion
-- others:
import DynFlags
-import CoreSyn
import Name
import NameSet
import VarEnv
| ForSigCtxt Name -- Foreign inport or export signature
| DefaultDeclCtxt -- Types in a default declaration
| SpecInstCtxt -- SPECIALISE instance pragma
+ | ThBrackCtxt -- Template Haskell type brackets [t| ... |]
-- Notes re TySynCtxt
-- We allow type synonyms that aren't types; e.g. type List = []
pprUserTypeCtxt (ConArgCtxt c) = ptext (sLit "the type of the constructor") <+> quotes (ppr c)
pprUserTypeCtxt (TySynCtxt c) = ptext (sLit "the RHS of the type synonym") <+> quotes (ppr c)
pprUserTypeCtxt GenPatCtxt = ptext (sLit "the type pattern of a generic definition")
+pprUserTypeCtxt ThBrackCtxt = ptext (sLit "a Template Haskell quotation [t|...|]")
pprUserTypeCtxt LamPatSigCtxt = ptext (sLit "a pattern type signature")
pprUserTypeCtxt BindPatSigCtxt = ptext (sLit "a pattern type signature")
pprUserTypeCtxt ResSigCtxt = ptext (sLit "a result type signature")
tidySkolemTyVar :: TidyEnv -> TcTyVar -> (TidyEnv, TcTyVar)
-- Tidy the type inside a GenSkol, preparatory to printing it
tidySkolemTyVar env tv
- = ASSERT( isSkolemTyVar tv || isSigTyVar tv )
+ = ASSERT( isTcTyVar tv && (isSkolemTyVar tv || isSigTyVar tv ) )
(env1, mkTcTyVar (tyVarName tv) (tyVarKind tv) info1)
where
(env1, info1) = case tcTyVarDetails tv of
SkolemTv {} -> False
isSkolemTyVar tv
- = ASSERT( isTcTyVar tv )
+ = ASSERT2( isTcTyVar tv, ppr tv )
case tcTyVarDetails tv of
SkolemTv _ -> True
MetaTv _ _ -> False
tcIsForAllTy (ForAllTy tv _) = not (isCoVar tv)
tcIsForAllTy _ = False
-tcSplitPhiTy :: Type -> (ThetaType, Type)
-tcSplitPhiTy ty = split ty ty []
- where
- split orig_ty ty tvs | Just ty' <- tcView ty = split orig_ty ty' tvs
+tcSplitPredFunTy_maybe :: Type -> Maybe (PredType, Type)
+-- Split off the first predicate argument from a type
+tcSplitPredFunTy_maybe ty | Just ty' <- tcView ty = tcSplitPredFunTy_maybe ty'
+tcSplitPredFunTy_maybe (ForAllTy tv ty)
+ | isCoVar tv = Just (coVarPred tv, ty)
+tcSplitPredFunTy_maybe (FunTy arg res)
+ | Just p <- tcSplitPredTy_maybe arg = Just (p, res)
+tcSplitPredFunTy_maybe _
+ = Nothing
- split _ (ForAllTy tv ty) ts
- | isCoVar tv = split ty ty (coVarPred tv : ts)
- split _ (FunTy arg res) ts
- | Just p <- tcSplitPredTy_maybe arg = split res res (p:ts)
- split orig_ty _ ts = (reverse ts, orig_ty)
+tcSplitPhiTy :: Type -> (ThetaType, Type)
+tcSplitPhiTy ty
+ = split ty []
+ where
+ split ty ts
+ = case tcSplitPredFunTy_maybe ty of
+ Just (pred, ty) -> split ty (pred:ts)
+ Nothing -> (reverse ts, ty)
tcSplitSigmaTy :: Type -> ([TyVar], ThetaType, Type)
tcSplitSigmaTy ty = case tcSplitForAllTys ty of
isDictTy ty | Just ty' <- tcView ty = isDictTy ty'
isDictTy (PredTy p) = isClassPred p
isDictTy _ = False
+
+isDictLikeTy :: Type -> Bool
+-- Note [Dictionary-like types]
+isDictLikeTy ty | Just ty' <- tcView ty = isDictTy ty'
+isDictLikeTy (PredTy p) = isClassPred p
+isDictLikeTy (TyConApp tc tys)
+ | isTupleTyCon tc = all isDictLikeTy tys
+isDictLikeTy _ = False
\end{code}
+Note [Dictionary-like types]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Being "dictionary-like" means either a dictionary type or a tuple thereof.
+In GHC 6.10 we build implication constraints which construct such tuples,
+and if we land up with a binding
+ t :: (C [a], Eq [a])
+ t = blah
+then we want to treat t as cheap under "-fdicts-cheap" for example.
+(Implication constraints are normally inlined, but sadly not if the
+occurrence is itself inside an INLINE function! Until we revise the
+handling of implication constraints, that is.) This turned out to
+be important in getting good arities in DPH code. Example:
+
+ class C a
+ class D a where { foo :: a -> a }
+ instance C a => D (Maybe a) where { foo x = x }
+
+ bar :: (C a, C b) => a -> b -> (Maybe a, Maybe b)
+ {-# INLINE bar #-}
+ bar x y = (foo (Just x), foo (Just y))
+
+Then 'bar' should jolly well have arity 4 (two dicts, two args), but
+we ended up with something like
+ bar = __inline_me__ (\d1,d2. let t :: (D (Maybe a), D (Maybe b)) = ...
+ in \x,y. <blah>)
+
+This is all a bit ad-hoc; eg it relies on knowing that implication
+constraints build tuples.
+
--------------------- Implicit parameters ---------------------------------
\begin{code}
| (tv,ty) <- eq_spec]
\end{code}
---------------------- The stupid theta (sigh) ---------------------------------
-
-\begin{code}
-dataConsStupidTheta :: [DataCon] -> ThetaType
--- Union the stupid thetas from all the specified constructors (non-empty)
--- All the constructors should have the same result type, modulo alpha conversion
--- The resulting ThetaType uses type variables from the *first* constructor in the list
---
--- It's here because it's used in MkId.mkRecordSelId, and in TcExpr
-dataConsStupidTheta (con1:cons)
- = nubBy tcEqPred all_preds
- where
- all_preds = dataConStupidTheta con1 ++ other_stupids
- res_ty1 = dataConOrigResTy con1
- other_stupids = [ substPred subst pred
- | con <- cons
- , let (tvs, _, _, res_ty) = dataConSig con
- Just subst = tcMatchTy (mkVarSet tvs) res_ty res_ty1
- , pred <- dataConStupidTheta con ]
-dataConsStupidTheta [] = panic "dataConsStupidTheta"
-\end{code}
-
%************************************************************************
%* *
isSigmaTy _ = False
isOverloadedTy :: Type -> Bool
+-- Yes for a type of a function that might require evidence-passing
+-- Used only by bindInstsOfLocalFuns/Pats
+-- NB: be sure to check for type with an equality predicate; hence isCoVar
isOverloadedTy ty | Just ty' <- tcView ty = isOverloadedTy ty'
-isOverloadedTy (ForAllTy _ ty) = isOverloadedTy ty
-isOverloadedTy (FunTy a _) = isPredTy a
-isOverloadedTy _ = False
+isOverloadedTy (ForAllTy tv ty) = isCoVar tv || isOverloadedTy ty
+isOverloadedTy (FunTy a _) = isPredTy a
+isOverloadedTy _ = False
isPredTy :: Type -> Bool -- Belongs in TcType because it does
-- not look through newtypes, or predtypes (of course)
-- hence no 'coreView'. This could, however, be changed without breaking
-- any code.
isOpenSynTyConApp :: TcTauType -> Bool
-isOpenSynTyConApp (TyConApp tc _) = isOpenSynTyCon tc
-isOpenSynTyConApp _other = False
+isOpenSynTyConApp (TyConApp tc tys) = isOpenSynTyCon tc &&
+ length tys == tyConArity tc
+isOpenSynTyConApp _other = False
\end{code}
]
checkRepTyCon :: (TyCon -> Bool) -> Type -> Bool
- -- Look through newtypes
- -- Non-recursive ones are transparent to splitTyConApp,
- -- but recursive ones aren't. Manuel had:
- -- newtype T = MkT (Ptr T)
- -- and wanted it to work...
-checkRepTyCon check_tc ty
- | Just (tc,_) <- splitTyConApp_maybe (repType ty) = check_tc tc
- | otherwise = False
+-- Look through newtypes, but *not* foralls
+-- Should work even for recursive newtypes
+-- eg Manuel had: newtype T = MkT (Ptr T)
+checkRepTyCon check_tc ty
+ = go [] ty
+ where
+ go rec_nts ty
+ | Just (tc,tys) <- splitTyConApp_maybe ty
+ = case carefullySplitNewType_maybe rec_nts tc tys of
+ Just (rec_nts', ty') -> go rec_nts' ty'
+ Nothing -> check_tc tc
+ | otherwise
+ = False
checkRepTyConKey :: [Unique] -> Type -> Bool
-- Like checkRepTyCon, but just looks at the TyCon key
projects / ghc-hetmet.git / blobdiff