splitTyConApp_maybe, splitTyConApp,
splitNewTyConApp_maybe, splitNewTyConApp,
- repType, typePrimRep, coreView, tcView, kindView,
+ repType, repType', typePrimRep, coreView, tcView, kindView,
mkForAllTy, mkForAllTys, splitForAllTy_maybe, splitForAllTys,
applyTy, applyTys, isForAllTy, dropForAlls,
-- Source types
predTypeRep, mkPredTy, mkPredTys,
+ tyConOrigHead, pprSourceTyCon,
-- Newtypes
splitRecNewType_maybe, newTyConInstRhs,
-- Performing substitution on types
substTy, substTys, substTyWith, substTheta,
- substPred, substTyVar, substTyVarBndr, deShadowTy, lookupTyVar,
+ substPred, substTyVar, substTyVars, substTyVarBndr, deShadowTy, lookupTyVar,
-- Pretty-printing
- pprType, pprParendType, pprTyThingCategory,
+ pprType, pprParendType, pprTypeApp, pprTyThingCategory, pprForAll,
pprPred, pprTheta, pprThetaArrow, pprClassPred, pprKind, pprParendKind
) where
newTyConInstRhs :: TyCon -> [Type] -> Type
newTyConInstRhs tycon tys =
let (tvs, ty) = newTyConRhs tycon in substTyWith tvs tys ty
-
\end{code}
repType (new_type_rep tc tys)
repType ty = ty
+-- repType' aims to be a more thorough version of repType
+-- For now it simply looks through the TyConApp args too
+repType' ty -- | pprTrace "repType'" (ppr ty $$ ppr (go1 ty)) False = undefined
+ | otherwise = go1 ty
+ where
+ go1 = go . repType
+ go (TyConApp tc tys) = mkTyConApp tc (map repType' tys)
+ go ty = ty
+
+
-- new_type_rep doesn't ask any questions:
-- it just expands newtype, whether recursive or not
new_type_rep new_tycon tys = ASSERT( tys `lengthIs` tyConArity new_tycon )
-- Result might be a newtype application, but the consumer will
-- look through that too if necessary
predTypeRep (EqPred ty1 ty2) = pprPanic "predTypeRep" (ppr (EqPred ty1 ty2))
+
+-- The original head is the tycon and its variables for a vanilla tycon and it
+-- is the family tycon and its type indexes for a family instance.
+tyConOrigHead :: TyCon -> (TyCon, [Type])
+tyConOrigHead tycon = case tyConFamInst_maybe tycon of
+ Nothing -> (tycon, mkTyVarTys (tyConTyVars tycon))
+ Just famInst -> famInst
+
+-- Pretty prints a tycon, using the family instance in case of a
+-- representation tycon. For example
+-- e.g. data T [a] = ...
+-- In that case we want to print `T [a]', where T is the family TyCon
+pprSourceTyCon tycon
+ | Just (repTyCon, tys) <- tyConFamInst_maybe tycon
+ = ppr $ repTyCon `TyConApp` tys -- can't be FunTyCon
+ | otherwise
+ = ppr tycon
\end{code}
-------------
cmpPredX :: RnEnv2 -> PredType -> PredType -> Ordering
cmpPredX env (IParam n1 ty1) (IParam n2 ty2) = (n1 `compare` n2) `thenCmp` cmpTypeX env ty1 ty2
- -- Compare types as well as names for implicit parameters
- -- This comparison is used exclusively (I think) for the
- -- finite map built in TcSimplify
-cmpPredX env (ClassP c1 tys1) (ClassP c2 tys2) = (c1 `compare` c2) `thenCmp` cmpTypesX env tys1 tys2
+ -- Compare names only for implicit parameters
+ -- This comparison is used exclusively (I believe)
+ -- for the Avails finite map built in TcSimplify
+ -- If the types differ we keep them distinct so that we see
+ -- a distinct pair to run improvement on
+cmpPredX env (ClassP c1 tys1) (ClassP c2 tys2) = (c1 `compare` c2) `thenCmp` (cmpTypesX env tys1 tys2)
cmpPredX env (EqPred ty1 ty2) (EqPred ty1' ty2') = (cmpTypeX env ty1 ty1') `thenCmp` (cmpTypeX env ty2 ty2')
-- Constructor order: IParam < ClassP < EqPred
Just ty -> ty -- See Note [Apply Once]
}
+substTyVars :: TvSubst -> [TyVar] -> [Type]
+substTyVars subst tvs = map (substTyVar subst) tvs
+
lookupTyVar :: TvSubst -> TyVar -> Maybe Type
-- See Note [Extending the TvSubst]
lookupTyVar (TvSubst in_scope env) tv = lookupVarEnv env tv