import VarSet
import VarEnv
import CoreSyn
+import Rules
import CoreUtils ( applyTypeToArgs, mkPiTypes )
import CoreFVs ( exprFreeVars, exprsFreeVars, idFreeVars )
-import CoreTidy ( tidyRules )
import CoreLint ( showPass, endPass )
-import Rules ( addIdSpecialisations, mkLocalRule, lookupRule, emptyRuleBase, rulesOfBinds )
-import PprCore ( pprRules )
import UniqSupply ( UniqSupply,
UniqSM, initUs_,
MonadUnique(..)
endPass dflags "Specialise" Opt_D_dump_spec binds'
dumpIfSet_dyn dflags Opt_D_dump_rules "Top-level specialisations"
- (pprRules (tidyRules emptyTidyEnv (rulesOfBinds binds')))
+ (pprRulesForUser (rulesOfBinds binds'))
return binds'
where
where
mk_ty_arg rhs_tyvar Nothing = Type (mkTyVarTy rhs_tyvar)
mk_ty_arg _ (Just ty) = Type ty
- rhs_subst = extendTvSubstList subst (spec_tyvars `zip` [ty | Just ty <- call_ts])
+
+ spec_ty_args = [ty | Just ty <- call_ts]
+ rhs_subst = extendTvSubstList subst (spec_tyvars `zip` spec_ty_args)
(rhs_subst', rhs_dicts') <- cloneBinders rhs_subst rhs_dicts
let
let
-- The rule to put in the function's specialisation is:
-- forall b,d, d1',d2'. f t1 b t3 d d1' d2' = f1 b d
- spec_env_rule = mkLocalRule (mkFastString ("SPEC " ++ showSDoc (ppr fn)))
+ rule_name = mkFastString ("SPEC " ++ showSDoc (ppr fn <+> ppr spec_ty_args))
+ spec_env_rule = mkLocalRule
+ rule_name
inline_prag -- Note [Auto-specialisation and RULES]
(idName fn)
(poly_tyvars ++ rhs_dicts')
dumpUDs bndrs (MkUD { dict_binds = orig_dbs
, calls = orig_calls
, ud_fvs = fvs}) body
- = (MkUD { dict_binds = free_dbs
- , calls = free_calls
- , ud_fvs = fvs `minusVarSet` bndr_set}, -- This may delete fewer variables
- foldrBag add_let body dump_dbs) -- than in priciple possible
+ = (new_uds, foldrBag add_let body dump_dbs)
+ -- This may delete fewer variables
+ -- than in priciple possible
where
+ new_uds =
+ MkUD { dict_binds = free_dbs
+ , calls = free_calls
+ , ud_fvs = fvs `minusVarSet` bndr_set}
+
bndr_set = mkVarSet bndrs
add_let (bind,_) body = Let bind body
-- Remove any calls that mention the variables
filterCalls bs calls
= mapFM (\_ cs -> filter_calls cs) $
- filterFM (\k _ -> k `elemVarSet` bs) calls
+ filterFM (\k _ -> not (k `elemVarSet` bs)) calls
where
filter_calls :: CallInfo -> CallInfo
- filter_calls = filterFM (\_ (_, fvs) -> fvs `intersectsVarSet` bs)
+ filter_calls = filterFM (\_ (_, fvs) -> not (fvs `intersectsVarSet` bs))
\end{code}