projects / ghc-hetmet.git / blobdiff
? search:
summary | shortlog | log | commit | commitdiff | tree
raw | inline | side by side
[project @ 1999-07-07 15:28:19 by simonmar]
[ghc-hetmet.git] / ghc / compiler / main / CmdLineOpts.lhs
diff --git a/ghc/compiler/main/CmdLineOpts.lhs b/ghc/compiler/main/CmdLineOpts.lhs
index 14f0cf6..5d06739 100644 (file)
--- a/ghc/compiler/main/CmdLineOpts.lhs
+++ b/ghc/compiler/main/CmdLineOpts.lhs
@@ -14,17 +14,20 @@ module CmdLineOpts (
        intSwitchSet,
        switchIsOn,
 
+       src_filename,
+
        -- debugging opts
        opt_D_dump_absC,
        opt_D_dump_asm,
        opt_D_dump_cpranal,
+       opt_D_dump_cse,
        opt_D_dump_deriv,
        opt_D_dump_ds,
        opt_D_dump_flatC,
        opt_D_dump_foreign,
        opt_D_dump_inlinings,
        opt_D_dump_occur_anal,
-       opt_D_dump_rdr,
+       opt_D_dump_parsed,
        opt_D_dump_realC,
        opt_D_dump_rn,
        opt_D_dump_rules,
@@ -96,7 +99,6 @@ module CmdLineOpts (
        opt_UnboxStrictFields,
        opt_SimplNoPreInlining,
        opt_SimplDoEtaReduction,
-       opt_SimplDoCaseElim,
        opt_SimplDoLambdaEtaExpansion,
        opt_SimplCaseOfCase,
        opt_SimplCaseMerge,
@@ -155,6 +157,7 @@ import GlaExts
 import Argv
 import Constants       -- Default values for some flags
 
+import FastString      ( headFS )
 import Maybes          ( assocMaybe, firstJust, maybeToBool )
 import Panic           ( panic, panic# )
 
@@ -212,6 +215,7 @@ data CoreToDo               -- These are diff core-to-core passes,
   | CoreDoSpecialising
   | CoreDoUSPInf
   | CoreDoCPResult 
+  | CoreCSE
 \end{code}
 
 \begin{code}
@@ -283,35 +287,47 @@ unpacked_opts =
 \end{code}
 
 \begin{code}
+src_filename :: FAST_STRING
+src_filename = case argv of
+                 filename : rest | headFS filename /= '-' -> filename
+                 otherwise -> panic "no filename"
+\end{code}
+
+\begin{code}
 -- debugging opts
-opt_D_dump_absC                        = lookUp  SLIT("-ddump-absC")
-opt_D_dump_asm                 = lookUp  SLIT("-ddump-asm")
-opt_D_dump_cpranal             = lookUp  SLIT("-ddump-cpranalyse")
-opt_D_dump_deriv               = lookUp  SLIT("-ddump-deriv")
-opt_D_dump_ds                  = lookUp  SLIT("-ddump-ds")
-opt_D_dump_flatC               = lookUp  SLIT("-ddump-flatC")
-opt_D_dump_foreign             = lookUp  SLIT("-ddump-foreign-stubs")
-opt_D_dump_inlinings           = lookUp  SLIT("-ddump-inlinings")
-opt_D_dump_occur_anal          = lookUp  SLIT("-ddump-occur-anal")
-opt_D_dump_rdr                 = lookUp  SLIT("-ddump-rdr")
-opt_D_dump_realC               = lookUp  SLIT("-ddump-realC")
-opt_D_dump_rn                  = lookUp  SLIT("-ddump-rn")
-opt_D_dump_simpl               = lookUp  SLIT("-ddump-simpl")
-opt_D_dump_simpl_iterations    = lookUp  SLIT("-ddump-simpl-iterations")
-opt_D_dump_spec                        = lookUp  SLIT("-ddump-spec")
-opt_D_dump_stg                 = lookUp  SLIT("-ddump-stg")
-opt_D_dump_stranal             = lookUp  SLIT("-ddump-stranal")
-opt_D_dump_tc                  = lookUp  SLIT("-ddump-tc")
-opt_D_dump_rules               = lookUp  SLIT("-ddump-rules")
-opt_D_dump_usagesp              = lookUp  SLIT("-ddump-usagesp")
-opt_D_dump_worker_wrapper      = lookUp  SLIT("-ddump-workwrap")
-opt_D_show_passes              = lookUp  SLIT("-dshow-passes")
-opt_D_dump_rn_trace            = lookUp  SLIT("-ddump-rn-trace")
-opt_D_dump_rn_stats            = lookUp  SLIT("-ddump-rn-stats")
-opt_D_dump_simpl_stats         = lookUp  SLIT("-ddump-simpl-stats")
-opt_D_source_stats             = lookUp  SLIT("-dsource-stats")
-opt_D_verbose_core2core                = lookUp  SLIT("-dverbose-simpl")
-opt_D_verbose_stg2stg          = lookUp  SLIT("-dverbose-stg")
+opt_D_dump_all                  = lookUp  SLIT("-ddump-all")
+opt_D_dump_most                 = opt_D_dump_all  || lookUp  SLIT("-ddump-most")
+
+opt_D_dump_absC                        = opt_D_dump_all  || lookUp  SLIT("-ddump-absC")
+opt_D_dump_asm                 = opt_D_dump_all  || lookUp  SLIT("-ddump-asm")
+opt_D_dump_cpranal             = opt_D_dump_most || lookUp  SLIT("-ddump-cpranal")
+opt_D_dump_deriv               = opt_D_dump_most || lookUp  SLIT("-ddump-deriv")
+opt_D_dump_ds                  = opt_D_dump_most || lookUp  SLIT("-ddump-ds")
+opt_D_dump_flatC               = opt_D_dump_all  || lookUp  SLIT("-ddump-flatC")
+opt_D_dump_foreign             = opt_D_dump_most || lookUp  SLIT("-ddump-foreign-stubs")
+opt_D_dump_inlinings           = opt_D_dump_most || lookUp  SLIT("-ddump-inlinings")
+opt_D_dump_occur_anal          = opt_D_dump_most || lookUp  SLIT("-ddump-occur-anal")
+opt_D_dump_parsed              = opt_D_dump_most || lookUp  SLIT("-ddump-parsed")
+opt_D_dump_realC               = opt_D_dump_all  || lookUp  SLIT("-ddump-realC")
+opt_D_dump_rn                  = opt_D_dump_most || lookUp  SLIT("-ddump-rn")
+opt_D_dump_simpl               = opt_D_dump_most || lookUp  SLIT("-ddump-simpl")
+opt_D_dump_simpl_iterations    = opt_D_dump_all  || lookUp  SLIT("-ddump-simpl-iterations")
+opt_D_dump_spec                        = opt_D_dump_most || lookUp  SLIT("-ddump-spec")
+opt_D_dump_stg                 = opt_D_dump_most || lookUp  SLIT("-ddump-stg")
+opt_D_dump_stranal             = opt_D_dump_most || lookUp  SLIT("-ddump-stranal")
+opt_D_dump_tc                  = opt_D_dump_most || lookUp  SLIT("-ddump-tc")
+opt_D_dump_rules               = opt_D_dump_most || lookUp  SLIT("-ddump-rules")
+opt_D_dump_usagesp              = opt_D_dump_most || lookUp  SLIT("-ddump-usagesp")
+opt_D_dump_cse                         = opt_D_dump_most || lookUp  SLIT("-ddump-cse")
+opt_D_dump_worker_wrapper      = opt_D_dump_most || lookUp  SLIT("-ddump-workwrap")
+opt_D_show_passes              = opt_D_dump_most || lookUp  SLIT("-dshow-passes")
+opt_D_dump_rn_trace            = opt_D_dump_all  || lookUp  SLIT("-ddump-rn-trace")
+opt_D_dump_rn_stats            = opt_D_dump_most || lookUp  SLIT("-ddump-rn-stats")
+opt_D_dump_simpl_stats         = opt_D_dump_most || lookUp  SLIT("-ddump-simpl-stats")
+opt_D_source_stats             = opt_D_dump_most || lookUp  SLIT("-dsource-stats")
+opt_D_verbose_core2core                = opt_D_dump_all  || lookUp  SLIT("-dverbose-simpl")
+opt_D_verbose_stg2stg          = opt_D_dump_all  || lookUp  SLIT("-dverbose-stg")
+
 opt_DoCoreLinting              = lookUp  SLIT("-dcore-lint")
 opt_DoStgLinting               = lookUp  SLIT("-dstg-lint")
 opt_DoUSPLinting               = lookUp  SLIT("-dusagesp-lint")
@@ -394,7 +410,6 @@ opt_SimplNoPreInlining              = lookUp SLIT("-fno-pre-inlining")
        -- NoPreInlining is there just to see how bad things
        -- get if you don't do it!
 opt_SimplDoEtaReduction                = lookUp SLIT("-fdo-eta-reduction")
-opt_SimplDoCaseElim            = lookUp SLIT("-fdo-case-elim")
 opt_SimplDoLambdaEtaExpansion  = lookUp SLIT("-fdo-lambda-eta-expansion")
 opt_SimplCaseOfCase            = lookUp SLIT("-fcase-of-case")
 opt_SimplCaseMerge             = lookUp SLIT("-fcase-merge")
@@ -405,13 +420,13 @@ opt_SimplPedanticBottoms  = lookUp SLIT("-fpedantic-bottoms")
 opt_UF_HiFileThreshold         = lookup_def_int "-funfolding-interface-threshold" (30::Int)
 opt_UF_CreationThreshold       = lookup_def_int "-funfolding-creation-threshold"  (30::Int)
 opt_UF_UseThreshold            = lookup_def_int "-funfolding-use-threshold"       (8::Int)     -- Discounts can be big
-opt_UF_ScrutConDiscount                = lookup_def_int "-funfolding-con-discount"        (3::Int)
+opt_UF_ScrutConDiscount                = lookup_def_int "-funfolding-con-discount"        (2::Int)
 opt_UF_FunAppDiscount          = lookup_def_int "-funfolding-fun-discount"        (6::Int)     -- It's great to inline a fn
 opt_UF_PrimArgDiscount         = lookup_def_int "-funfolding-prim-discount"       (1::Int)
 opt_UF_KeenessFactor           = lookup_def_float "-funfolding-keeness-factor"    (2.0::Float)
 
-opt_UF_CheapOp  = ( 1 :: Int)
-opt_UF_DearOp   = ( 8 :: Int)
+opt_UF_CheapOp  = ( 0 :: Int)  -- Only one instruction; and the args are charged for
+opt_UF_DearOp   = ( 4 :: Int)
 opt_UF_NoRepLit = ( 20 :: Int) -- Strings can be pretty big
                        
 opt_ProduceS                   = lookup_str "-S="
@@ -458,6 +473,7 @@ classifyOpts = sep argv [] [] -- accumulators...
          "-ffloat-inwards"  -> CORE_TD(CoreDoFloatInwards)
          "-ffull-laziness"  -> CORE_TD(CoreDoFullLaziness)
          "-fliberate-case"  -> CORE_TD(CoreLiberateCase)
+         "-fcse"            -> CORE_TD(CoreCSE)
          "-fprint-core"     -> CORE_TD(CoreDoPrintCore)
          "-fstatic-args"    -> CORE_TD(CoreDoStaticArgs)
          "-fstrictness"     -> CORE_TD(CoreDoStrictness)
@@ -576,8 +592,10 @@ isAmongSimpl on_switches           -- Switches mentioned later occur *earlier*
        case (indexArray# stuff (tagOf_SimplSwitch switch)) of
 #if __GLASGOW_HASKELL__ < 400
          Lift v -> v
-#else
+#elif __GLASGOW_HASKELL__ < 403
          (# _, v #) -> v
+#else
+         (# v #) -> v
 #endif
     }
   where
Glasgow Haskell Compiler with heterogeneous metaprogramming (generalized arrows and modal types)