FloatOut: Allow floating through breakpoint ticks

I believe this is actually a completely valid thing to do, despite the
arguments put forth in #10052. All that was missing was logic in
SetLevels to correctly substitute the cloned binders into the
breakpoint's free variable list.

This is a prerequisite for enabling StaticPointer support in the
interpreter.

Test Plan: Validate

Reviewers: austin, scpmw

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D3049

2 files changed, 15 insertions, 15 deletions

diff --git a/compiler/simplCore/FloatOut.hs b/compiler/simplCore/FloatOut.hs
index 475108c7d8..10955d2861 100644
--- a/compiler/simplCore/FloatOut.hs
+++ b/compiler/simplCore/FloatOut.hs
@@ -260,26 +260,21 @@ floatBody lvl arg       -- Used rec rhss, and case-alternative rhss
 {- Note [Floating past breakpoints]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
-Notes from Peter Wortmann (re: #10052)
+We used to disallow floating out of breakpoint ticks (see #10052). However, I
+think this is too restrictive.
 
-"This case clearly means we're trying to float past a breakpoint..."
+Consider the case of an expression scoped over by a breakpoint tick,
 
-Further:
+  tick<...> (let x = ... in f x)
 
-"Breakpoints as they currently exist are the only Tikish that is not
-scoped, counting, and not splittable.
+In this case it is completely legal to float out x, despite the fact that
+breakpoint ticks are scoped,
 
-This means that we can't:
-  - Simply float code out of it, because the payload must still be covered (scoped)
-  - Copy the tick, because it would change entry counts (here: duplicate breakpoints)"
+  let x = ... in (tick<...>  f x)
 
-While this seems like an odd case, it can apparently occur in real
-life: through the combination of optimizations + GHCi usage. For an
-example, see #10052 as mentioned above. So not only does the
-interpreter not like some compiler-generated things (like unboxed
-tuples), the compiler doesn't like interpreter-introduced things!
+The reason here is that we know that the breakpoint will still be hit when the
+expression is entered since the tick still scopes over the RHS.
 
-Also see Note [GHCi and -O] in GHC.hs.
 -}
 
 floatExpr :: LevelledExpr
@@ -318,6 +313,10 @@ floatExpr (Tick tickish expr)
     (fs, annotated_defns, Tick tickish expr') }
 
   -- Note [Floating past breakpoints]
+  | Breakpoint{} <- tickish
+  = case (floatExpr expr)    of { (fs, floating_defns, expr') ->
+    (fs, floating_defns, Tick tickish expr') }
+
   | otherwise
   = pprPanic "floatExpr tick" (ppr tickish)
 
diff --git a/compiler/simplCore/SetLevels.hs b/compiler/simplCore/SetLevels.hs
index 955d3ba89d..c0d6e8d862 100644
--- a/compiler/simplCore/SetLevels.hs
+++ b/compiler/simplCore/SetLevels.hs
@@ -305,7 +305,8 @@ lvlExpr env (_, AnnCast expr (_, co)) = do
 
 lvlExpr env (_, AnnTick tickish expr) = do
     expr' <- lvlExpr env expr
-    return (Tick tickish expr')
+    let tickish' = substTickish (le_subst env) tickish
+    return (Tick tickish' expr')
 
 lvlExpr env expr@(_, AnnApp _ _) = do
     let