X-Git-Url: http://git.megacz.com/?a=blobdiff_plain;f=compiler%2FsimplCore%2FSimplCore.lhs;h=df928f6a66f4a49dbaeee1555b4a0730c1a48ee9;hb=7fa25f74d02cf36cb4997477c7527324104c74ee;hp=62c3c35f34e7adfb726c6f09929b34c94d215bff;hpb=72462499b891d5779c19f3bda03f96e24f9554ae;p=ghc-hetmet.git

diff --git a/compiler/simplCore/SimplCore.lhs b/compiler/simplCore/SimplCore.lhs
index 62c3c35..df928f6 100644
--- a/compiler/simplCore/SimplCore.lhs
+++ b/compiler/simplCore/SimplCore.lhs
@@ -31,6 +31,7 @@ import OccurAnal	( occurAnalysePgm, occurAnalyseExpr )
 import IdInfo
 import CoreUtils	( coreBindsSize )
 import Simplify		( simplTopBinds, simplExpr )
+import SimplUtils	( simplEnvForGHCi, simplEnvForRules )
 import SimplEnv
 import SimplMonad
 import CoreMonad
@@ -120,6 +121,8 @@ simplifyExpr :: DynFlags -- includes spec of what core-to-core passes to do
 	     -> IO CoreExpr
 -- simplifyExpr is called by the driver to simplify an
 -- expression typed in at the interactive prompt
+--
+-- Also used by Template Haskell
 simplifyExpr dflags expr
   = do	{
 	; Err.showPass dflags "Simplify"
@@ -127,7 +130,7 @@ simplifyExpr dflags expr
 	; us <-  mkSplitUniqSupply 's'
 
 	; let (expr', _counts) = initSmpl dflags emptyRuleBase emptyFamInstEnvs us $
-				 simplExprGently gentleSimplEnv expr
+				 simplExprGently simplEnvForGHCi expr
 
 	; Err.dumpIfSet_dyn dflags Opt_D_dump_simpl "Simplified expression"
 			(pprCoreExpr expr')
@@ -135,9 +138,6 @@ simplifyExpr dflags expr
 	; return expr'
 	}
 
-gentleSimplEnv :: SimplEnv
-gentleSimplEnv = mkSimplEnv SimplGently  (isAmongSimpl [])
-
 doCorePasses :: [CorePass] -> ModGuts -> CoreM ModGuts
 doCorePasses passes guts = foldM (flip doCorePass) guts passes
 
@@ -333,7 +333,7 @@ prepareRules hsc_env@(HscEnv { hsc_dflags = dflags, hsc_HPT = hpt })
 	; let 	-- Simplify the local rules; boringly, we need to make an in-scope set
 		-- from the local binders, to avoid warnings from Simplify.simplVar
 	      local_ids        = mkInScopeSet (mkVarSet (bindersOfBinds binds))
-	      env	       = setInScopeSet gentleSimplEnv local_ids 
+	      env	       = setInScopeSet simplEnvForRules local_ids 
 	      (simpl_rules, _) = initSmpl dflags emptyRuleBase emptyFamInstEnvs us $
 				 mapM (simplRule env) local_rules
 
@@ -409,6 +409,7 @@ The simplifier does indeed do eta reduction (it's in
 Simplify.completeLam) but only if -O is on.
 
 \begin{code}
+simplRule :: SimplEnv -> CoreRule -> SimplM CoreRule
 simplRule env rule@(BuiltinRule {})
   = return rule
 simplRule env rule@(Rule { ru_bndrs = bndrs, ru_args = args, ru_rhs = rhs })
@@ -571,7 +572,7 @@ simplifyPgmIO mode switches hsc_env us hpt_rule_base
 	   eps <- hscEPS hsc_env ;
 	   let	{ rule_base1 = unionRuleBase hpt_rule_base (eps_rule_base eps)
 	        ; rule_base2 = extendRuleBaseList rule_base1 rules
-		; simpl_env  = mkSimplEnv mode sw_chkr 
+		; simpl_env  = mkSimplEnv sw_chkr mode
 		; simpl_binds = {-# SCC "SimplTopBinds" #-} 
 				simplTopBinds simpl_env tagged_binds
 		; fam_envs = (eps_fam_inst_env eps, fam_inst_env) } ;
@@ -611,7 +612,7 @@ simplifyPgmIO mode switches hsc_env us hpt_rule_base
 	   let { binds2 = {-# SCC "ZapInd" #-} shortOutIndirections binds1 } ;
 
 		-- Dump the result of this iteration
-	   endIteration dflags mode iteration_no max_iterations counts1 binds2 rules1 ;
+	   end_iteration dflags mode iteration_no max_iterations counts1 binds2 rules1 ;
 
 		-- Loop
   	   do_iteration us2 (iteration_no + 1) all_counts binds2 rules1
@@ -620,14 +621,14 @@ simplifyPgmIO mode switches hsc_env us hpt_rule_base
   	  (us1, us2) = splitUniqSupply us
 
 -------------------
-endIteration :: DynFlags -> SimplifierMode -> Int -> Int 
+end_iteration :: DynFlags -> SimplifierMode -> Int -> Int 
              -> SimplCount -> [CoreBind] -> [CoreRule] -> IO ()
--- Same as endPass but with simplifier counts
-endIteration dflags mode iteration_no max_iterations counts binds rules
+-- Same as endIteration but with simplifier counts
+end_iteration dflags mode iteration_no max_iterations counts binds rules
   = do { Err.dumpIfSet_dyn dflags Opt_D_dump_simpl_iterations pass_name
 		             (pprSimplCount counts) ;
 
-       ; endPass dflags pass_name Opt_D_dump_simpl_iterations binds rules }
+       ; endIteration dflags pass_name Opt_D_dump_simpl_iterations binds rules }
   where
     pass_name = "Simplifier mode " ++ showPpr mode ++ 
 	     	", iteration " ++ show iteration_no ++
@@ -668,11 +669,11 @@ x_local to transfer to x_exported.  Hence the copyIdInfo call.
 RULES: we want to *add* any RULES for x_local to x_exported.
 
 
-Note [Messing up the exported Id's IdInfo]
+Note [Messing up the exported Id's RULES]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-We must be careful about discarding the IdInfo on the old Id
-
-The example that went bad on me at one stage was this one:
+We must be careful about discarding (obviously) or even merging the
+RULES on the exported Id. The example that went bad on me at one stage
+was this one:
 	
     iterate :: (a -> a) -> a -> [a]
 	[Exported]