X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FsimplCore%2FSimplCore.lhs;h=9f656fba1c46c24c33b33e08fbcda9ae444df02c;hb=23bc35d6bbfefa7def797eb0868cc88e02633914;hp=df928f6a66f4a49dbaeee1555b4a0730c1a48ee9;hpb=51c4d029be44a5a629daf51b55cbca7cb734c172;p=ghc-hetmet.git diff --git a/compiler/simplCore/SimplCore.lhs b/compiler/simplCore/SimplCore.lhs index df928f6..9f656fb 100644 --- a/compiler/simplCore/SimplCore.lhs +++ b/compiler/simplCore/SimplCore.lhs @@ -55,10 +55,6 @@ import Specialise ( specProgram) import SpecConstr ( specConstrProgram) import DmdAnal ( dmdAnalPgm ) import WorkWrap ( wwTopBinds ) -#ifdef OLD_STRICTNESS -import StrictAnal ( saBinds ) -import CprAnalyse ( cprAnalyse ) -#endif import Vectorise ( vectorise ) import FastString import Util @@ -88,10 +84,8 @@ core2core hsc_env guts = do us <- mkSplitUniqSupply 's' let (cp_us, ru_us) = splitUniqSupply us - -- COMPUTE THE ANNOTATIONS TO USE - ann_env <- prepareAnnotations hsc_env (Just guts) - -- COMPUTE THE RULE BASE TO USE + -- See Note [Overall plumbing for rules] in Rules.lhs (hpt_rule_base, guts1) <- prepareRules hsc_env guts ru_us -- Get the module out of the current HscEnv so we can retrieve it from the monad. @@ -100,7 +94,7 @@ core2core hsc_env guts = do -- _theoretically_ be changed during the Core pipeline (it's part of ModGuts), which -- would mean our cached value would go out of date. let mod = mg_module guts - (guts2, stats) <- runCoreM hsc_env ann_env hpt_rule_base cp_us mod $ do + (guts2, stats) <- runCoreM hsc_env hpt_rule_base cp_us mod $ do -- FIND BUILT-IN PASSES let builtin_core_todos = getCoreToDo dflags @@ -190,24 +184,8 @@ doCorePass CoreDoGlomBinds = dontDescribePass $ doPassDM glomBinds doCorePass CoreDoPrintCore = dontDescribePass $ observe printCore doCorePass (CoreDoRuleCheck phase pat) = dontDescribePass $ ruleCheck phase pat -#ifdef OLD_STRICTNESS -doCorePass CoreDoOldStrictness = {-# SCC "OldStrictness" #-} doOldStrictness -#endif - doCorePass CoreDoNothing = return doCorePass (CoreDoPasses passes) = doCorePasses passes - -#ifdef OLD_STRICTNESS -doOldStrictness :: ModGuts -> CoreM ModGuts -doOldStrictness guts - = do dfs <- getDynFlags - guts' <- describePass "Strictness analysis" Opt_D_dump_stranal $ - doPassM (saBinds dfs) guts - guts'' <- describePass "Constructed Product analysis" Opt_D_dump_cpranal $ - doPass cprAnalyse guts' - return guts'' -#endif - \end{code} %************************************************************************ @@ -245,11 +223,10 @@ printCore _ binds = Err.dumpIfSet True "Print Core" (pprCoreBindings binds) ruleCheck :: CompilerPhase -> String -> ModGuts -> CoreM ModGuts ruleCheck current_phase pat guts = do - let is_active = isActive current_phase rb <- getRuleBase dflags <- getDynFlags liftIO $ Err.showPass dflags "RuleCheck" - liftIO $ printDump (ruleCheckProgram is_active pat rb (mg_binds guts)) + liftIO $ printDump (ruleCheckProgram current_phase pat rb (mg_binds guts)) return guts @@ -346,9 +323,9 @@ prepareRules hsc_env@(HscEnv { hsc_dflags = dflags, hsc_HPT = hpt }) ; Err.dumpIfSet_dyn dflags Opt_D_dump_rules "Transformation rules" (withPprStyle (mkUserStyle (mkPrintUnqualified dflags rdr_env) AllTheWay) $ - vcat [text "Local rules", pprRules simpl_rules, + vcat [text "Local rules for local Ids", pprRules simpl_rules, blankLine, - text "Imported rules", pprRuleBase hpt_rule_base]) + text "Local rules for imported Ids", pprRuleBase hpt_rule_base]) ; return (hpt_rule_base, guts { mg_binds = binds_w_rules, mg_rules = rules_for_imps }) @@ -565,6 +542,7 @@ simplifyPgmIO mode switches hsc_env us hpt_rule_base (pprCoreBindings tagged_binds); -- Get any new rules, and extend the rule base + -- See Note [Overall plumbing for rules] in Rules.lhs -- We need to do this regularly, because simplification can -- poke on IdInfo thunks, which in turn brings in new rules -- behind the scenes. Otherwise there's a danger we'll simply @@ -844,7 +822,7 @@ transferIdInfo exported_id local_id = modifyIdInfo transfer exported_id where local_info = idInfo local_id - transfer exp_info = exp_info `setNewStrictnessInfo` newStrictnessInfo local_info + transfer exp_info = exp_info `setStrictnessInfo` strictnessInfo local_info `setUnfoldingInfo` unfoldingInfo local_info `setInlinePragInfo` inlinePragInfo local_info `setSpecInfo` addSpecInfo (specInfo exp_info) new_info