diff options
Diffstat (limited to 'compiler/specialise')
| -rw-r--r-- | compiler/specialise/Rules.lhs | 19 | ||||
| -rw-r--r-- | compiler/specialise/SpecConstr.lhs | 14 | ||||
| -rw-r--r-- | compiler/specialise/Specialise.lhs | 16 |
3 files changed, 23 insertions, 26 deletions
diff --git a/compiler/specialise/Rules.lhs b/compiler/specialise/Rules.lhs index a439f2ac27..ef29eb58eb 100644 --- a/compiler/specialise/Rules.lhs +++ b/compiler/specialise/Rules.lhs @@ -626,10 +626,6 @@ match :: RuleEnv -- The Var case follows closely what happens in Unify.match match renv subst (Var v1) e2 = match_var renv subst v1 e2 -match renv subst (Note _ e1) e2 = match renv subst e1 e2 -match renv subst e1 (Note _ e2) = match renv subst e1 e2 - -- Ignore notes in both template and thing to be matched - -- See Note [Notes in RULE matching] match renv subst e1 (Var v2) -- Note [Expanding variables] | not (inRnEnvR rn_env v2) -- Note [Do not expand locally-bound variables] @@ -885,13 +881,12 @@ the entire match. Hence, (a) the guard (not (isLocallyBoundR v2)) (b) when we expand we nuke the renaming envt (nukeRnEnvR). -Note [Notes in RULE matching] -~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ -Look through Notes in both template and expression being matched. In -particular, we don't want to be confused by InlineMe notes. Maybe we -should be more careful about profiling notes, but for now I'm just -riding roughshod over them. cf Note [Notes in call patterns] in -SpecConstr +Note [Tick annotations in RULE matching] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ +We used to look through Notes in both template and expression being +matched. This would be incorrect for ticks, which we cannot discard, +so we do not look through Ticks at all. cf Note [Notes in call +patterns] in SpecConstr Note [Matching lets] ~~~~~~~~~~~~~~~~~~~~ @@ -1051,7 +1046,7 @@ ruleCheck _ (Lit _) = emptyBag ruleCheck _ (Type _) = emptyBag ruleCheck _ (Coercion _) = emptyBag ruleCheck env (App f a) = ruleCheckApp env (App f a) [] -ruleCheck env (Note _ e) = ruleCheck env e +ruleCheck env (Tick _ e) = ruleCheck env e ruleCheck env (Cast e _) = ruleCheck env e ruleCheck env (Let bd e) = ruleCheckBind env bd `unionBags` ruleCheck env e ruleCheck env (Lam _ e) = ruleCheck env e diff --git a/compiler/specialise/SpecConstr.lhs b/compiler/specialise/SpecConstr.lhs index 34cfc9c90b..0959425e8f 100644 --- a/compiler/specialise/SpecConstr.lhs +++ b/compiler/specialise/SpecConstr.lhs @@ -970,8 +970,8 @@ combineOccs xs ys = zipWithEqual "combineOccs" combineOcc xs ys setScrutOcc :: ScEnv -> ScUsage -> OutExpr -> ArgOcc -> ScUsage -- _Overwrite_ the occurrence info for the scrutinee, if the scrutinee -- is a variable, and an interesting variable -setScrutOcc env usg (Cast e _) occ = setScrutOcc env usg e occ -setScrutOcc env usg (Note _ e) occ = setScrutOcc env usg e occ +setScrutOcc env usg (Cast e _) occ = setScrutOcc env usg e occ +setScrutOcc env usg (Tick _ e) occ = setScrutOcc env usg e occ setScrutOcc env usg (Var v) occ | Just RecArg <- lookupHowBound env v = usg { scu_occs = extendVarEnv (scu_occs usg) v occ } | otherwise = usg @@ -1003,8 +1003,8 @@ scExpr' env (Var v) = case scSubstId env v of scExpr' env (Type t) = return (nullUsage, Type (scSubstTy env t)) scExpr' env (Coercion c) = return (nullUsage, Coercion (scSubstCo env c)) scExpr' _ e@(Lit {}) = return (nullUsage, e) -scExpr' env (Note n e) = do (usg,e') <- scExpr env e - return (usg, Note n e') +scExpr' env (Tick t e) = do (usg,e') <- scExpr env e + return (usg, Tick t e') scExpr' env (Cast e co) = do (usg, e') <- scExpr env e return (usg, Cast e' (scSubstCo env co)) scExpr' env e@(App _ _) = scApp env (collectArgs e) @@ -1583,7 +1583,7 @@ argToPat _env _in_scope _val_env arg@(Type {}) _arg_occ argToPat _env _in_scope _val_env arg@(Coercion {}) _arg_occ = return (False, arg) -argToPat env in_scope val_env (Note _ arg) arg_occ +argToPat env in_scope val_env (Tick _ arg) arg_occ = argToPat env in_scope val_env arg arg_occ -- Note [Notes in call patterns] -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ @@ -1765,9 +1765,9 @@ samePat (vs1, as1) (vs2, as2) same (Type {}) (Type {}) = True -- Note [Ignore type differences] same (Coercion {}) (Coercion {}) = True - same (Note _ e1) e2 = same e1 e2 -- Ignore casts and notes + same (Tick _ e1) e2 = same e1 e2 -- Ignore casts and notes same (Cast e1 _) e2 = same e1 e2 - same e1 (Note _ e2) = same e1 e2 + same e1 (Tick _ e2) = same e1 e2 same e1 (Cast e2 _) = same e1 e2 same e1 e2 = WARN( bad e1 || bad e2, ppr e1 $$ ppr e2) diff --git a/compiler/specialise/Specialise.lhs b/compiler/specialise/Specialise.lhs index 68d023b52c..24f9d080db 100644 --- a/compiler/specialise/Specialise.lhs +++ b/compiler/specialise/Specialise.lhs @@ -716,9 +716,9 @@ specExpr _ (Lit lit) = return (Lit lit, emptyUDs) specExpr subst (Cast e co) = do (e', uds) <- specExpr subst e return ((Cast e' (CoreSubst.substCo subst co)), uds) -specExpr subst (Note note body) = do +specExpr subst (Tick tickish body) = do (body', uds) <- specExpr subst body - return (Note (specNote subst note) body', uds) + return (Tick (specTickish subst tickish) body', uds) ---------------- Applications might generate a call instance -------------------- @@ -766,10 +766,12 @@ specExpr subst (Let bind body) = do -- All done return (foldr Let body' binds', uds) --- Must apply the type substitution to coerceions -specNote :: Subst -> Note -> Note -specNote _ note = note - +specTickish :: Subst -> Tickish Id -> Tickish Id +specTickish subst (Breakpoint ix ids) + = Breakpoint ix [ id' | id <- ids, Var id' <- [specVar subst id]] + -- drop vars from the list if they have a non-variable substitution. + -- should never happen, but it's harmless to drop them anyway. +specTickish _ other_tickish = other_tickish specCase :: Subst -> CoreExpr -- Scrutinee, already done @@ -1611,7 +1613,7 @@ interestingDict (Type _) = False interestingDict (Coercion _) = False interestingDict (App fn (Type _)) = interestingDict fn interestingDict (App fn (Coercion _)) = interestingDict fn -interestingDict (Note _ a) = interestingDict a +interestingDict (Tick _ a) = interestingDict a interestingDict (Cast e _) = interestingDict e interestingDict _ = True \end{code} |