[project @ 2002-09-13 15:02:25 by simonpj]

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

diff --git a/ghc/compiler/specialise/SpecConstr.lhs b/ghc/compiler/specialise/SpecConstr.lhs
index 85bbd96..ab7ccd4 100644 (file)
--- a/ghc/compiler/specialise/SpecConstr.lhs
+++ b/ghc/compiler/specialise/SpecConstr.lhs
@@ -14,12 +14,11 @@ import CoreSyn
 import CoreLint                ( showPass, endPass )
 import CoreUtils       ( exprType, eqExpr, mkPiTypes )
 import CoreFVs                 ( exprsFreeVars )
-import CoreTidy                ( tidyIdRules )
+import CoreTidy                ( pprTidyIdRules )
 import WwLib           ( mkWorkerArgs )
 import DataCon         ( dataConRepArity )
 import Type            ( tyConAppArgs )
-import PprCore         ( pprIdRules )
-import Id              ( Id, idName, idType, idSpecialisation,
+import Id              ( Id, idName, idType, 
                          isDataConId_maybe, 
                          mkUserLocal, mkSysLocal )
 import Var             ( Var )
@@ -34,10 +33,11 @@ import BasicTypes   ( Activation(..) )
 import Outputable
 
 import Maybes          ( orElse )
-import Util            ( mapAccumL, lengthAtLeast )
+import Util            ( mapAccumL, lengthAtLeast, notNull )
 import List            ( nubBy, partition )
 import UniqSupply
 import Outputable
+import FastString
 \end{code}
 
 -----------------------------------------------------
@@ -182,7 +182,7 @@ specConstrProgram dflags us binds
        endPass dflags "SpecConstr" Opt_D_dump_spec binds'
 
        dumpIfSet_dyn dflags Opt_D_dump_rules "Top-level specialisations"
-                 (vcat (map dump_specs (concat (map bindersOf binds'))))
+                 (vcat (map pprTidyIdRules (concat (map bindersOf binds'))))
 
        return binds'
   where
@@ -190,8 +190,6 @@ specConstrProgram dflags us binds
     go env (bind:binds) = scBind env bind      `thenUs` \ (env', _, bind') ->
                          go env' binds         `thenUs` \ binds' ->
                          returnUs (bind' : binds')
-
-    dump_specs var = pprIdRules (tidyIdRules var)
 \end{code}
 
 
@@ -377,7 +375,7 @@ scExpr env e@(App _ _)
 ----------------------
 scBind :: ScEnv -> CoreBind -> UniqSM (ScEnv, ScUsage, CoreBind)
 scBind env (Rec [(fn,rhs)])
-  | not (null val_bndrs)
+  | notNull val_bndrs
   = scExpr env_fn_body body            `thenUs` \ (usg, body') ->
     let
        SCU { calls = calls, occs = occs } = usg
@@ -511,7 +509,7 @@ spec_one env fn rhs (pats, rule_number)
                -- Usual w/w hack to avoid generating 
                -- a spec_rhs of unlifted type and no args
        
-       rule_name = _PK_ ("SC:" ++ showSDoc (ppr fn <> int rule_number))
+       rule_name = mkFastString ("SC:" ++ showSDoc (ppr fn <> int rule_number))
        spec_rhs  = mkLams spec_lam_args spec_body
        spec_id   = mkUserLocal spec_occ spec_uniq (mkPiTypes spec_lam_args body_ty) fn_loc
        rule      = Rule rule_name specConstrActivation