[Git][ghc/ghc][wip/T23083] 6 commits: DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997)

Sebastian Graf (@sgraf812) gitlab at gitlab.haskell.org
Mon Mar 13 10:14:59 UTC 2023



Sebastian Graf pushed to branch wip/T23083 at Glasgow Haskell Compiler / GHC


Commits:
ec2d93eb by Sebastian Graf at 2023-03-10T10:18:54-05:00
DmdAnal: Fix a panic on OPAQUE and trivial/PAP RHS (#22997)

We should not panic in `add_demands` (now `set_lam_dmds`), because that code
path is legimitely taken for OPAQUE PAP bindings, as in T22997.

Fixes #22997.

- - - - -
5b4628ae by Sylvain Henry at 2023-03-10T10:19:34-05:00
JS: remove dead code for old integer-gmp

- - - - -
bab23279 by Josh Meredith at 2023-03-10T23:24:49-05:00
JS: Fix implementation of MK_JSVAL

- - - - -
ec263a59 by Sebastian Graf at 2023-03-10T23:25:25-05:00
Simplify: Move `wantEtaExpansion` before expensive `do_eta_expand` check

There is no need to run arity analysis and what not if we are not in a
Simplifier phase that eta-expands or if we don't want to eta-expand the
expression in the first place.

Purely a refactoring with the goal of improving compiler perf.

- - - - -
badeaf4d by Sebastian Graf at 2023-03-13T11:14:36+01:00
Simplifier: Simplification of arguments in a single function

The Simplifier had a function `simplArg` that wasn't called in `rebuildCall`,
which seems to be the main way to simplify args. Hence I consolidated the code
path to call `simplArg`, too, renaming to `simplLazyArg`.

- - - - -
c4fbfb8c by Sebastian Graf at 2023-03-13T11:14:36+01:00
CorePrep: Eta expand arguments (#23083)

Previously, we'd only eta expand let bindings and lambdas,
now we'll also eta expand arguments such as in T23083:
```hs
g f h = f (h `seq` (h $))
```
Unless `-fpedantic-bottoms` is set, we'll now transform to
```hs
g f h = f (\eta -> h eta)
```
in CorePrep.

See the new `Note [Eta expansion of arguments in CorePrep]` for the details.

Fixes #23083.

- - - - -


12 changed files:

- compiler/GHC/Core/Opt/DmdAnal.hs
- compiler/GHC/Core/Opt/Simplify/Iteration.hs
- compiler/GHC/Core/Opt/Simplify/Utils.hs
- compiler/GHC/CoreToStg/Prep.hs
- compiler/GHC/Driver/Config/CoreToStg/Prep.hs
- compiler/GHC/StgToJS/Linker/Utils.hs
- rts/js/rts.js
- + testsuite/tests/simplCore/should_compile/T23083.hs
- + testsuite/tests/simplCore/should_compile/T23083.stderr
- testsuite/tests/simplCore/should_compile/all.T
- + testsuite/tests/stranal/should_compile/T22997.hs
- testsuite/tests/stranal/should_compile/all.T


Changes:

=====================================
compiler/GHC/Core/Opt/DmdAnal.hs
=====================================
@@ -1916,10 +1916,11 @@ finaliseArgBoxities env fn threshold_arity rhs_dmds div rhs
 
   -- Check for an OPAQUE function: see Note [OPAQUE pragma]
   -- In that case, trim off all boxity info from argument demands
+  -- and demand info on lambda binders
   -- See Note [The OPAQUE pragma and avoiding the reboxing of arguments]
   | isOpaquePragma (idInlinePragma fn)
   , let trimmed_rhs_dmds = map trimBoxity rhs_dmds
-  = (trimmed_rhs_dmds, add_demands trimmed_rhs_dmds rhs)
+  = (trimmed_rhs_dmds, set_lam_dmds trimmed_rhs_dmds rhs)
 
   -- Check that we have enough visible binders to match the
   -- threshold arity; if not, we won't do worker/wrapper
@@ -1939,8 +1940,8 @@ finaliseArgBoxities env fn threshold_arity rhs_dmds div rhs
     --   vcat [text "function:" <+> ppr fn
     --        , text "dmds before:" <+> ppr (map idDemandInfo (filter isId bndrs))
     --        , text "dmds after: " <+>  ppr arg_dmds' ]) $
-    (arg_dmds', add_demands arg_dmds' rhs)
-    -- add_demands: we must attach the final boxities to the lambda-binders
+    (arg_dmds', set_lam_dmds arg_dmds' rhs)
+    -- set_lam_dmds: we must attach the final boxities to the lambda-binders
     -- of the function, both because that's kosher, and because CPR analysis
     -- uses the info on the binders directly.
   where
@@ -2032,17 +2033,18 @@ finaliseArgBoxities env fn threshold_arity rhs_dmds div rhs
                  | positiveTopBudget bg_inner' = (bg_inner', dmd')
                  | otherwise                   = (bg_inner,  trimBoxity dmd)
 
-    add_demands :: [Demand] -> CoreExpr -> CoreExpr
+    set_lam_dmds :: [Demand] -> CoreExpr -> CoreExpr
     -- Attach the demands to the outer lambdas of this expression
-    add_demands [] e = e
-    add_demands (dmd:dmds) (Lam v e)
-      | isTyVar v = Lam v (add_demands (dmd:dmds) e)
-      | otherwise = Lam (v `setIdDemandInfo` dmd) (add_demands dmds e)
-    add_demands dmds (Cast e co) = Cast (add_demands dmds e) co
+    set_lam_dmds (dmd:dmds) (Lam v e)
+      | isTyVar v = Lam v (set_lam_dmds (dmd:dmds) e)
+      | otherwise = Lam (v `setIdDemandInfo` dmd) (set_lam_dmds dmds e)
+    set_lam_dmds dmds (Cast e co) = Cast (set_lam_dmds dmds e) co
        -- This case happens for an OPAQUE function, which may look like
        --     f = (\x y. blah) |> co
        -- We give it strictness but no boxity (#22502)
-    add_demands dmds e = pprPanic "add_demands" (ppr dmds $$ ppr e)
+    set_lam_dmds _ e = e
+       -- In the OPAQUE case, the list of demands at this point might be
+       -- non-empty, e.g., when looking at a PAP. Hence don't panic (#22997).
 
 finaliseLetBoxity
   :: AnalEnv


=====================================
compiler/GHC/Core/Opt/Simplify/Iteration.hs
=====================================
@@ -1517,7 +1517,7 @@ rebuild env expr cont
       ApplyToVal { sc_arg = arg, sc_env = se, sc_dup = dup_flag
                  , sc_cont = cont, sc_hole_ty = fun_ty }
         -- See Note [Avoid redundant simplification]
-        -> do { (_, _, arg') <- simplArg env dup_flag fun_ty se arg
+        -> do { (_, _, arg') <- simplLazyArg env dup_flag fun_ty Nothing se arg
               ; rebuild env (App expr arg') cont }
 
 completeBindX :: SimplEnv
@@ -1633,7 +1633,6 @@ simplCast env body co0 cont0
                                    , sc_hole_ty = coercionLKind co }) }
                                         -- NB!  As the cast goes past, the
                                         -- type of the hole changes (#16312)
-
         -- (f |> co) e   ===>   (f (e |> co1)) |> co2
         -- where   co :: (s1->s2) ~ (t1->t2)
         --         co1 :: t1 ~ s1
@@ -1652,7 +1651,7 @@ simplCast env body co0 cont0
                       -- See Note [Avoiding exponential behaviour]
 
                    MCo co1 ->
-            do { (dup', arg_se', arg') <- simplArg env dup fun_ty arg_se arg
+            do { (dup', arg_se', arg') <- simplLazyArg env dup fun_ty Nothing arg_se arg
                     -- When we build the ApplyTo we can't mix the OutCoercion
                     -- 'co' with the InExpr 'arg', so we simplify
                     -- to make it all consistent.  It's a bit messy.
@@ -1678,16 +1677,18 @@ simplCast env body co0 cont0
           -- See Note [Representation polymorphism invariants] in GHC.Core
           -- test: typecheck/should_run/EtaExpandLevPoly
 
-simplArg :: SimplEnv -> DupFlag
-         -> OutType                 -- Type of the function applied to this arg
-         -> StaticEnv -> CoreExpr   -- Expression with its static envt
-         -> SimplM (DupFlag, StaticEnv, OutExpr)
-simplArg env dup_flag fun_ty arg_env arg
+simplLazyArg :: SimplEnv -> DupFlag
+             -> OutType                 -- Type of the function applied to this arg
+             -> Maybe ArgInfo
+             -> StaticEnv -> CoreExpr   -- Expression with its static envt
+             -> SimplM (DupFlag, StaticEnv, OutExpr)
+simplLazyArg env dup_flag fun_ty mb_arg_info arg_env arg
   | isSimplified dup_flag
   = return (dup_flag, arg_env, arg)
   | otherwise
   = do { let arg_env' = arg_env `setInScopeFromE` env
-       ; arg' <- simplExprC arg_env' arg (mkBoringStop (funArgTy fun_ty))
+       ; let arg_ty = funArgTy fun_ty
+       ; arg' <- simplExprC arg_env' arg (mkLazyArgStop arg_ty mb_arg_info)
        ; return (Simplified, zapSubstEnv arg_env', arg') }
          -- Return a StaticEnv that includes the in-scope set from 'env',
          -- because arg' may well mention those variables (#20639)
@@ -2281,12 +2282,8 @@ rebuildCall env fun_info
         -- There is no benefit (unlike in a let-binding), and we'd
         -- have to be very careful about bogus strictness through
         -- floating a demanded let.
-  = do  { arg' <- simplExprC (arg_se `setInScopeFromE` env) arg
-                             (mkLazyArgStop arg_ty fun_info)
+  = do  { (_, _, arg') <- simplLazyArg env dup_flag fun_ty (Just fun_info) arg_se arg
         ; rebuildCall env (addValArgTo fun_info  arg' fun_ty) cont }
-  where
-    arg_ty = funArgTy fun_ty
-
 
 ---------- No further useful info, revert to generic rebuild ------------
 rebuildCall env (ArgInfo { ai_fun = fun, ai_args = rev_args }) cont
@@ -3723,7 +3720,7 @@ mkDupableContWithDmds env dmds
     do  { let (dmd:cont_dmds) = dmds   -- Never fails
         ; (floats1, cont') <- mkDupableContWithDmds env cont_dmds cont
         ; let env' = env `setInScopeFromF` floats1
-        ; (_, se', arg') <- simplArg env' dup hole_ty se arg
+        ; (_, se', arg') <- simplLazyArg env' dup hole_ty Nothing se arg
         ; (let_floats2, arg'') <- makeTrivial env NotTopLevel dmd (fsLit "karg") arg'
         ; let all_floats = floats1 `addLetFloats` let_floats2
         ; return ( all_floats


=====================================
compiler/GHC/Core/Opt/Simplify/Utils.hs
=====================================
@@ -461,8 +461,9 @@ mkRhsStop :: OutType -> RecFlag -> Demand -> SimplCont
 -- See Note [RHS of lets] in GHC.Core.Unfold
 mkRhsStop ty is_rec bndr_dmd = Stop ty (RhsCtxt is_rec) (subDemandIfEvaluated bndr_dmd)
 
-mkLazyArgStop :: OutType -> ArgInfo -> SimplCont
-mkLazyArgStop ty fun_info = Stop ty (lazyArgContext fun_info) arg_sd
+mkLazyArgStop :: OutType -> Maybe ArgInfo -> SimplCont
+mkLazyArgStop ty Nothing         = mkBoringStop ty
+mkLazyArgStop ty (Just fun_info) = Stop ty (lazyArgContext fun_info) arg_sd
   where
     arg_sd = subDemandIfEvaluated (Partial.head (ai_dmds fun_info))
 
@@ -1859,11 +1860,12 @@ tryEtaExpandRhs :: SimplEnv -> BindContext -> OutId -> OutExpr
                 -> SimplM (ArityType, OutExpr)
 -- See Note [Eta-expanding at let bindings]
 tryEtaExpandRhs env bind_cxt bndr rhs
-  | do_eta_expand           -- If the current manifest arity isn't enough
-                            --    (never true for join points)
-  , seEtaExpand env         -- and eta-expansion is on
-  , wantEtaExpansion rhs
-  = -- Do eta-expansion.
+  | seEtaExpand env         -- If Eta-expansion is on
+  , wantEtaExpansion rhs    -- and we'd like to eta-expand e
+  , do_eta_expand           -- and e's manifest arity is lower than
+                            --     what it could be
+                            --     (never true for join points)
+  =                         -- Do eta-expansion.
     assertPpr( not (isJoinBC bind_cxt) ) (ppr bndr) $
        -- assert: this never happens for join points; see GHC.Core.Opt.Arity
        --         Note [Do not eta-expand join points]


=====================================
compiler/GHC/CoreToStg/Prep.hs
=====================================
@@ -1491,7 +1491,12 @@ cpeArg env dmd arg
 
        ; if okCpeArg arg2
          then do { v <- newVar arg_ty
-                 ; let arg3      = cpeEtaExpand (exprArity arg2) arg2
+                 ; let ao        = cp_arityOpts (cpe_config env)
+                 -- See Note [Eta expansion of arguments in CorePrep]
+                 ; let arg3      | Just at <- exprEtaExpandArity ao arg2
+                                 = cpeEtaExpand (arityTypeArity at) arg2
+                                 | otherwise
+                                 = arg2
                        arg_float = mkFloat env dmd is_unlifted v arg3
                  ; return (addFloat floats2 arg_float, varToCoreExpr v) }
          else return (floats2, arg2)
@@ -1614,6 +1619,34 @@ and now we do NOT want eta expansion to give
 Instead GHC.Core.Opt.Arity.etaExpand gives
                 f = /\a -> \y -> let s = h 3 in g s y
 
+Note [Eta expansion of arguments in CorePrep]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+We eta expand arguments in here, in CorePrep, rather than in the Simplifier, and
+do so based on 'exprEtaExpandArity' rather than the cheaper 'exprArity' analysis
+we do on let RHSs and lambdas. The reason for the latter is that the Simplifier
+has already run the more costly analysis on lambdas and let RHSs and eta
+expanded accordingly, while it does not try to eta expand arguments at all.
+
+So why eta expand arguments in CorePrep rather than in the Simplifier?
+There are two reasons why eta expansion of arguments is useful
+
+  1. In expressions like @f (h `seq` (g $))@ (from T23083) eta expanding the
+     argument to @f (\x -> h `seq` (g $ x))@ allows us to save allocation of a
+     closure and have a faster call sequence; a code-gen matter.
+
+  2. The eta expansion to @f (\x -> h `seq` (g $ x))@ gives rise to another
+     opportunity: We could inline ($), saving call overhead and perhaps turning
+     an unknown call into a known call. In general, there could be further
+     simplification based on the structure of the concrete argument `x`.
+
+To profit from (1), it is enough to eta expand in CorePrep, while (2) shows
+that in some rare cases as above, eta expansion of arguments may enable
+further simplification. CorePrep would not allow to exploit (2), while eta
+expansion in the Simplifier would.
+
+Alas, trying to eta expand arguments in every round of the Simplifier is costly
+(!10088 measured a geom. mean of +2.0% regression in ghc/alloc perf, regressing
+as much as 27.2%), so we only exploit (1) for now.
 -}
 
 cpeEtaExpand :: Arity -> CpeRhs -> CpeRhs
@@ -1977,6 +2010,9 @@ data CorePrepConfig = CorePrepConfig
   , cp_convertNumLit           :: !(LitNumType -> Integer -> Maybe CoreExpr)
   -- ^ Convert some numeric literals (Integer, Natural) into their final
   -- Core form.
+
+  , cp_arityOpts               :: !ArityOpts
+  -- ^ Configuration for arity analysis ('exprEtaExpandArity').
   }
 
 data CorePrepEnv
@@ -1987,6 +2023,7 @@ data CorePrepEnv
         -- enabled we instead produce an 'error' expression to catch
         -- the case where a function we think should bottom
         -- unexpectedly returns.
+
         , cpe_env             :: IdEnv CoreExpr   -- Clone local Ids
         -- ^ This environment is used for three operations:
         --


=====================================
compiler/GHC/Driver/Config/CoreToStg/Prep.hs
=====================================
@@ -9,6 +9,7 @@ import GHC.Core.Opt.Pipeline.Types ( CoreToDo(..) )
 import GHC.Driver.Env
 import GHC.Driver.Session
 import GHC.Driver.Config.Core.Lint
+import GHC.Driver.Config.Core.Opt.Arity
 import GHC.Tc.Utils.Env
 import GHC.Types.Var
 import GHC.Utils.Outputable ( alwaysQualify )
@@ -17,14 +18,16 @@ import GHC.CoreToStg.Prep
 
 initCorePrepConfig :: HscEnv -> IO CorePrepConfig
 initCorePrepConfig hsc_env = do
+   let dflags = hsc_dflags hsc_env
    convertNumLit <- do
-     let platform = targetPlatform $ hsc_dflags hsc_env
+     let platform = targetPlatform dflags
          home_unit = hsc_home_unit hsc_env
          lookup_global = lookupGlobal hsc_env
      mkConvertNumLiteral platform home_unit lookup_global
    return $ CorePrepConfig
       { cp_catchNonexhaustiveCases = gopt Opt_CatchNonexhaustiveCases $ hsc_dflags hsc_env
       , cp_convertNumLit = convertNumLit
+      , cp_arityOpts = initArityOpts dflags
       }
 
 initCorePrepPgmConfig :: DynFlags -> [Var] -> CorePrepPgmConfig


=====================================
compiler/GHC/StgToJS/Linker/Utils.hs
=====================================
@@ -115,8 +115,8 @@ genCommonCppDefs profiling = mconcat
 
   -- GHCJS.Prim.JSVal
   , if profiling
-      then "#define MK_JSVAL(x) (h$baseZCGHCziJSziPrimziJSVal_con_e, (x), h$CCS_SYSTEM)\n"
-      else "#define MK_JSVAL(x) (h$baseZCGHCziJSziPrimziJSVal_con_e, (x))\n"
+      then "#define MK_JSVAL(x) (h$c1(h$baseZCGHCziJSziPrimziJSVal_con_e, (x), h$CCS_SYSTEM))\n"
+      else "#define MK_JSVAL(x) (h$c1(h$baseZCGHCziJSziPrimziJSVal_con_e, (x)))\n"
   ,  "#define JSVAL_VAL(x) ((x).d1)\n"
 
   -- GHCJS.Prim.JSException


=====================================
rts/js/rts.js
=====================================
@@ -365,14 +365,7 @@ function h$printReg(r) {
     } else if(r.f.t === h$ct_blackhole && r.x) {
       return ("blackhole: -> " + h$printReg({ f: r.x.x1, d: r.d1.x2 }) + ")");
     } else {
-      var iv = "";
-      if(r.f.n === "integer-gmp:GHC.Integer.Type.Jp#" ||
-      r.f.n === "integer-gmp:GHC.Integer.Type.Jn#") {
-        iv = ' [' + r.d1.join(',') + '](' + h$ghcjsbn_showBase(r.d1, 10) + ')'
-      } else if(r.f.n === "integer-gmp:GHC.Integer.Type.S#") {
-        iv = ' (S: ' + r.d1 + ')';
-      }
-      return ((r.alloc ? r.alloc + ': ' : '') + r.f.n + " (" + h$closureTypeName(r.f.t) + ", " + r.f.a + ")" + iv);
+      return ((r.alloc ? r.alloc + ': ' : '') + r.f.n + " (" + h$closureTypeName(r.f.t) + ", " + r.f.a + ")");
     }
   } else if(typeof r === 'object') {
     var res = h$collectProps(r);
@@ -536,14 +529,7 @@ function h$dumpStackTop(stack, start, sp) {
           if(s.f.t === h$ct_blackhole && s.d1 && s.d1.x1 && s.d1.x1.n) {
             h$log("stack[" + i + "] = blackhole -> " + s.d1.x1.n);
           } else {
-            var iv = "";
-            if(s.f.n === "integer-gmp:GHC.Integer.Type.Jp#" ||
-            s.f.n === "integer-gmp:GHC.Integer.Type.Jn#") {
-              iv = ' [' + s.d1.join(',') + '](' + h$ghcjsbn_showBase(s.d1, 10) + ')'
-            } else if(s.f.n === "integer-gmp:GHC.Integer.Type.S#") {
-              iv = ' (S: ' + s.d1 + ')';
-            }
-            h$log("stack[" + i + "] = -> " + (s.alloc ? s.alloc + ': ' : '') + s.f.n + " (" + h$closureTypeName(s.f.t) + ", a: " + s.f.a + ")" + iv);
+            h$log("stack[" + i + "] = -> " + (s.alloc ? s.alloc + ': ' : '') + s.f.n + " (" + h$closureTypeName(s.f.t) + ", a: " + s.f.a + ")");
           }
         }
       } else if(h$isInstanceOf(s,h$MVar)) {


=====================================
testsuite/tests/simplCore/should_compile/T23083.hs
=====================================
@@ -0,0 +1,6 @@
+{-# OPTIONS_GHC -O2 -fforce-recomp #-}
+
+module T23083 where
+
+g :: ((Integer -> Integer) -> Integer) -> (Integer -> Integer) -> Integer
+g f h = f (h `seq` (h $))


=====================================
testsuite/tests/simplCore/should_compile/T23083.stderr
=====================================
@@ -0,0 +1,36 @@
+
+==================== Tidy Core ====================
+Result size of Tidy Core = {terms: 21, types: 17, coercions: 0, joins: 0/0}
+
+-- RHS size: {terms: 6, types: 6, coercions: 0, joins: 0/0}
+g :: ((Integer -> Integer) -> Integer) -> (Integer -> Integer) -> Integer
+[GblId, Arity=2, Str=<1C(1,L)><LC(S,L)>, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [60 60] 50 0}]
+g = \ (f :: (Integer -> Integer) -> Integer) (h :: Integer -> Integer) -> f (\ (eta :: Integer) -> h eta)
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+T23083.$trModule4 :: GHC.Prim.Addr#
+[GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}]
+T23083.$trModule4 = "main"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+T23083.$trModule3 :: GHC.Types.TrName
+[GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+T23083.$trModule3 = GHC.Types.TrNameS T23083.$trModule4
+
+-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
+T23083.$trModule2 :: GHC.Prim.Addr#
+[GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 30 0}]
+T23083.$trModule2 = "T23083"#
+
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+T23083.$trModule1 :: GHC.Types.TrName
+[GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+T23083.$trModule1 = GHC.Types.TrNameS T23083.$trModule2
+
+-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
+T23083.$trModule :: GHC.Types.Module
+[GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+T23083.$trModule = GHC.Types.Module T23083.$trModule3 T23083.$trModule1
+
+
+


=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -477,3 +477,4 @@ test('T23012', normal, compile, ['-O'])
 test('RewriteHigherOrderPatterns', normal, compile, ['-O -ddump-rule-rewrites -dsuppress-all -dsuppress-uniques'])
 test('T23024', normal, multimod_compile, ['T23024', '-O -v0'])
 test('T23026', normal, compile, ['-O'])
+test('T23083', [ grep_errmsg(r'f.*eta') ], compile, ['-O -ddump-simpl -dsuppress-uniques -dppr-cols=99999'])


=====================================
testsuite/tests/stranal/should_compile/T22997.hs
=====================================
@@ -0,0 +1,9 @@
+module T22997 where
+
+{-# OPAQUE trivial #-}
+trivial :: Int -> Int
+trivial = succ
+
+{-# OPAQUE pap #-}
+pap :: Integer -> Integer
+pap = (42 +)


=====================================
testsuite/tests/stranal/should_compile/all.T
=====================================
@@ -88,3 +88,5 @@ test('EtaExpansion', normal, compile, [''])
 test('T22039', normal, compile, [''])
 # T22388: Should see $winteresting but not $wboring
 test('T22388', [ grep_errmsg(r'^\S+\$w\S+') ], compile, ['-dsuppress-uniques -ddump-simpl'])
+# T22997: Just a panic that should not happen
+test('T22997', normal, compile, [''])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8ca0c05b598353177cec46d4a508ea725d282f09...c4fbfb8cedcabc0badcb4d89613177164d778460

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/8ca0c05b598353177cec46d4a508ea725d282f09...c4fbfb8cedcabc0badcb4d89613177164d778460
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20230313/6e83717c/attachment-0001.html>


More information about the ghc-commits mailing list