compiler/vectorise/VectUtils.hs

   1 module VectUtils (
   2   paDictArgType
   3 ) where
   4
   5 #include "HsVersions.h"
   6
   7 import VectMonad
   8
   9 import Type
  10 import TypeRep
  11 import Var
  12
  13 paDictArgType :: TyVar -> VM (Maybe Type)
  14 paDictArgType tv = go (TyVarTy tv) (tyVarKind tv)
  15   where
  16     go ty k | Just k' <- kindView k = go ty k'
  17     go ty (FunTy k1 k2)
  18       = do
  19           tv   <- newTyVar FSLIT("a") k1
  20           mty1 <- go (TyVarTy tv) k1
  21           case mty1 of
  22             Just ty1 -> do
  23                           mty2 <- go (AppTy ty (TyVarTy tv)) k2
  24                           return $ fmap (ForAllTy tv . FunTy ty1) mty2
  25             Nothing  -> go ty k2
  26
  27     go ty k
  28       | isLiftedTypeKind k
  29       = do
  30           tc <- builtin paDictTyCon
  31           return . Just $ TyConApp tc [ty]
  32
  33
  34     go ty k = return Nothing
  35