Do not float join points in exprIsConApp_maybe

We hvae been making exprIsConApp_maybe cleverer in recent times:

    commit b78cc64e923716ac0512c299f42d4d0012306c05
    Date:   Thu Nov 15 17:14:31 2018 +0100
    Make constructor wrappers inline only during the final phase

    commit 7833cf407d1f608bebb1d38bb99d3035d8d735e6
    Date:   Thu Jan 24 17:58:50 2019 +0100
    Look through newtype wrappers (Trac #16254)

    commit c25b135ff5b9c69a90df0ccf51b04952c2dc6ee1
    Date:   Thu Feb 21 12:03:22 2019 +0000
    Fix exprIsConApp_maybe

But alas there was still a bug, now immortalised in
  Note [Don't float join points]
in SimpleOpt.

It's quite hard to trigger because it requires a dead
join point, but it came up when compiling Cabal
Cabal.Distribution.Fields.Lexer.hs, when working on
!3113.

Happily, the fix is extremly easy.  Finding the
bug was not so easy.

1 files changed, 27 insertions, 0 deletions

diff --git a/compiler/GHC/Core/SimpleOpt.hs b/compiler/GHC/Core/SimpleOpt.hs
index b14b421e49..afb51d1219 100644
--- a/compiler/GHC/Core/SimpleOpt.hs
+++ b/compiler/GHC/Core/SimpleOpt.hs
@@ -957,6 +957,31 @@ will happen the next time either.
 
 See test T16254, which checks the behavior of newtypes.
 
+Note [Don't float join points]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+exprIsConApp_maybe should succeed on
+   let v = e in Just v
+returning [x=e] as one of the [FloatBind].  But it must
+NOT succeed on
+   join j x = rhs in Just v
+because join-points can't be gaily floated.  Consider
+   case (join j x = rhs in Just) of
+     K p q -> blah
+We absolutely must not "simplify" this to
+   join j x = rhs
+   in blah
+because j's return type is (Maybe t), quite different to blah's.
+
+You might think this could never happen, because j can't be
+tail-called in the body if the body returns a constructor.  But
+in !3113 we had a /dead/ join point (which is not illegal),
+and its return type was wonky.
+
+The simple thing is not to float a join point.  The next iteration
+of the simplifier will sort everything out.  And it there is
+a join point, the chances are that the body is not a constructor
+application, so failing faster is good.
+
 Note [exprIsConApp_maybe for data-con wrappers: tricky corner]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Generally speaking
@@ -1065,6 +1090,8 @@ exprIsConApp_maybe (in_scope, id_unf) expr
          in go subst' (float:floats) body (CC args co)
 
     go subst floats (Let (NonRec bndr rhs) expr) cont
+       | not (isJoinId bndr)
+         -- Crucial guard! See Note [Don't float join points]
        = let rhs'            = subst_expr subst rhs
              (subst', bndr') = subst_bndr subst bndr
              float           = FloatLet (NonRec bndr' rhs')