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
-- optimisation opts
| Opt_Strictness
| Opt_FullLaziness
+ | Opt_StaticArgumentTransformation
| Opt_CSE
| Opt_LiberateCase
| Opt_SpecConstr
| Opt_DoEtaReduction
| Opt_CaseMerge
| Opt_UnboxStrictFields
+ | Opt_MethodSharing
| Opt_DictsCheap
| Opt_RewriteRules
| Opt_Vectorise
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,
shouldDumpSimplPhase = const False,
ruleCheck = Nothing,
specConstrThreshold = Just 200,
+ specConstrCount = Just 3,
liberateCaseThreshold = Just 200,
stolen_x86_regs = 4,
cmdlineHcIncludes = [],
Opt_ImplicitPrelude,
Opt_MonomorphismRestriction,
+ Opt_MethodSharing,
+
Opt_DoAsmMangling,
Opt_GenManifest,
, ([2], Opt_LiberateCase)
, ([2], Opt_SpecConstr)
+ , ([2], Opt_StaticArgumentTransformation)
, ([0,1,2], Opt_DoLambdaEtaExpansion)
-- This one is important for a tiresome reason:
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)
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,
------ 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
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 (
( "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 ),
( "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 ),
= 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)