X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;ds=sidebyside;f=compiler%2Fmain%2FDynFlags.hs;h=f88d02c49a05edb480040cde033f13ac5e3ec47e;hb=2412b0b38f23d645632a780d1659627ba398d947;hp=39459d33bd6464e5998da907024f128f52e98e33;hpb=0ab4d209650b44b019a414a6cefd0f4cbc006ee4;p=ghc-hetmet.git

diff --git a/compiler/main/DynFlags.hs b/compiler/main/DynFlags.hs
index 39459d3..f88d02c 100644
--- a/compiler/main/DynFlags.hs
+++ b/compiler/main/DynFlags.hs
@@ -60,8 +60,6 @@ module DynFlags (
     compilerInfo,
   ) where
 
--- XXX This define is a bit of a hack, and should be done more nicely
-#define FAST_STRING_NOT_NEEDED 1
 #include "HsVersions.h"
 
 import Module
@@ -239,6 +237,7 @@ data DynFlag
    -- optimisation opts
    | Opt_Strictness
    | Opt_FullLaziness
+   | Opt_StaticArgumentTransformation
    | Opt_CSE
    | Opt_LiberateCase
    | Opt_SpecConstr
@@ -249,6 +248,7 @@ data DynFlag
    | Opt_DoEtaReduction
    | Opt_CaseMerge
    | Opt_UnboxStrictFields
+   | Opt_MethodSharing
    | Opt_DictsCheap
    | Opt_RewriteRules
    | Opt_Vectorise
@@ -305,6 +305,7 @@ data DynFlags = DynFlags {
   ruleCheck		:: Maybe String,
 
   specConstrThreshold   :: Maybe Int,	-- Threshold for SpecConstr
+  specConstrCount	:: Maybe Int,	-- Max number of specialisations for any one function
   liberateCaseThreshold :: Maybe Int,   -- Threshold for LiberateCase 
 
   stolen_x86_regs	:: Int,		
@@ -496,6 +497,7 @@ defaultDynFlags =
         shouldDumpSimplPhase    = const False,
 	ruleCheck		= Nothing,
 	specConstrThreshold	= Just 200,
+	specConstrCount		= Just 3,
         liberateCaseThreshold   = Just 200,
 	stolen_x86_regs		= 4,
 	cmdlineHcIncludes	= [],
@@ -554,6 +556,8 @@ defaultDynFlags =
             Opt_ImplicitPrelude,
             Opt_MonomorphismRestriction,
 
+            Opt_MethodSharing,
+
             Opt_DoAsmMangling,
 
             Opt_GenManifest,
@@ -708,6 +712,7 @@ optLevelFlags
 
     , ([2],	Opt_LiberateCase)
     , ([2],	Opt_SpecConstr)
+    , ([2],	Opt_StaticArgumentTransformation)
 
     , ([0,1,2], Opt_DoLambdaEtaExpansion)
 		-- This one is important for a tiresome reason:
@@ -827,6 +832,7 @@ getCoreToDo 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)
 
@@ -870,11 +876,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,
+
 	-- initial simplify: mk specialiser happy: minimum effort please
         simpl_gently,
 
@@ -1173,6 +1186,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
 
@@ -1185,6 +1199,10 @@ dynamic_flags = [
                 upd (\dfs -> dfs{ specConstrThreshold = Just n })))
   ,  ( "fno-spec-constr-threshold",   NoArg (
                 upd (\dfs -> dfs{ specConstrThreshold = Nothing })))
+  ,  ( "fspec-constr-count",   	      IntSuffix (\n ->
+                upd (\dfs -> dfs{ specConstrCount = Just n })))
+  ,  ( "fno-spec-constr-count",   NoArg (
+                upd (\dfs -> dfs{ specConstrCount = Nothing })))
   ,  ( "fliberate-case-threshold",    IntSuffix (\n ->
                 upd (\dfs -> dfs{ liberateCaseThreshold = Just n })))
   ,  ( "fno-liberate-case-threshold", NoArg (
@@ -1245,6 +1263,7 @@ fFlags = [
   ( "warn-tabs",                        Opt_WarnTabs ),
   ( "print-explicit-foralls",           Opt_PrintExplicitForalls ),
   ( "strictness",                       Opt_Strictness ),
+  ( "static-argument-transformation",   Opt_StaticArgumentTransformation ),
   ( "full-laziness",                    Opt_FullLaziness ),
   ( "liberate-case",                    Opt_LiberateCase ),
   ( "spec-constr",                      Opt_SpecConstr ),
@@ -1256,6 +1275,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 ),
@@ -1562,6 +1582,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)