Use "on the spot" solving for fundeps

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

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 92b98ac..7bd4d84 100644 (file)
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -32,7 +32,7 @@ module DynFlags (
         Option(..), showOpt,
         DynLibLoader(..),
         fFlags, fLangFlags, xFlags,
         Option(..), showOpt,
         DynLibLoader(..),
         fFlags, fLangFlags, xFlags,

-        dphPackage,
+        DPHBackend(..), dphPackage,

         wayNames,
 
         -- ** Manipulating DynFlags
         wayNames,
 
         -- ** Manipulating DynFlags

@@ -153,6 +153,7 @@ data DynFlag
    | Opt_D_dump_rn_stats
    | Opt_D_dump_opt_cmm
    | Opt_D_dump_simpl_stats
    | Opt_D_dump_rn_stats
    | Opt_D_dump_opt_cmm
    | Opt_D_dump_simpl_stats

+   | Opt_D_dump_cs_trace       -- Constraint solver in type checker

    | Opt_D_dump_tc_trace
    | Opt_D_dump_if_trace
    | Opt_D_dump_splices
    | Opt_D_dump_tc_trace
    | Opt_D_dump_if_trace
    | Opt_D_dump_splices

@@ -181,6 +182,7 @@ data DynFlag
    | Opt_WarnHiShadows
    | Opt_WarnImplicitPrelude
    | Opt_WarnIncompletePatterns
    | Opt_WarnHiShadows
    | Opt_WarnImplicitPrelude
    | Opt_WarnIncompletePatterns

+   | Opt_WarnIncompleteUniPatterns

    | Opt_WarnIncompletePatternsRecUpd
    | Opt_WarnMissingFields
    | Opt_WarnMissingImportList
    | Opt_WarnIncompletePatternsRecUpd
    | Opt_WarnMissingFields
    | Opt_WarnMissingImportList

@@ -669,7 +671,7 @@ defaultDynFlags =
         mainFunIs               = Nothing,
         ctxtStkDepth            = mAX_CONTEXT_REDUCTION_DEPTH,
 
         mainFunIs               = Nothing,
         ctxtStkDepth            = mAX_CONTEXT_REDUCTION_DEPTH,
 

-        dphBackend              = DPHPar,
+        dphBackend              = DPHNone,

 
         thisPackage             = mainPackageId,
 
 
         thisPackage             = mainPackageId,
 

@@ -805,7 +807,14 @@ languageExtensions (Just Haskell98)
     = [Opt_ImplicitPrelude,
        Opt_MonomorphismRestriction,
        Opt_NPlusKPatterns,
     = [Opt_ImplicitPrelude,
        Opt_MonomorphismRestriction,
        Opt_NPlusKPatterns,

-       Opt_DatatypeContexts]
+       Opt_DatatypeContexts,
+       Opt_NondecreasingIndentation
+           -- strictly speaking non-standard, but we always had this
+           -- on implicitly before the option was added in 7.1, and
+           -- turning it off breaks code, so we're keeping it on for
+           -- backwards compatibility.  Cabal uses -XHaskell98 by
+           -- default unless you specify another language.
+      ]

 
 languageExtensions (Just Haskell2010)
     = [Opt_ImplicitPrelude,
 
 languageExtensions (Just Haskell2010)
     = [Opt_ImplicitPrelude,

@@ -1251,6 +1260,7 @@ dynamic_flags = [
   , Flag "ddump-worker-wrapper"    (setDumpFlag Opt_D_dump_worker_wrapper)
   , Flag "ddump-rn-trace"          (setDumpFlag Opt_D_dump_rn_trace)
   , Flag "ddump-if-trace"          (setDumpFlag Opt_D_dump_if_trace)
   , Flag "ddump-worker-wrapper"    (setDumpFlag Opt_D_dump_worker_wrapper)
   , Flag "ddump-rn-trace"          (setDumpFlag Opt_D_dump_rn_trace)
   , Flag "ddump-if-trace"          (setDumpFlag Opt_D_dump_if_trace)

+  , Flag "ddump-cs-trace"          (setDumpFlag Opt_D_dump_cs_trace)

   , Flag "ddump-tc-trace"          (setDumpFlag Opt_D_dump_tc_trace)
   , Flag "ddump-splices"           (setDumpFlag Opt_D_dump_splices)
   , Flag "ddump-rn-stats"          (setDumpFlag Opt_D_dump_rn_stats)
   , Flag "ddump-tc-trace"          (setDumpFlag Opt_D_dump_tc_trace)
   , Flag "ddump-splices"           (setDumpFlag Opt_D_dump_splices)
   , Flag "ddump-rn-stats"          (setDumpFlag Opt_D_dump_rn_stats)

@@ -1334,6 +1344,7 @@ dynamic_flags = [
   , Flag "fdph-seq"         (NoArg (setDPHBackend DPHSeq))
   , Flag "fdph-par"         (NoArg (setDPHBackend DPHPar))
   , Flag "fdph-this"        (NoArg (setDPHBackend DPHThis))
   , Flag "fdph-seq"         (NoArg (setDPHBackend DPHSeq))
   , Flag "fdph-par"         (NoArg (setDPHBackend DPHPar))
   , Flag "fdph-this"        (NoArg (setDPHBackend DPHThis))

+  , Flag "fdph-none"        (NoArg (setDPHBackend DPHNone))

 
         ------ Compiler flags -----------------------------------------------
 
 
         ------ Compiler flags -----------------------------------------------
 

@@ -1419,6 +1430,7 @@ fFlags = [
   ( "warn-hi-shadowing",                Opt_WarnHiShadows, nop ),
   ( "warn-implicit-prelude",            Opt_WarnImplicitPrelude, nop ),
   ( "warn-incomplete-patterns",         Opt_WarnIncompletePatterns, nop ),
   ( "warn-hi-shadowing",                Opt_WarnHiShadows, nop ),
   ( "warn-implicit-prelude",            Opt_WarnImplicitPrelude, nop ),
   ( "warn-incomplete-patterns",         Opt_WarnIncompletePatterns, nop ),

+  ( "warn-incomplete-uni-patterns",     Opt_WarnIncompleteUniPatterns, nop ),

   ( "warn-incomplete-record-updates",   Opt_WarnIncompletePatternsRecUpd, nop ),
   ( "warn-missing-fields",              Opt_WarnMissingFields, nop ),
   ( "warn-missing-import-lists",        Opt_WarnMissingImportList, nop ),
   ( "warn-incomplete-record-updates",   Opt_WarnIncompletePatternsRecUpd, nop ),
   ( "warn-missing-fields",              Opt_WarnMissingFields, nop ),
   ( "warn-missing-import-lists",        Opt_WarnMissingImportList, nop ),

@@ -1681,6 +1693,8 @@ impliedFlags
        -- stuff like " 'a' not in scope ", which is a bit silly
        -- if the compiler has just filled in field 'a' of constructor 'C'
     , (Opt_RecordWildCards,     turnOn, Opt_DisambiguateRecordFields)
        -- stuff like " 'a' not in scope ", which is a bit silly
        -- if the compiler has just filled in field 'a' of constructor 'C'
     , (Opt_RecordWildCards,     turnOn, Opt_DisambiguateRecordFields)

+    
+    , (Opt_ParallelArrays, turnOn, Opt_ParallelListComp)

   ]
 
 optLevelFlags :: [([Int], DynFlag)]
   ]
 
 optLevelFlags :: [([Int], DynFlag)]

@@ -1739,6 +1753,7 @@ standardWarnings
       ]
 
 minusWOpts :: [DynFlag]
       ]
 
 minusWOpts :: [DynFlag]

+-- Things you get with -W

 minusWOpts
     = standardWarnings ++
       [ Opt_WarnUnusedBinds,
 minusWOpts
     = standardWarnings ++
       [ Opt_WarnUnusedBinds,

@@ -1750,6 +1765,7 @@ minusWOpts
       ]
 
 minusWallOpts :: [DynFlag]
       ]
 
 minusWallOpts :: [DynFlag]

+-- Things you get with -Wall

 minusWallOpts
     = minusWOpts ++
       [ Opt_WarnTypeDefaults,
 minusWallOpts
     = minusWOpts ++
       [ Opt_WarnTypeDefaults,

@@ -1757,21 +1773,21 @@ minusWallOpts
         Opt_WarnMissingSigs,
         Opt_WarnHiShadows,
         Opt_WarnOrphans,
         Opt_WarnMissingSigs,
         Opt_WarnHiShadows,
         Opt_WarnOrphans,

-        Opt_WarnUnusedDoBind,
-        Opt_WarnIdentities
+        Opt_WarnUnusedDoBind

       ]
 
       ]
 

--- minuswRemovesOpts should be every warning option

 minuswRemovesOpts :: [DynFlag]
 minuswRemovesOpts :: [DynFlag]

+-- minuswRemovesOpts should be every warning option 

 minuswRemovesOpts
     = minusWallOpts ++
 minuswRemovesOpts
     = minusWallOpts ++

-      [Opt_WarnImplicitPrelude,
+      [Opt_WarnTabs,

        Opt_WarnIncompletePatternsRecUpd,
        Opt_WarnIncompletePatternsRecUpd,

+       Opt_WarnIncompleteUniPatterns,

        Opt_WarnMonomorphism,
        Opt_WarnUnrecognisedPragmas,
        Opt_WarnAutoOrphans,
        Opt_WarnMonomorphism,
        Opt_WarnUnrecognisedPragmas,
        Opt_WarnAutoOrphans,

-       Opt_WarnTabs
-      ]
+       Opt_WarnImplicitPrelude
+     ]       

 
 enableGlasgowExts :: DynP ()
 enableGlasgowExts = do setDynFlag Opt_PrintExplicitForalls
 
 enableGlasgowExts :: DynP ()
 enableGlasgowExts = do setDynFlag Opt_PrintExplicitForalls

@@ -1977,44 +1993,39 @@ setOptLevel n dflags
 -- -Odph is equivalent to
 --
 --    -O2                               optimise as much as possible
 -- -Odph is equivalent to
 --
 --    -O2                               optimise as much as possible

---    -fno-method-sharing               sharing specialisation defeats fusion
---                                      sometimes
---    -fdicts-cheap                     always inline dictionaries

 --    -fmax-simplifier-iterations20     this is necessary sometimes
 --    -fmax-simplifier-iterations20     this is necessary sometimes

---    -fsimplifier-phases=3             we use an additional simplifier phase
---                                      for fusion
---    -fno-spec-constr-threshold        run SpecConstr even for big loops
---    -fno-spec-constr-count            SpecConstr as much as possible
---    -finline-enough-args              hack to prevent excessive inlining
+--    -fsimplifier-phases=3             we use an additional simplifier phase for fusion

 --
 setDPHOpt :: DynFlags -> DynFlags
 setDPHOpt dflags = setOptLevel 2 (dflags { maxSimplIterations  = 20
                                          , simplPhases         = 3
 --
 setDPHOpt :: DynFlags -> DynFlags
 setDPHOpt dflags = setOptLevel 2 (dflags { maxSimplIterations  = 20
                                          , simplPhases         = 3

-                                         , specConstrThreshold = Nothing
-                                         , specConstrCount     = Nothing

                                          })
                                          })

-                   `dopt_set`   Opt_DictsCheap

 
 

-data DPHBackend = DPHPar
-                | DPHSeq
-                | DPHThis
+-- Determines the package used by the vectoriser for the symbols of the vectorised code.
+-- 'DPHNone' indicates that no data-parallel backend library is available; hence, the
+-- vectoriser cannot be used.
+--
+data DPHBackend = DPHPar    -- "dph-par"
+                | DPHSeq    -- "dph-seq"
+                | DPHThis   -- the currently compiled package
+                | DPHNone   -- no DPH library available

         deriving(Eq, Ord, Enum, Show)
 
 setDPHBackend :: DPHBackend -> DynP ()
         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"]
+setDPHBackend backend = upd $ \dflags -> dflags { dphBackend = backend }

 
 

+-- Query the DPH backend package to be used by the vectoriser.
+--

 dphPackage :: DynFlags -> PackageId
 dphPackage :: DynFlags -> PackageId

-dphPackage dflags = case dphBackend dflags of
-                      DPHPar  -> dphParPackageId
-                      DPHSeq  -> dphSeqPackageId
-                      DPHThis -> thisPackage dflags
+dphPackage dflags 
+  = case dphBackend dflags of
+      DPHPar  -> dphParPackageId
+      DPHSeq  -> dphSeqPackageId
+      DPHThis -> thisPackage dflags
+      DPHNone -> ghcError (CmdLineError dphBackendError)
+
+dphBackendError :: String
+dphBackendError = "To use -fvectorise select a DPH backend with -fdph-par or -fdph-seq"

 
 setMainIs :: String -> DynP ()
 setMainIs arg
 
 setMainIs :: String -> DynP ()
 setMainIs arg

@@ -2298,6 +2309,7 @@ compilerInfo = [("Project name",                String cProjectName),
                 ("LibDir",                      FromDynFlags topDir),
                 ("Global Package DB",           FromDynFlags systemPackageConfig),
                 ("C compiler flags",            String (show cCcOpts)),
                 ("LibDir",                      FromDynFlags topDir),
                 ("Global Package DB",           FromDynFlags systemPackageConfig),
                 ("C compiler flags",            String (show cCcOpts)),

-                ("Linker flags",                String (show cLdOpts))
+                ("Gcc Linker flags",            String (show cGccLinkerOpts)),
+                ("Ld Linker flags",             String (show cLdLinkerOpts))

                ]
 
                ]