#include "HsVersions.h"
import CoreSyn -- All of it
-import OccurAnal ( occurAnalyseGlobalExpr )
+import OccurAnal ( occurAnalyseExpr )
import CoreFVs ( exprFreeVars, exprsFreeVars, rulesRhsFreeVars )
import CoreUnfold ( isCheapUnfolding, unfoldingTemplate )
import CoreUtils ( tcEqExprX )
import PprCore ( pprRules )
-import Type ( Type )
+import Type ( TvSubstEnv )
import TcType ( tcSplitTyConApp_maybe )
import CoreTidy ( tidyRules )
import Id ( Id, idUnfolding, isLocalId, isGlobalId, idName,
idSpecialisation, idCoreRules, setIdSpecialisation )
import IdInfo ( SpecInfo( SpecInfo ) )
import Var ( Var )
-import VarEnv ( IdEnv, TyVarEnv, InScopeSet, emptyTidyEnv,
+import VarEnv ( IdEnv, InScopeSet, emptyTidyEnv,
emptyInScopeSet, mkInScopeSet, extendInScopeSetList,
emptyVarEnv, lookupVarEnv, extendVarEnv,
nukeRnEnvL, mkRnEnv2, rnOccR, rnOccL, inRnEnvR,
import VarSet
import Name ( Name, NamedThing(..), nameOccName )
import NameEnv
-import Unify ( tcMatchTyX, MatchEnv(..) )
+import Unify ( ruleMatchTyX, MatchEnv(..) )
import BasicTypes ( Activation, CompilerPhase, isActive )
-
import Outputable
import FastString
-import Maybe ( isJust )
+import Maybes ( isJust, orElse )
import Bag
+import Util ( singleton )
import List ( isPrefixOf )
\end{code}
extendRuleBase :: RuleBase -> CoreRule -> RuleBase
extendRuleBase rule_base rule
- = extendNameEnv_C add rule_base (ruleIdName rule) [rule]
- where
- add rules _ = rule : rules
+ = extendNameEnv_Acc (:) singleton rule_base (ruleIdName rule) rule
pprRuleBase :: RuleBase -> SDoc
pprRuleBase rules = vcat [ pprRules (tidyRules emptyTidyEnv rs)
lookupRule is_active in_scope rule_base fn args
= matchRules is_active in_scope fn args rules
where
- rules | isLocalId fn = idCoreRules fn
- | otherwise = case lookupNameEnv rule_base (idName fn) of
- Just rules -> rules
- Nothing -> []
+ -- The rules for an Id come from two places:
+ -- (a) the ones it is born with (idCoreRules fn)
+ -- (b) rules added in subsequent modules (extra_rules)
+ -- PrimOps, for example, are born with a bunch of rules under (a)
+ rules = extra_rules ++ idCoreRules fn
+ extra_rules | isLocalId fn = []
+ | otherwise = lookupNameEnv rule_base (idName fn) `orElse` []
matchRules :: (Activation -> Bool) -> InScopeSet
-> Id -> [CoreExpr]
`mkApps` tpl_vals
`mkApps` leftovers)
where
- rule_fn = occurAnalyseGlobalExpr (mkLams tpl_vars rhs)
+ rule_fn = occurAnalyseExpr (mkLams tpl_vars rhs)
-- We could do this when putting things into the rulebase, I guess
\end{code}
-- for uniformity with IdSubstEnv
type SubstEnv = (TvSubstEnv, IdSubstEnv)
type IdSubstEnv = IdEnv CoreExpr
-type TvSubstEnv = TyVarEnv Type
emptySubstEnv :: SubstEnv
emptySubstEnv = (emptyVarEnv, emptyVarEnv)
\begin{code}
------------------------------------------
match_ty menv (tv_subst, id_subst) ty1 ty2
- = do { tv_subst' <- Unify.tcMatchTyX menv tv_subst ty1 ty2
+ = do { tv_subst' <- Unify.ruleMatchTyX menv tv_subst ty1 ty2
; return (tv_subst', id_subst) }
\end{code}