From ccc45f0239e7e9719b78eacf42bef718fe71af6a Mon Sep 17 00:00:00 2001 From: Ben Gamari <ben@smart-cactus.org> Date: Sun, 29 Dec 2019 07:51:15 +0000 Subject: [PATCH] simplCore: Ensure that rule templates contain no ticks This fixes #17619, where a tick snuck in to the template of a rule, resulting in a panic during rule matching. The situation is summarized in `Note [Rule templates are devoid of ticks]`. In short, we ensure that the template remains devoid of ticks by stripping ticks after substitution. This feels a bit hacky but I can't think of a better option at the moment. We also now assert this invariant in Core Lint. --- compiler/coreSyn/CoreLint.hs | 7 +++++++ compiler/coreSyn/CoreSubst.hs | 3 ++- compiler/simplCore/Simplify.hs | 3 ++- compiler/specialise/Rules.hs | 18 ++++++++++++++++++ 4 files changed, 29 insertions(+), 2 deletions(-) diff --git a/compiler/coreSyn/CoreLint.hs b/compiler/coreSyn/CoreLint.hs index def51f5010cc..1fbb7c8b2fde 100644 --- a/compiler/coreSyn/CoreLint.hs +++ b/compiler/coreSyn/CoreLint.hs @@ -1571,6 +1571,10 @@ lintCoreRule fun fun_ty rule@(Rule { ru_name = name, ru_bndrs = bndrs , ru_args = args, ru_rhs = rhs }) = lintBinders LambdaBind bndrs $ \ _ -> do { lhs_ty <- lintCoreArgs fun_ty args + + -- Ensure template arguments contain no ticks + ; forM_ args $ \arg -> checkL (null $ stripTicksT (const True) arg) + $ template_arg_with_tick_doc arg ; rhs_ty <- case isJoinId_maybe fun of Just join_arity -> do { checkL (args `lengthIs` join_arity) $ @@ -1591,6 +1595,9 @@ lintCoreRule fun fun_ty rule@(Rule { ru_name = name, ru_bndrs = bndrs where rule_doc = text "Rule" <+> doubleQuotes (ftext name) <> colon + template_arg_with_tick_doc arg = + rule_doc <+> text "Argument" <+> ppr arg <+> text "contains tick(s)" + lhs_fvs = exprsFreeVars args rhs_fvs = exprFreeVars rhs diff --git a/compiler/coreSyn/CoreSubst.hs b/compiler/coreSyn/CoreSubst.hs index afb894642622..43f9c358f690 100644 --- a/compiler/coreSyn/CoreSubst.hs +++ b/compiler/coreSyn/CoreSubst.hs @@ -687,7 +687,8 @@ substRule subst subst_ru_fn rule@(Rule { ru_bndrs = bndrs, ru_args = args , ru_fn = if is_local then subst_ru_fn fn_name else fn_name - , ru_args = map (substExpr doc subst') args + , ru_args = map (stripTicksE (const True) . substExpr doc subst') args + -- See Note [Rule templates are devoid of ticks] in Rules. , ru_rhs = substExpr (text "foo") subst' rhs } -- Do NOT optimise the RHS (previously we did simplOptExpr here) -- See Note [Substitute lazily] diff --git a/compiler/simplCore/Simplify.hs b/compiler/simplCore/Simplify.hs index 408006f75aa2..225dc498c2f4 100644 --- a/compiler/simplCore/Simplify.hs +++ b/compiler/simplCore/Simplify.hs @@ -3645,5 +3645,6 @@ simplRules env mb_new_id rules mb_cont ; rhs' <- simplExprC rule_env rhs rhs_cont ; return (rule { ru_bndrs = bndrs' , ru_fn = fn_name' - , ru_args = args' + , ru_args = map (stripTicksE (const True)) args' + -- See Note [Rule templates are devoid of ticks] in Rules. , ru_rhs = rhs' }) } diff --git a/compiler/specialise/Rules.hs b/compiler/specialise/Rules.hs index 72e293421cf5..af9b46878b70 100644 --- a/compiler/specialise/Rules.hs +++ b/compiler/specialise/Rules.hs @@ -1024,6 +1024,24 @@ tick scope, we can float them upwards to the rule application site. cf Note [Notes in call patterns] in SpecConstr +Note [Rule templates are devoid of ticks] +~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ + +As mentioned in Note [Tick annotations in RULE matching], the matcher allows +ticks only in very few cases. In particular, they are completely disallowed +in the rule template. Core Lint checks this invariant. + +However, there are a few ways in which ticks can sneak in to the template. +#17619 is one particularly tricky way: + + 1. SpecConstr creates a rule on `f` with a free variable `x` in its template. + 2. CSE rewrites the RHS of `x` to `<tick> y` + 3. The simplifier unconditionally post-inlines `x` + 4. The simplifier simplifes `f`'s rules and, in so doing, substitutes `x ~> + <tick> y`, introducing a tick into the template of the rule. + +To avoid this, we strip ticks after substituting in to rule templates. + Note [Matching lets] ~~~~~~~~~~~~~~~~~~~~ Matching a let-expression. Consider -- GitLab