import Var
import Id ( mkWildId )
import MkId ( unwrapFamInstScrut )
+import Name ( Name )
import PrelNames
import TysWiredIn
import BasicTypes ( Boxity(..) )
mkDataConTag :: DataCon -> CoreExpr
mkDataConTag dc = mkConApp intDataCon [mkIntLitInt $ dataConTag dc]
-isClosureTyCon :: TyCon -> Bool
-isClosureTyCon tc = tyConName tc == closureTyConName
+splitUnTy :: String -> Name -> Type -> Type
+splitUnTy s name ty
+ | Just (tc, [ty']) <- splitTyConApp_maybe ty
+ , tyConName tc == name
+ = ty'
-splitClosureTy :: Type -> (Type, Type)
-splitClosureTy ty
- | Just (tc, [arg_ty, res_ty]) <- splitTyConApp_maybe ty
- , isClosureTyCon tc
- = (arg_ty, res_ty)
+ | otherwise = pprPanic s (ppr ty)
- | otherwise = pprPanic "splitClosureTy" (ppr ty)
+splitBinTy :: String -> Name -> Type -> (Type, Type)
+splitBinTy s name ty
+ | Just (tc, [ty1, ty2]) <- splitTyConApp_maybe ty
+ , tyConName tc == name
+ = (ty1, ty2)
-isPArrayTyCon :: TyCon -> Bool
-isPArrayTyCon tc = tyConName tc == parrayTyConName
+ | otherwise = pprPanic s (ppr ty)
-splitPArrayTy :: Type -> Type
-splitPArrayTy ty
- | Just (tc, [arg_ty]) <- splitTyConApp_maybe ty
- , isPArrayTyCon tc
- = arg_ty
+splitCrossTy :: Type -> (Type, Type)
+splitCrossTy = splitBinTy "splitCrossTy" ndpCrossTyConName
+
+splitPlusTy :: Type -> (Type, Type)
+splitPlusTy = splitBinTy "splitSumTy" ndpPlusTyConName
+
+splitEmbedTy :: Type -> Type
+splitEmbedTy = splitUnTy "splitEmbedTy" embedTyConName
- | otherwise = pprPanic "splitPArrayTy" (ppr ty)
+splitClosureTy :: Type -> (Type, Type)
+splitClosureTy = splitBinTy "splitClosureTy" closureTyConName
+
+splitPArrayTy :: Type -> Type
+splitPArrayTy = splitUnTy "splitPArrayTy" parrayTyConName
mkBuiltinTyConApp :: (Builtins -> TyCon) -> [Type] -> VM Type
mkBuiltinTyConApp get_tc tys