Option(..),
DynLibLoader(..),
fFlags, xFlags,
+ DPHBackend(..),
-- Configuration of the core-to-core and stg-to-stg phases
CoreToDo(..),
mainFunIs :: Maybe String,
ctxtStkDepth :: Int, -- Typechecker context stack depth
+ dphBackend :: DPHBackend,
+
thisPackage :: PackageId,
-- ways
mainFunIs = Nothing,
ctxtStkDepth = mAX_CONTEXT_REDUCTION_DEPTH,
+ dphBackend = DPHPar,
+
thisPackage = mainPackageId,
objectDir = Nothing,
| CoreCSE
| CoreDoRuleCheck Int{-CompilerPhase-} String -- Check for non-application of rules
-- matching this string
- | CoreDoVectorisation
+ | CoreDoVectorisation DPHBackend
| CoreDoNothing -- Useful when building up
| CoreDoPasses [CoreToDo] -- lists of these things
spec_constr = dopt Opt_SpecConstr dflags
liberate_case = dopt Opt_LiberateCase dflags
rule_check = ruleCheck dflags
- vectorisation = dopt Opt_Vectorise dflags
static_args = dopt Opt_StaticArgumentTransformation dflags
maybe_rule_check phase = runMaybe rule_check (CoreDoRuleCheck phase)
maybe_rule_check phase
]
+ vectorisation
+ = runWhen (dopt Opt_Vectorise dflags)
+ $ CoreDoPasses [ simpl_gently, CoreDoVectorisation (dphBackend dflags) ]
+
+
-- By default, we have 2 phases before phase 0.
-- Want to run with inline phase 2 after the specialiser to give
core_todo =
if opt_level == 0 then
- [runWhen vectorisation (CoreDoPasses [ simpl_gently, CoreDoVectorisation ]),
+ [vectorisation,
simpl_phase 0 ["final"] max_iter]
else {- opt_level >= 1 -} [
-- after this before anything else
runWhen static_args (CoreDoPasses [ simpl_gently, CoreDoStaticArgs ]),
- -- initial simplify: mk specialiser happy: minimum effort please
- simpl_gently,
-
-- We run vectorisation here for now, but we might also try to run
-- it later
- runWhen vectorisation (CoreDoPasses [ CoreDoVectorisation, simpl_gently ]),
+ vectorisation,
+
+ -- initial simplify: mk specialiser happy: minimum effort please
+ simpl_gently,
-- Specialisation is best done before full laziness
-- so that overloaded functions have all their dictionary lambdas manifest
(IntSuffix $ \n -> upd $ \dfs -> dfs{ ctxtStkDepth = n })
Supported
+ ------ DPH flags ----------------------------------------------------
+
+ , Flag "fdph-seq"
+ (NoArg (upd (setDPHBackend DPHSeq)))
+ Supported
+ , Flag "fdph-par"
+ (NoArg (upd (setDPHBackend DPHPar)))
+ Supported
+
------ Compiler flags -----------------------------------------------
, Flag "fasm" (NoArg (setObjTarget HscAsm)) Supported
`dopt_set` Opt_DictsCheap
`dopt_unset` Opt_MethodSharing
+data DPHBackend = DPHPar
+ | DPHSeq
+
+setDPHBackend :: DPHBackend -> DynFlags -> DynFlags
+setDPHBackend backend dflags = dflags { dphBackend = backend }
setMainIs :: String -> DynP ()
import VectBuiltIn
import HscTypes
-import Module ( dphSeqPackageId )
+import Module ( PackageId )
import CoreSyn
import TyCon
import DataCon
(ppr $ mkTyConApp tycon tys)
}
-initV :: HscEnv -> ModGuts -> VectInfo -> VM a -> IO (Maybe (VectInfo, a))
-initV hsc_env guts info p
+initV :: PackageId -> HscEnv -> ModGuts -> VectInfo -> VM a -> IO (Maybe (VectInfo, a))
+initV pkg hsc_env guts info p
= do
Just r <- initDs hsc_env (mg_module guts)
(mg_rdr_env guts)
go =
do
- builtins <- initBuiltins dphSeqPackageId
+ builtins <- initBuiltins pkg
builtin_vars <- initBuiltinVars builtins
builtin_tycons <- initBuiltinTyCons builtins
let builtin_datacons = initBuiltinDataCons builtins
import DynFlags
import HscTypes
+import Module ( dphSeqPackageId, dphParPackageId )
import CoreLint ( showPass, endPass )
import CoreSyn
import CoreUtils
import Control.Monad ( liftM, liftM2, zipWithM )
import Data.List ( sortBy, unzip4 )
-vectorise :: HscEnv -> UniqSupply -> RuleBase -> ModGuts
+vectorise :: DPHBackend -> HscEnv -> UniqSupply -> RuleBase -> ModGuts
-> IO (SimplCount, ModGuts)
-vectorise hsc_env _ _ guts
+vectorise backend hsc_env _ _ guts
= do
showPass dflags "Vectorisation"
eps <- hscEPS hsc_env
let info = hptVectInfo hsc_env `plusVectInfo` eps_vect_info eps
- Just (info', guts') <- initV hsc_env guts info (vectModule guts)
+ Just (info', guts') <- initV (backendPackage backend) hsc_env guts info
+ (vectModule guts)
endPass dflags "Vectorisation" Opt_D_dump_vect (mg_binds guts')
return (zeroSimplCount dflags, guts' { mg_vect_info = info' })
where
dflags = hsc_dflags hsc_env
+ backendPackage DPHSeq = dphSeqPackageId
+ backendPackage DPHPar = dphParPackageId
+
vectModule :: ModGuts -> VM ModGuts
vectModule guts
= do