#include "HsVersions.h"
-import DynFlags ( DynFlags, DynFlag(..) )
import Id ( Id, idName, idType, mkUserLocal, idCoreRules,
- idInlinePragma, setInlinePragma, setIdUnfolding,
- isLocalId )
+ idInlineActivation, setInlineActivation, setIdUnfolding,
+ isLocalId )
import TcType ( Type, mkTyVarTy, tcSplitSigmaTy,
tyVarsOfTypes, tyVarsOfTheta, isClassPred,
tcCmpType, isUnLiftedType
import Rules
import CoreUtils ( exprIsTrivial, applyTypeToArgs, mkPiTypes )
import CoreFVs ( exprFreeVars, exprsFreeVars, idFreeVars )
-import CoreLint ( showPass, endPass )
import UniqSupply ( UniqSupply,
UniqSM, initUs_,
MonadUnique(..)
import MkId ( voidArgId, realWorldPrimId )
import FiniteMap
import Maybes ( catMaybes, isJust )
-import ErrUtils ( dumpIfSet_dyn )
import Bag
import Util
import Outputable
%************************************************************************
\begin{code}
-specProgram :: DynFlags -> UniqSupply -> [CoreBind] -> IO [CoreBind]
-specProgram dflags us binds = do
-
- showPass dflags "Specialise"
-
- let binds' = initSM us (do (binds', uds') <- go binds
- return (dumpAllDictBinds uds' binds'))
-
- endPass dflags "Specialise" Opt_D_dump_spec binds'
-
- dumpIfSet_dyn dflags Opt_D_dump_rules "Top-level specialisations"
- (pprRulesForUser (rulesOfBinds binds'))
-
- return binds'
+specProgram :: UniqSupply -> [CoreBind] -> [CoreBind]
+specProgram us binds = initSM us (do (binds', uds') <- go binds
+ return (dumpAllDictBinds uds' binds'))
where
-- We need to start with a Subst that knows all the things
-- that are in scope, so that the substitution engine doesn't
(tyvars, theta, _) = tcSplitSigmaTy fn_type
n_tyvars = length tyvars
n_dicts = length theta
- inline_prag = idInlinePragma fn
+ inline_act = idInlineActivation fn
-- It's important that we "see past" any INLINE pragma
-- else we'll fail to specialise an INLINE thing
rule_name = mkFastString ("SPEC " ++ showSDoc (ppr fn <+> ppr spec_ty_args))
spec_env_rule = mkLocalRule
rule_name
- inline_prag -- Note [Auto-specialisation and RULES]
+ inline_act -- Note [Auto-specialisation and RULES]
(idName fn)
(poly_tyvars ++ inst_dict_ids)
inst_args
-- Add the { d1' = dx1; d2' = dx2 } usage stuff
final_uds = foldr addDictBind rhs_uds dx_binds
- spec_pr | inline_rhs = (spec_f `setInlinePragma` inline_prag, Note InlineMe spec_rhs)
+ spec_pr | inline_rhs = (spec_f `setInlineActivation` inline_act, Note InlineMe spec_rhs)
| otherwise = (spec_f, spec_rhs)
; return (Just (spec_pr, final_uds, spec_env_rule)) } }
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We transfer to the specialised function any INLINE stuff from the
original. This means (a) the Activation in the IdInfo, and (b) any
-InlineMe on the RHS.
+InlineMe on the RHS. We do not, however, transfer the RuleMatchInfo
+since we do not expect the specialisation to occur in rewrite rules.
This is a change (Jun06). Previously the idea is that the point of
inlining was precisely to specialise the function at its call site,