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