1 module Vectorise( vectorise )
4 #include "HsVersions.h"
9 import CoreLint ( showPass, endPass )
18 vectorise :: HscEnv -> ModGuts -> IO ModGuts
19 vectorise hsc_env guts
20 | not (Opt_Vectorise `dopt` dflags) = return guts
23 showPass dflags "Vectorisation"
25 let info = hptVectInfo hsc_env `plusVectInfo` eps_vect_info eps
26 Just guts' <- initDs hsc_env (mg_module guts)
29 (vectoriseModule info guts)
30 endPass dflags "Vectorisation" Opt_D_dump_vect (mg_binds guts')
33 dflags = hsc_dflags hsc_env
35 -- ----------------------------------------------------------------------------
36 -- Vectorisation monad
38 data Builtins = Builtins {
41 , closureTyCon :: TyCon
43 , applyClosureVar :: Var
44 , mkClosurePVar :: Var
45 , applyClosurePVar :: Var
48 , replicatePAVar :: Var
51 initBuiltins :: DsM Builtins
54 parrayTyCon <- dsLookupTyCon parrayTyConName
55 paTyCon <- dsLookupTyCon paTyConName
56 closureTyCon <- dsLookupTyCon closureTyConName
58 mkClosureVar <- dsLookupGlobalId mkClosureName
59 applyClosureVar <- dsLookupGlobalId applyClosureName
60 mkClosurePVar <- dsLookupGlobalId mkClosurePName
61 applyClosurePVar <- dsLookupGlobalId applyClosurePName
62 closurePAVar <- dsLookupGlobalId closurePAName
63 lengthPAVar <- dsLookupGlobalId lengthPAName
64 replicatePAVar <- dsLookupGlobalId replicatePAName
67 parrayTyCon = parrayTyCon
69 , closureTyCon = closureTyCon
70 , mkClosureVar = mkClosureVar
71 , applyClosureVar = applyClosureVar
72 , mkClosurePVar = mkClosurePVar
73 , applyClosurePVar = applyClosurePVar
74 , closurePAVar = closurePAVar
75 , lengthPAVar = lengthPAVar
76 , replicatePAVar = replicatePAVar
80 -- Mapping from variables to their vectorised versions
82 vect_vars :: VarEnv Var
85 initVEnv :: VectInfo -> DsM VEnv
88 vect_vars = mapVarEnv snd $ vectInfoCCVar info
92 updVectInfo :: VEnv -> VectInfo -> VectInfo
93 updVectInfo env info = info
95 newtype VM a = VM { runVM :: Builtins -> VEnv -> DsM (VEnv, a) }
97 instance Monad VM where
98 return x = VM $ \bi env -> return (env, x)
99 VM p >>= f = VM $ \bi env -> do
100 (env', x) <- p bi env
103 vectoriseModule :: VectInfo -> ModGuts -> DsM ModGuts
104 vectoriseModule info guts
106 builtins <- initBuiltins
108 (env', guts') <- runVM (vectModule guts) builtins env
109 return $ guts' { mg_vect_info = updVectInfo env' info }
111 vectModule :: ModGuts -> VM ModGuts
112 vectModule guts = return guts