compiler/vectorise/VectType.hs

   1 module VectType ( vectTyCon, vectType )
   2 where
   3
   4 #include "HsVersions.h"
   5
   6 import VectMonad
   7 import VectUtils
   8
   9 import TyCon
  10 import Type
  11 import TypeRep
  12
  13 import Outputable
  14
  15 import Control.Monad  ( liftM2 )
  16
  17 vectTyCon :: TyCon -> VM TyCon
  18 vectTyCon tc
  19   | isFunTyCon tc        = builtin closureTyCon
  20   | isBoxedTupleTyCon tc = return tc
  21   | isUnLiftedTyCon tc   = return tc
  22   | otherwise = do
  23                   r <- lookupTyCon tc
  24                   case r of
  25                     Just tc' -> return tc'
  26
  27                     -- FIXME: just for now
  28                     Nothing  -> pprTrace "ccTyCon:" (ppr tc) $ return tc
  29
  30 vectType :: Type -> VM Type
  31 vectType ty | Just ty' <- coreView ty = vectType ty'
  32 vectType (TyVarTy tv) = return $ TyVarTy tv
  33 vectType (AppTy ty1 ty2) = liftM2 AppTy (vectType ty1) (vectType ty2)
  34 vectType (TyConApp tc tys) = liftM2 TyConApp (vectTyCon tc) (mapM vectType tys)
  35 vectType (FunTy ty1 ty2)   = liftM2 TyConApp (builtin closureTyCon)
  36                                              (mapM vectType [ty1,ty2])
  37 vectType ty@(ForAllTy _ _)
  38   = do
  39       mdicts   <- mapM paDictArgType tyvars
  40       mono_ty' <- vectType mono_ty
  41       return $ tyvars `mkForAllTys` ([dict | Just dict <- mdicts] `mkFunTys` mono_ty')
  42   where
  43     (tyvars, mono_ty) = splitForAllTys ty
  44
  45 vectType ty = pprPanic "vectType:" (ppr ty)
  46