X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2Fmain%2FDynFlags.hs;h=9e2d24b07d9bb91d51f5c2b9d819d61169919e1a;hb=84dc1adf521191e1c171e684c7cd28f03475125e;hp=43ecba731dbb8dd35a630f2ea170069fc7966e0c;hpb=dab80474aec701dab215ed0f9b9bfa904083182a;p=ghc-hetmet.git diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs index 43ecba7..9e2d24b 100644 --- a/compiler/main/DynFlags.hs +++ b/compiler/main/DynFlags.hs @@ -21,7 +21,7 @@ module DynFlags ( Option(..), DynLibLoader(..), fFlags, xFlags, - DPHBackend(..), + dphPackage, -- ** Manipulating DynFlags defaultDynFlags, -- DynFlags @@ -892,7 +892,7 @@ data CoreToDo -- These are diff core-to-core passes, | CoreCSE | CoreDoRuleCheck Int{-CompilerPhase-} String -- Check for non-application of rules -- matching this string - | CoreDoVectorisation DPHBackend + | CoreDoVectorisation PackageId | CoreDoNothing -- Useful when building up | CoreDoPasses [CoreToDo] -- lists of these things @@ -947,7 +947,7 @@ getCoreToDo dflags vectorisation = runWhen (dopt Opt_Vectorise dflags) - $ CoreDoPasses [ simpl_gently, CoreDoVectorisation (dphBackend dflags) ] + $ CoreDoPasses [ simpl_gently, CoreDoVectorisation (dphPackage dflags) ] -- By default, we have 2 phases before phase 0. @@ -1435,10 +1435,13 @@ dynamic_flags = [ ------ DPH flags ---------------------------------------------------- , Flag "fdph-seq" - (NoArg (upd (setDPHBackend DPHSeq))) + (NoArg (setDPHBackend DPHSeq)) Supported , Flag "fdph-par" - (NoArg (upd (setDPHBackend DPHPar))) + (NoArg (setDPHBackend DPHPar)) + Supported + , Flag "fdph-this" + (NoArg (setDPHBackend DPHThis)) Supported ------ Compiler flags ----------------------------------------------- @@ -1872,10 +1875,24 @@ setDPHOpt dflags = setOptLevel 2 (dflags { maxSimplIterations = 20 data DPHBackend = DPHPar | DPHSeq - -setDPHBackend :: DPHBackend -> DynFlags -> DynFlags -setDPHBackend backend dflags = dflags { dphBackend = backend } - + | DPHThis + deriving(Eq, Ord, Enum, Show) + +setDPHBackend :: DPHBackend -> DynP () +setDPHBackend backend + = do + upd $ \dflags -> dflags { dphBackend = backend } + mapM_ exposePackage (dph_packages backend) + where + dph_packages DPHThis = [] + dph_packages DPHPar = ["dph-prim-par", "dph-par"] + dph_packages DPHSeq = ["dph-prim-seq", "dph-seq"] + +dphPackage :: DynFlags -> PackageId +dphPackage dflags = case dphBackend dflags of + DPHPar -> dphParPackageId + DPHSeq -> dphSeqPackageId + DPHThis -> thisPackage dflags setMainIs :: String -> DynP () setMainIs arg