Clean up
[ghc.git] / 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