Improve handling of -fdph-* flags

[ghc-hetmet.git] / compiler / main / DynFlags.hs

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 3d17361..9e2d24b 100644 (file)
--- 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.
@@ -1440,6 +1440,9 @@ dynamic_flags = [
   , Flag "fdph-par"
          (NoArg (setDPHBackend DPHPar))
          Supported
+  , Flag "fdph-this"
+         (NoArg (setDPHBackend DPHThis))
+         Supported
 
         ------ Compiler flags -----------------------------------------------
 
@@ -1872,16 +1875,24 @@ setDPHOpt dflags = setOptLevel 2 (dflags { maxSimplIterations  = 20
 
 data DPHBackend = DPHPar
                 | DPHSeq
+                | DPHThis
+        deriving(Eq, Ord, Enum, Show)
 
 setDPHBackend :: DPHBackend -> DynP ()
 setDPHBackend backend 
   = do
       upd $ \dflags -> dflags { dphBackend = backend }
-      exposePackage $ "dph-prim-" ++ suffix backend
-      exposePackage $ "dph-"      ++ suffix backend
+      mapM_ exposePackage (dph_packages backend)
   where
-    suffix DPHPar = "par"
-    suffix DPHSeq = "seq"
+    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