Working around a bug to do with optCoercionwip/T18962

4 files changed, 9 insertions, 8 deletions

diff --git a/compiler/GHC/Builtin/Names.hs b/compiler/GHC/Builtin/Names.hs
index cf0f72c50f..e6d18f5f1d 100644
--- a/compiler/GHC/Builtin/Names.hs
+++ b/compiler/GHC/Builtin/Names.hs
@@ -2163,7 +2163,7 @@ wildCardKey, absentErrorIdKey, augmentIdKey, appendIdKey,
     raiseOverflowIdKey, raiseUnderflowIdKey, raiseDivZeroIdKey
     :: Unique
 
-wildCardKey                   = mkPreludeMiscIdUnique  0  -- See Note [WildCard binders]
+wildCardKey                   = mkPreludeMiscIdUnique  0  -- See Note [WildCard names]
 absentErrorIdKey              = mkPreludeMiscIdUnique  1
 augmentIdKey                  = mkPreludeMiscIdUnique  2
 appendIdKey                   = mkPreludeMiscIdUnique  3
diff --git a/compiler/GHC/Core/Opt/Simplify.hs b/compiler/GHC/Core/Opt/Simplify.hs
index c485bd1cfe..376ec58052 100644
--- a/compiler/GHC/Core/Opt/Simplify.hs
+++ b/compiler/GHC/Core/Opt/Simplify.hs
@@ -21,7 +21,6 @@ import GHC.Core.Opt.Simplify.Monad
 import GHC.Core.Type hiding ( substTy, substTyVar, extendTvSubst, extendCvSubst )
 import GHC.Core.Opt.Simplify.Env
 import GHC.Core.Opt.Simplify.Utils
-import GHC.Core.Opt.StaticArgs ( saTransform )
 import GHC.Core.Opt.OccurAnal ( occurAnalyseExpr )
 import GHC.Types.Literal   ( litIsLifted ) --, mkLitInt ) -- temporalily commented out. See #8326
 import GHC.Types.SourceText
diff --git a/compiler/GHC/Core/Opt/StaticArgs.hs b/compiler/GHC/Core/Opt/StaticArgs.hs
index 1ee130811c..4c17bd7754 100644
--- a/compiler/GHC/Core/Opt/StaticArgs.hs
+++ b/compiler/GHC/Core/Opt/StaticArgs.hs
@@ -56,6 +56,7 @@ import GHC.Prelude
 
 #include "HsVersions.h"
 
+import GHC.Builtin.Uniques ( mkBuiltinUnique )
 import GHC.Builtin.Names ( unboundKey )
 import GHC.Types.Var
 import GHC.Core
@@ -154,7 +155,7 @@ peelSatOccs (SO env) fn = case delLookupVarEnv env fn of
   (mb_sa, env') -> (mb_sa `orElse` noStaticArgs, SO env')
 
 satAnalBind :: SatEnv -> TopLevelFlag -> CoreBind -> (SatOccs, CoreBind)
-satAnalBind env top_lvl (NonRec id rhs) = (occs, NonRec id rhs')
+satAnalBind env _ (NonRec id rhs) = (occs, NonRec id rhs')
   where
     (occs, rhs') = satAnalExpr (env `addInScopeVar` id) rhs
 satAnalBind env top_lvl (Rec pairs) = (combineSatOccsList occss, Rec pairs')
@@ -171,6 +172,7 @@ satAnalBind env top_lvl (Rec pairs) = (combineSatOccsList occss, Rec pairs')
         (static_args, occs') = peelSatOccs occs fn
         !fn' | allStaticAndUnliftedBody (length bndrs) static_args rhs_body
              || (isStableUnfolding (realIdUnfolding fn) && idStaticArgs fn /= noStaticArgs)
+             || length pairs >= 27 -- panics in optCoercion while compiling GHC.Tc.Utils.Zonk?!!
              = fn -- otherwise we end up with an unlifted worker body
              | otherwise     = -- pprTrace "satAnalBind:set" (ppr fn $$ ppr static_args) $
                                fn `setIdStaticArgs` static_args
@@ -560,16 +562,16 @@ saTransform binder arg_staticness rhs_binders rhs_body
     -- rhs_binders = [\alpha, \beta, c, n, xs]
     -- rhs_body = e
 
-    binders_w_staticness = rhs_binders `zip` (arg_staticness ++ repeat NotStatic)
+    binders_w_staticness = zip3 rhs_binders (arg_staticness ++ repeat NotStatic) (map mkBuiltinUnique [1..])
                                         -- Any extra args are assumed NotStatic
 
     non_static_args :: [Var]
             -- non_static_args = [xs]
             -- rhs_binders_without_type_capture = [\alpha', \beta', c, n, xs]
-    non_static_args = [v | (v, NotStatic) <- binders_w_staticness]
+    non_static_args = [v | (v, NotStatic, _) <- binders_w_staticness]
 
-    mk_shadow_lam_bndr (bndr, NotStatic) = bndr
-    mk_shadow_lam_bndr (bndr, _        ) = setVarUnique bndr unboundKey
+    mk_shadow_lam_bndr (bndr, NotStatic, _   ) = bndr
+    mk_shadow_lam_bndr (bndr, _        , uniq) = setVarUnique bndr uniq
                                            -- See Note [Binder type capture]
 
     -- new_rhs = \alpha beta c n xs ->
diff --git a/compiler/GHC/Core/Unfold.hs b/compiler/GHC/Core/Unfold.hs
index 244de58c5d..48cb75faf7 100644
--- a/compiler/GHC/Core/Unfold.hs
+++ b/compiler/GHC/Core/Unfold.hs
@@ -51,7 +51,7 @@ import GHC.Core.DataCon
 import GHC.Types.Literal
 import GHC.Builtin.PrimOps
 import GHC.Types.Id.Info
-import GHC.Types.Basic  ( Arity, InlineSpec(..), inlinePragmaSpec, noStaticArgs )
+import GHC.Types.Basic  ( Arity, InlineSpec(..), inlinePragmaSpec )
 import GHC.Core.Type
 import GHC.Builtin.Names
 import GHC.Builtin.Types.Prim ( realWorldStatePrimTy )