X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2Fmain%2FDynFlags.hs;h=621d6b99f1949a74bdf2b11b2b6a679bdb7ebe7c;hb=e82f1baac558b855760e3011112d76397142bfc2;hp=2c5d497db5a29e9dbbc070e7feb0619e69ff15a0;hpb=31478ab93794cd2e0e2a389d76caf43a65c8c3aa;p=ghc-hetmet.git

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 2c5d497..621d6b9 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -152,6 +152,7 @@ data DynFlag
    | Opt_D_dump_view_pattern_commoning
    | Opt_D_faststring_stats
    | Opt_DumpToFile			-- ^ Append dump output to files instead of stdout.
+   | Opt_D_no_debug_output
    | Opt_DoCoreLinting
    | Opt_DoStgLinting
    | Opt_DoCmmLinting
@@ -248,6 +249,7 @@ data DynFlag
    | Opt_DoEtaReduction
    | Opt_CaseMerge
    | Opt_UnboxStrictFields
+   | Opt_MethodSharing
    | Opt_DictsCheap
    | Opt_RewriteRules
    | Opt_Vectorise
@@ -555,6 +557,8 @@ defaultDynFlags =
             Opt_ImplicitPrelude,
             Opt_MonomorphismRestriction,
 
+            Opt_MethodSharing,
+
             Opt_DoAsmMangling,
 
             Opt_GenManifest,
@@ -829,7 +833,7 @@ getCoreToDo dflags
     liberate_case = dopt Opt_LiberateCase dflags
     rule_check    = ruleCheck dflags
     vectorisation = dopt Opt_Vectorise dflags
-    static_args   = dopt Opt_StaticArgumentTransformation dflags
+    -- static_args   = dopt Opt_StaticArgumentTransformation dflags
 
     maybe_rule_check phase = runMaybe rule_check (CoreDoRuleCheck phase)
 
@@ -873,16 +877,18 @@ getCoreToDo dflags
 	    MaxSimplifierIterations max_iter
 	]
 
-    core_todo = 
+    core_todo =
      if opt_level == 0 then
-       [simpl_phase 0 ["final"] max_iter]
+       [runWhen vectorisation (CoreDoPasses [ simpl_gently, CoreDoVectorisation ]),
+        simpl_phase 0 ["final"] max_iter]
      else {- opt_level >= 1 -} [ 
 
     -- We want to do the static argument transform before full laziness as it
     -- may expose extra opportunities to float things outwards. However, to fix
     -- up the output of the transformation we need at do at least one simplify
     -- after this before anything else
-	    runWhen static_args CoreDoStaticArgs,
+	    -- runWhen static_args CoreDoStaticArgs,
+            -- XXX disabled, see #2321
 
 	-- initial simplify: mk specialiser happy: minimum effort please
         simpl_gently,
@@ -1156,7 +1162,8 @@ dynamic_flags = [
   ,  ( "ddump-mod-cycles",     	 setDumpFlag Opt_D_dump_mod_cycles)
   ,  ( "ddump-view-pattern-commoning", setDumpFlag Opt_D_dump_view_pattern_commoning)
   ,  ( "ddump-to-file",          setDumpFlag Opt_DumpToFile)
-  ,  ( "ddump-hi-diffs",         NoArg (setDynFlag Opt_D_dump_hi_diffs))
+  ,  ( "ddump-hi-diffs",         setDumpFlag Opt_D_dump_hi_diffs)
+
   ,  ( "dcore-lint",       	 NoArg (setDynFlag Opt_DoCoreLinting))
   ,  ( "dstg-lint",        	 NoArg (setDynFlag Opt_DoStgLinting))
   ,  ( "dcmm-lint",		 NoArg (setDynFlag Opt_DoCmmLinting))
@@ -1182,6 +1189,7 @@ dynamic_flags = [
 	------ Optimisation flags ------------------------------------------
   ,  ( "O"	, NoArg (upd (setOptLevel 1)))
   ,  ( "Onot"	, NoArg (upd (setOptLevel 0))) -- deprecated
+  ,  ( "Odph"   , NoArg (upd setDPHOpt))
   ,  ( "O"	, OptIntSuffix (\mb_n -> upd (setOptLevel (mb_n `orElse` 1))))
 		-- If the number is missing, use 1
 
@@ -1270,6 +1278,7 @@ fFlags = [
   ( "do-eta-reduction",                 Opt_DoEtaReduction ),
   ( "case-merge",                       Opt_CaseMerge ),
   ( "unbox-strict-fields",              Opt_UnboxStrictFields ),
+  ( "method-sharing",                   Opt_MethodSharing ),
   ( "dicts-cheap",                      Opt_DictsCheap ),
   ( "excess-precision",                 Opt_ExcessPrecision ),
   ( "asm-mangling",                     Opt_DoAsmMangling ),
@@ -1479,9 +1488,16 @@ unSetDynFlag f = upd (\dfs -> dopt_unset dfs f)
 --------------------------
 setDumpFlag :: DynFlag -> OptKind DynP
 setDumpFlag dump_flag 
-  = NoArg (setDynFlag Opt_ForceRecomp >> setDynFlag dump_flag)
+  | force_recomp   = NoArg (setDynFlag Opt_ForceRecomp >> setDynFlag dump_flag)
+  | otherwise      = NoArg (setDynFlag dump_flag)
+  where
 	-- Whenver we -ddump, switch off the recompilation checker,
 	-- else you don't see the dump!
+        -- However, certain dumpy-things are really interested in what's going
+        -- on during recompilation checking, so in those cases we
+        -- don't want to turn it off.
+   force_recomp = dump_flag `notElem` [Opt_D_dump_if_trace, 
+                                       Opt_D_dump_hi_diffs]
 
 setVerboseCore2Core :: DynP ()
 setVerboseCore2Core = do setDynFlag Opt_ForceRecomp
@@ -1576,6 +1592,24 @@ setOptLevel n dflags
 	= updOptLevel n dflags
 
 
+-- -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
+--    -fno-spec-constr-threshold        run SpecConstr even for big loops
+--
+setDPHOpt :: DynFlags -> DynFlags
+setDPHOpt dflags = setOptLevel 2 (dflags { maxSimplIterations  = 20
+                                         , specConstrThreshold = Nothing
+                                         })
+                   `dopt_set`   Opt_DictsCheap
+                   `dopt_unset` Opt_MethodSharing
+
+
+
 setMainIs :: String -> DynP ()
 setMainIs arg
   | not (null main_fn) && isLower (head main_fn)
@@ -1829,5 +1863,7 @@ compilerInfo = [("Project name",                cProjectName),
                 ("Tables next to code",         cGhcEnableTablesNextToCode),
                 ("Win32 DLLs",                  cEnableWin32DLLs),
                 ("RTS ways",                    cGhcRTSWays),
-                ("Leading underscore",          cLeadingUnderscore)]
+                ("Leading underscore",          cLeadingUnderscore),
+                ("Debug on",                    show debugIsOn)
+               ]