[commit: ghc] ghc-8.4: In Exitify, zap idInfo of abstracted variables (fixes #15005) (2f5b97c)

[git at git.haskell.org]

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

On branch  : ghc-8.4
Link       : http://ghc.haskell.org/trac/ghc/changeset/2f5b97c37dbc9708e7a33b4e36f66a12b32ee09f/ghc

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

commit 2f5b97c37dbc9708e7a33b4e36f66a12b32ee09f
Author: Joachim Breitner <mail at joachim-breitner.de>
Date:   Tue Apr 10 09:36:08 2018 -0400

    In Exitify, zap idInfo of abstracted variables (fixes #15005)
    
    as helpfully outlined by SPJ.
    
    This commit copies a small bit code from `SetLevels` which could
    reasonably be put in `Id` as `zapAllIdinfo`; I did not do this to make
    merging this commmit into `ghc-8.4` easier.
    
    If this commit gets merged, then presumably after commit
    3f59d3802170f495702674b4f8e4e80247803654 (test case) and
    ae0cff0a1834d8b041b06d0e1ab6ce969aac44c8 (other fixes to Exitify.hs).
    
    Differential Revision: https://phabricator.haskell.org/D4582
    
    (cherry picked from commit 3cfb12d8adac37e5565d66fd173e4648cc041e65)


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

2f5b97c37dbc9708e7a33b4e36f66a12b32ee09f
 compiler/simplCore/Exitify.hs | 10 +++++++++-
 1 file changed, 9 insertions(+), 1 deletion(-)

diff --git a/compiler/simplCore/Exitify.hs b/compiler/simplCore/Exitify.hs
index 2d3b5af..9295922 100644
--- a/compiler/simplCore/Exitify.hs
+++ b/compiler/simplCore/Exitify.hs
@@ -48,6 +48,7 @@ import VarEnv
 import CoreFVs
 import FastString
 import Type
+import MkCore           ( sortQuantVars )
 
 import Data.Bifunctor
 import Control.Monad
@@ -166,7 +167,14 @@ exitify in_scope pairs =
         is_interesting = anyVarSet isLocalId (fvs `minusVarSet` mkVarSet captured)
 
         -- The possible arguments of this exit join point
-        args = filter (`elemVarSet` fvs) captured
+        args =
+            map zap $
+            sortQuantVars $
+            filter (`elemVarSet` fvs) captured
+
+        -- cf. SetLevels.abstractVars
+        zap v | isId v = setIdInfo v vanillaIdInfo
+              | otherwise = v
 
         -- We cannot abstract over join points
         captures_join_points = any isJoinId args