[project @ 2001-02-28 11:48:34 by simonpj]

[ghc-hetmet.git] / ghc / compiler / simplCore / SimplCore.lhs

diff --git a/ghc/compiler/simplCore/SimplCore.lhs b/ghc/compiler/simplCore/SimplCore.lhs
index 5bf0fe8..6c07ba9 100644 (file)
--- a/ghc/compiler/simplCore/SimplCore.lhs
+++ b/ghc/compiler/simplCore/SimplCore.lhs
@@ -37,6 +37,7 @@ import VarSet
 import LiberateCase    ( liberateCase )
 import SAT             ( doStaticArgs )
 import Specialise      ( specProgram)
+import SpecConstr      ( specConstrProgram)
 import UsageSPInf       ( doUsageSPInf )
 import StrictAnal      ( saBinds )
 import WorkWrap                ( wwTopBinds )
@@ -107,7 +108,7 @@ simplifyExpr dflags pcs hst expr
 
        ; us <-  mkSplitUniqSupply 's'
 
-       ; let (expr', _counts) = initSmpl dflags sw_chkr us emptyVarSet black_list_all  
+       ; let (expr', _counts) = initSmpl dflags sw_chkr us emptyVarSet black_list_nothing      
                                          (simplExprGently expr)
 
        ; dumpIfSet_dyn dflags Opt_D_dump_simpl "Simplified expression"
@@ -116,8 +117,8 @@ simplifyExpr dflags pcs hst expr
        ; return expr'
        }
   where
-    sw_chkr any             = SwBool False     -- A bit bogus
-    black_list_all v = True            -- Black list everything
+    sw_chkr any                 = SwBool False -- A bit bogus
+    black_list_nothing v = False       -- Black list nothing
 
 
 doCorePasses :: DynFlags
@@ -157,6 +158,8 @@ doCorePass dfs rb us binds CoreDoWorkerWrapper
    = _scc_ "WorkWrap"      noStats dfs (wwTopBinds dfs us binds)
 doCorePass dfs rb us binds CoreDoSpecialising       
    = _scc_ "Specialise"    noStats dfs (specProgram dfs us binds)
+doCorePass dfs rb us binds CoreDoSpecConstr
+   = _scc_ "SpecConstr"    noStats dfs (specConstrProgram dfs us binds)
 doCorePass dfs rb us binds CoreDoCPResult              
    = _scc_ "CPResult"      noStats dfs (cprAnalyse dfs binds)
 doCorePass dfs rb us binds CoreDoPrintCore             
@@ -217,7 +220,6 @@ prepareRules dflags pkg_rule_base hst us binds rules
              rule_base                   = extendRuleBaseList imp_rule_base orphan_rules
              final_rule_base             = addRuleBaseFVs rule_base (ruleBaseFVs local_rule_base)
                -- The last step black-lists the free vars of local rules too
-
        ; return (final_rule_base, local_rule_ids, orphan_rules, rule_rhs_fvs)
     }
   where