import CoreLint ( showPass, endPass )
import CoreUtils ( exprType, eqExpr, mkPiTypes )
import CoreFVs ( exprsFreeVars )
+import CoreTidy ( pprTidyIdRules )
import WwLib ( mkWorkerArgs )
import DataCon ( dataConRepArity )
import Type ( tyConAppArgs )
-import PprCore ( pprCoreRules )
-import Id ( Id, idName, idType, idSpecialisation,
- isDataConId_maybe,
+import Id ( Id, idName, idType,
+ isDataConId_maybe,
mkUserLocal, mkSysLocal )
import Var ( Var )
import VarEnv
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}
-----------------------------------------------------
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
go env (bind:binds) = scBind env bind `thenUs` \ (env', _, bind') ->
go env' binds `thenUs` \ binds' ->
returnUs (bind' : binds')
-
-dump_specs var = pprCoreRules var (idSpecialisation var)
\end{code}
----------------------
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
-- 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