X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FsimplCore%2FSimplCore.lhs;h=8ec2d1da57a4b56e70e7c1214f5be2d10745b2ed;hb=b8ee6f14ca6e9e49015ee9b404cf8b8191fede05;hp=df928f6a66f4a49dbaeee1555b4a0730c1a48ee9;hpb=51c4d029be44a5a629daf51b55cbca7cb734c172;p=ghc-hetmet.git

diff --git a/compiler/simplCore/SimplCore.lhs b/compiler/simplCore/SimplCore.lhs
index df928f6..8ec2d1d 100644
--- a/compiler/simplCore/SimplCore.lhs
+++ b/compiler/simplCore/SimplCore.lhs
@@ -15,9 +15,7 @@ module SimplCore ( core2core, simplifyExpr ) where
 
 #include "HsVersions.h"
 
-import DynFlags		( CoreToDo(..), SimplifierSwitch(..),
-			  SimplifierMode(..), DynFlags, DynFlag(..), dopt,
-			  getCoreToDo, shouldDumpSimplPhase )
+import DynFlags		( DynFlags, DynFlag(..), dopt )
 import CoreSyn
 import CoreSubst
 import HscTypes
@@ -37,7 +35,6 @@ import SimplMonad
 import CoreMonad
 import qualified ErrUtils as Err 
 import CoreLint
-import CoreMonad	( endPass )
 import FloatIn		( floatInwards )
 import FloatOut		( floatOutwards )
 import FamInstEnv
@@ -55,10 +52,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 +81,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 +91,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 +181,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 +220,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 +320,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 })
@@ -530,7 +504,7 @@ simplifyPgmIO mode switches hsc_env us hpt_rule_base
     }
   where
     dflags     	 = hsc_dflags hsc_env
-    dump_phase 	 = shouldDumpSimplPhase dflags mode
+    dump_phase 	 = dumpSimplPhase dflags mode
 		   
     sw_chkr	   = isAmongSimpl switches
     max_iterations = intSwitchSet sw_chkr MaxSimplifierIterations `orElse` 2
@@ -565,6 +539,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
@@ -593,7 +568,7 @@ simplifyPgmIO mode switches hsc_env us hpt_rule_base
 
 	   let	{ all_counts = counts `plusSimplCount` counts1
 	   	; binds1 = getFloats env1
-                ; rules1 = substRulesForImportedIds (mkCoreSubst env1) rules
+                ; rules1 = substRulesForImportedIds (mkCoreSubst (text "imp-rules") env1) rules
 	        } ;
 
 		-- Stop if nothing happened; don't dump output
@@ -844,7 +819,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