[commit: ghc] master: FloatOut: Allow floating through breakpoint ticks (44f079f)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/ghc

On branch  : master
Link       : http://ghc.haskell.org/trac/ghc/changeset/44f079f74869d8cb417e2dcc104517ae7f593e5f/ghc

>---------------------------------------------------------------

commit 44f079f74869d8cb417e2dcc104517ae7f593e5f
Author: Ben Gamari <bgamari.foss at gmail.com>
Date:   Tue Jan 31 16:05:26 2017 -0500

    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


>---------------------------------------------------------------

44f079f74869d8cb417e2dcc104517ae7f593e5f
 compiler/simplCore/FloatOut.hs  | 27 +++++++++++++--------------
 compiler/simplCore/SetLevels.hs |  3 ++-
 2 files changed, 15 insertions(+), 15 deletions(-)

diff --git a/compiler/simplCore/FloatOut.hs b/compiler/simplCore/FloatOut.hs
index 475108c..10955d2 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 955d3ba..c0d6e8d 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