-maybeAppDataTyCon
- :: GenType (GenTyVar any) uvar
- -> Maybe (TyCon, -- the type constructor
- [GenType (GenTyVar any) uvar], -- types to which it is applied
- [Id]) -- its family of data-constructors
-maybeAppDataTyConExpandingDicts, maybeAppSpecDataTyConExpandingDicts
- :: Type -> Maybe (TyCon, [Type], [Id])
-
-maybeAppDataTyCon ty = maybe_app_data_tycon (\x->x) ty
-maybeAppDataTyConExpandingDicts ty = maybe_app_data_tycon expandTy ty
-maybeAppSpecDataTyConExpandingDicts ty = maybe_app_data_tycon expandTy ty
-
-
-maybe_app_data_tycon expand ty
- = let
- expanded_ty = expand ty
- (app_ty, arg_tys) = splitAppTy expanded_ty
- in
- case (getTyCon_maybe app_ty) of
- Just tycon | --pprTrace "maybe_app:" (ppCat [ppr PprDebug (isDataTyCon tycon), ppr PprDebug (notArrowKind (typeKind expanded_ty))]) $
- isDataTyCon tycon &&
- notArrowKind (typeKind expanded_ty)
- -- Must be saturated for ty to be a data type
- -> Just (tycon, arg_tys, tyConDataCons tycon)
-
- other -> Nothing
-
-getAppDataTyCon, getAppSpecDataTyCon
- :: GenType (GenTyVar any) uvar
- -> (TyCon, -- the type constructor
- [GenType (GenTyVar any) uvar], -- types to which it is applied
- [Id]) -- its family of data-constructors
-getAppDataTyConExpandingDicts, getAppSpecDataTyConExpandingDicts
- :: Type -> (TyCon, [Type], [Id])
-
-getAppDataTyCon ty = get_app_data_tycon maybeAppDataTyCon ty
-getAppDataTyConExpandingDicts ty = --pprTrace "getAppDataTyConEx...:" (pprType PprDebug ty) $
- get_app_data_tycon maybeAppDataTyConExpandingDicts ty
-
--- these should work like the UniTyFuns.getUniDataSpecTyCon* things of old (ToDo)
-getAppSpecDataTyCon = getAppDataTyCon
-getAppSpecDataTyConExpandingDicts = getAppDataTyConExpandingDicts
-
-get_app_data_tycon maybe ty
- = case maybe ty of
- Just stuff -> stuff
-#ifdef DEBUG
- Nothing -> panic "Type.getAppDataTyCon"-- (pprGenType PprShowAll ty)
-#endif
-
-
-maybeBoxedPrimType :: Type -> Maybe (Id, Type)
-
-maybeBoxedPrimType ty
- = case (maybeAppDataTyCon ty) of -- Data type,
- Just (tycon, tys_applied, [data_con]) -- 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
- -> Just (data_con, data_con_arg_ty)
- other_cases -> Nothing
- other_cases -> Nothing
+isTauTy :: GenType flexi -> Bool
+isTauTy (TyVarTy v) = True
+isTauTy (TyConApp _ tys) = all isTauTy tys
+isTauTy (AppTy a b) = isTauTy a && isTauTy b
+isTauTy (FunTy a b) = isTauTy a && isTauTy b
+isTauTy (NoteTy _ ty) = isTauTy ty
+isTauTy other = False
+\end{code}
+
+\begin{code}
+mkRhoTy :: [(Class, [GenType flexi])] -> GenType flexi -> GenType flexi
+mkRhoTy theta ty = foldr (\(c,t) r -> FunTy (mkDictTy c t) r) ty theta
+
+splitRhoTy :: GenType flexi -> ([(Class, [GenType flexi])], GenType flexi)
+splitRhoTy ty = split ty ty []
+ where
+ split orig_ty (FunTy arg res) ts = case splitDictTy_maybe arg of
+ Just pair -> split res res (pair:ts)
+ Nothing -> (reverse ts, orig_ty)
+ split orig_ty (NoteTy _ ty) ts = split orig_ty ty ts
+ split orig_ty ty ts = (reverse ts, orig_ty)