summary |
shortlog |
log |
commit | commitdiff |
tree
raw |
patch |
inline | side by side (from parent 1:
242855e)
new function: splitForAllTyExpandingDicts
getFunTy_maybe, getFunTyExpandingDicts_maybe,
mkTyConTy, getTyCon_maybe, applyTyCon,
mkSynTy,
getFunTy_maybe, getFunTyExpandingDicts_maybe,
mkTyConTy, getTyCon_maybe, applyTyCon,
mkSynTy,
- mkForAllTy, mkForAllTys, getForAllTy_maybe, getForAllTyExpandingDicts_maybe, splitForAllTy,
+ mkForAllTy, mkForAllTys, getForAllTy_maybe, getForAllTyExpandingDicts_maybe, splitForAllTy, splitForAllTyExpandingDicts,
mkForAllUsageTy, getForAllUsageTy,
applyTy,
#ifdef DEBUG
mkForAllUsageTy, getForAllUsageTy,
applyTy,
#ifdef DEBUG
--IMPORT_DELOOPER(PrelLoop) -- for paranoia checking
-- friends:
--IMPORT_DELOOPER(PrelLoop) -- for paranoia checking
-- friends:
-import Class --( classSig, classOpLocalType, GenClass{-instances-} )
+import Class ( classSig, classOpLocalType, GenClass{-instances-} )
import Kind ( mkBoxedTypeKind, resultKind, notArrowKind, Kind )
import TyCon ( mkFunTyCon, isFunTyCon, isEnumerationTyCon, isTupleTyCon, maybeTyConSingleCon,
import Kind ( mkBoxedTypeKind, resultKind, notArrowKind, Kind )
import TyCon ( mkFunTyCon, isFunTyCon, isEnumerationTyCon, isTupleTyCon, maybeTyConSingleCon,
- isPrimTyCon, isDataTyCon, isSynTyCon, maybeNewTyCon, isNewTyCon,
+ isPrimTyCon, isAlgTyCon, isDataTyCon, isSynTyCon, maybeNewTyCon, isNewTyCon,
tyConKind, tyConDataCons, getSynTyConDefn, TyCon )
import TyVar ( tyVarKind, GenTyVar{-instances-}, SYN_IE(GenTyVarSet),
emptyTyVarSet, unionTyVarSets, minusTyVarSet,
tyConKind, tyConDataCons, getSynTyConDefn, TyCon )
import TyVar ( tyVarKind, GenTyVar{-instances-}, SYN_IE(GenTyVarSet),
emptyTyVarSet, unionTyVarSets, minusTyVarSet,
getForAllTyExpandingDicts_maybe ty@(DictTy _ _ _) = getForAllTyExpandingDicts_maybe (expandTy ty)
getForAllTyExpandingDicts_maybe _ = Nothing
getForAllTyExpandingDicts_maybe ty@(DictTy _ _ _) = getForAllTyExpandingDicts_maybe (expandTy ty)
getForAllTyExpandingDicts_maybe _ = Nothing
-splitForAllTy :: GenType t u-> ([t], GenType t u)
+splitForAllTy :: GenType t u -> ([t], GenType t u)
splitForAllTy t = go t t []
where
-- See notes on type synonyms above
go syn_t (ForAllTy tv t) tvs = go t t (tv:tvs)
go syn_t (SynTy _ _ t) tvs = go syn_t t tvs
go syn_t t tvs = (reverse tvs, syn_t)
splitForAllTy t = go t t []
where
-- See notes on type synonyms above
go syn_t (ForAllTy tv t) tvs = go t t (tv:tvs)
go syn_t (SynTy _ _ t) tvs = go syn_t t tvs
go syn_t t tvs = (reverse tvs, syn_t)
+
+splitForAllTyExpandingDicts :: Type -> ([TyVar], Type)
+splitForAllTyExpandingDicts ty
+ = go [] ty
+ where
+ go tvs ty = case getForAllTyExpandingDicts_maybe ty of
+ Just (tv, ty') -> go (tv:tvs) ty'
+ Nothing -> (reverse tvs, ty)
Applied data tycons (give back constrs)
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Applied data tycons (give back constrs)
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Nota Bene: all these functions suceed for @newtype@ applications too!
+
\begin{code}
maybeAppDataTyCon
:: GenType (GenTyVar any) uvar
\begin{code}
maybeAppDataTyCon
:: GenType (GenTyVar any) uvar
(app_ty, arg_tys) = splitAppTys expanded_ty
in
case (getTyCon_maybe app_ty) of
(app_ty, arg_tys) = splitAppTys expanded_ty
in
case (getTyCon_maybe app_ty) of
- Just tycon | --pprTrace "maybe_app:" (hsep [ppr PprDebug (isDataTyCon tycon), ppr PprDebug (notArrowKind (typeKind expanded_ty))]) $
- isDataTyCon tycon &&
+ Just tycon | isAlgTyCon tycon && -- NB "Alg"; succeeds for newtype too
notArrowKind (typeKind expanded_ty)
-- Must be saturated for ty to be a data type
-> Just (tycon, arg_tys, tyConDataCons tycon)
notArrowKind (typeKind expanded_ty)
-- Must be saturated for ty to be a data type
-> Just (tycon, arg_tys, tyConDataCons tycon)
maybeBoxedPrimType :: Type -> Maybe (Id, Type)
maybeBoxedPrimType ty
maybeBoxedPrimType :: Type -> Maybe (Id, Type)
maybeBoxedPrimType ty
- = case (maybeAppDataTyCon ty) of -- Data type,
- Just (tycon, tys_applied, [data_con]) -- with exactly one constructor
+ = case (maybeAppDataTyCon ty) of -- Data type,
+ Just (tycon, tys_applied, [data_con]) | isDataTyCon tycon -- with exactly one constructor
-> case (dataConArgTys data_con tys_applied) of
[data_con_arg_ty] -- Applied to exactly one type,
| isPrimType data_con_arg_ty -- which is primitive
-> case (dataConArgTys data_con tys_applied) of
[data_con_arg_ty] -- Applied to exactly one type,
| isPrimType data_con_arg_ty -- which is primitive