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 -- ----------------------------------------------------------------------------
  18 -- Types
  19
  20 vectTyCon :: TyCon -> VM TyCon
  21 vectTyCon tc
  22   | isFunTyCon tc        = builtin closureTyCon
  23   | isBoxedTupleTyCon tc = return tc
  24   | isUnLiftedTyCon tc   = return tc
  25   | otherwise = do
  26                   r <- lookupTyCon tc
  27                   case r of
  28                     Just tc' -> return tc'
  29
  30                     -- FIXME: just for now
  31                     Nothing  -> pprTrace "ccTyCon:" (ppr tc) $ return tc
  32
  33 vectType :: Type -> VM Type
  34 vectType ty | Just ty' <- coreView ty = vectType ty'
  35 vectType (TyVarTy tv) = return $ TyVarTy tv
  36 vectType (AppTy ty1 ty2) = liftM2 AppTy (vectType ty1) (vectType ty2)
  37 vectType (TyConApp tc tys) = liftM2 TyConApp (vectTyCon tc) (mapM vectType tys)
  38 vectType (FunTy ty1 ty2)   = liftM2 TyConApp (builtin closureTyCon)
  39                                              (mapM vectType [ty1,ty2])
  40 vectType ty@(ForAllTy _ _)
  41   = do
  42       mdicts   <- mapM paDictArgType tyvars
  43       mono_ty' <- vectType mono_ty
  44       return $ tyvars `mkForAllTys` ([dict | Just dict <- mdicts] `mkFunTys` mono_ty')
  45   where
  46     (tyvars, mono_ty) = splitForAllTys ty
  47
  48 vectType ty = pprPanic "vectType:" (ppr ty)
  49