[commit: ghc] wip/T14152: Exitification: The body of a let is also in tail-call position (915c152)

[git at git.haskell.org]

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

On branch  : wip/T14152
Link       : http://ghc.haskell.org/trac/ghc/changeset/915c1524773dedbf4b61b420b0c5a5c4b99f632a/ghc

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

commit 915c1524773dedbf4b61b420b0c5a5c4b99f632a
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Sun Sep 3 09:15:02 2017 +0100

    Exitification: The body of a let is also in tail-call position


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

915c1524773dedbf4b61b420b0c5a5c4b99f632a
 compiler/coreSyn/CoreSyn.hs   | 10 +++++-----
 compiler/simplCore/Exitify.hs |  5 +++++
 2 files changed, 10 insertions(+), 5 deletions(-)

diff --git a/compiler/coreSyn/CoreSyn.hs b/compiler/coreSyn/CoreSyn.hs
index 99478d2..4c87b62 100644
--- a/compiler/coreSyn/CoreSyn.hs
+++ b/compiler/coreSyn/CoreSyn.hs
@@ -77,7 +77,7 @@ module CoreSyn (
         collectAnnArgs, collectAnnArgsTicks,
 
         -- ** Operations on annotations
-        deAnnotate, deAnnotate', deAnnAlt,
+        deAnnotate, deAnnotate', deAnnAlt, deAnnBind,
         collectAnnBndrs, collectNAnnBndrs,
 
         -- * Orphanhood
@@ -2158,16 +2158,16 @@ deAnnotate' (AnnTick tick body)   = Tick tick (deAnnotate body)
 
 deAnnotate' (AnnLet bind body)
   = Let (deAnnBind bind) (deAnnotate body)
-  where
-    deAnnBind (AnnNonRec var rhs) = NonRec var (deAnnotate rhs)
-    deAnnBind (AnnRec pairs) = Rec [(v,deAnnotate rhs) | (v,rhs) <- pairs]
-
 deAnnotate' (AnnCase scrut v t alts)
   = Case (deAnnotate scrut) v t (map deAnnAlt alts)
 
 deAnnAlt :: AnnAlt bndr annot -> Alt bndr
 deAnnAlt (con,args,rhs) = (con,args,deAnnotate rhs)
 
+deAnnBind  :: AnnBind b annot -> Bind b
+deAnnBind (AnnNonRec var rhs) = NonRec var (deAnnotate rhs)
+deAnnBind (AnnRec pairs) = Rec [(v,deAnnotate rhs) | (v,rhs) <- pairs]
+
 -- | As 'collectBinders' but for 'AnnExpr' rather than 'Expr'
 collectAnnBndrs :: AnnExpr bndr annot -> ([bndr], AnnExpr bndr annot)
 collectAnnBndrs e
diff --git a/compiler/simplCore/Exitify.hs b/compiler/simplCore/Exitify.hs
index cc4172d..8913c3e 100644
--- a/compiler/simplCore/Exitify.hs
+++ b/compiler/simplCore/Exitify.hs
@@ -135,6 +135,11 @@ exitify in_scope pairs =
             return (dc, pats, rhs')
         return $ Case (deAnnotate scrut) bndr ty alts'
 
+    go captured (_, AnnLet ann_bind body) = do
+        let bind = deAnnBind ann_bind
+        body' <- go (bindersOf bind ++ captured) body
+        return $ Let bind body'
+
     go _ ann_e = return (deAnnotate ann_e) -- TODO: What else is a tail-call position?