[project @ 2003-07-09 11:06:31 by simonpj]

[ghc-hetmet.git] / ghc / compiler / specialise / Rules.lhs

diff --git a/ghc/compiler/specialise/Rules.lhs b/ghc/compiler/specialise/Rules.lhs
index f806be1..34813e7 100644 (file)
--- a/ghc/compiler/specialise/Rules.lhs
+++ b/ghc/compiler/specialise/Rules.lhs
@@ -20,7 +20,7 @@ import OccurAnal      ( occurAnalyseRule )
 import CoreFVs         ( exprFreeVars, ruleRhsFreeVars, ruleLhsFreeIds )
 import CoreUnfold      ( isCheapUnfolding, unfoldingTemplate )
 import CoreUtils       ( eqExpr )
-import PprCore         ( pprCoreRule )
+import CoreTidy                ( pprTidyIdRules )
 import Subst           ( Subst, InScopeSet, mkInScopeSet, lookupSubst, extendSubst,
                          substEnv, setSubstEnv, emptySubst, isInScope, emptyInScopeSet,
                          bindSubstList, unBindSubstList, substInScope, uniqAway
@@ -34,6 +34,7 @@ import qualified TcType ( match )
 import BasicTypes      ( Activation, CompilerPhase, isActive )
 
 import Outputable
+import FastString
 import Maybe           ( isJust, isNothing, fromMaybe )
 import Util            ( sortLt )
 import Bag
@@ -505,7 +506,7 @@ ruleCheckProgram phase rule_pat binds
         ]
   where
     results = unionManyBags (map (ruleCheckBind (phase, rule_pat)) binds)
-    line = text (take 20 (repeat '-'))
+    line = text (replicate 20 '-')
          
 type RuleCheckEnv = (CompilerPhase, String)    -- Phase and Pattern
 
@@ -541,7 +542,7 @@ ruleCheckFun (phase, pat) fn args
   where
     name_match_rules = case idSpecialisation fn of
                          Rules rules _ -> filter match rules
-    match rule = pat `isPrefixOf` _UNPK_ (ruleName rule)
+    match rule = pat `isPrefixOf` unpackFS (ruleName rule)
 
 ruleAppCheck_help :: CompilerPhase -> Id -> [CoreExpr] -> [CoreRule] -> SDoc
 ruleAppCheck_help phase fn args rules
@@ -554,8 +555,10 @@ ruleAppCheck_help phase fn args rules
 
     check_rule rule = rule_herald rule <> colon <+> rule_info rule
 
-    rule_herald (BuiltinRule name _) = text "Builtin rule" <+> doubleQuotes (ptext name)
-    rule_herald (Rule name _ _ _ _)  = text "Rule" <+> doubleQuotes (ptext name)
+    rule_herald (BuiltinRule name _) = 
+       ptext SLIT("Builtin rule") <+> doubleQuotes (ftext name)
+    rule_herald (Rule name _ _ _ _)  = 
+       ptext SLIT("Rule") <+> doubleQuotes (ftext name)
 
     rule_info rule
        | Just (name,_) <- matchRule noBlackList emptyInScopeSet rule args
@@ -629,7 +632,5 @@ extendRuleBase (RuleBase rule_ids rule_fvs) (id, rule)
        -- locally defined ones!!
 
 pprRuleBase :: RuleBase -> SDoc
-pprRuleBase (RuleBase rules _) = vcat [ pprCoreRule (ppr id) rs
-                                     | id <- varSetElems rules,
-                                       rs <- rulesRules $ idSpecialisation id ]
+pprRuleBase (RuleBase rules _) = vcat [ pprTidyIdRules id | id <- varSetElems rules ]
 \end{code}