[Git][ghc/ghc][wip/T23209] Make SpecConstr deal with casts better

Simon Peyton Jones (@simonpj) gitlab at gitlab.haskell.org
Thu Nov 30 16:29:34 UTC 2023



Simon Peyton Jones pushed to branch wip/T23209 at Glasgow Haskell Compiler / GHC


Commits:
401c02ed by Simon Peyton Jones at 2023-11-30T16:28:34+00:00
Make SpecConstr deal with casts better

This patch does two things, to fix #23209:

* It improves SpecConstr so that it no longer quantifies over
  coercion variables.  See Note [SpecConstr and casts]

* It improves the rule matcher to deal nicely with the case where
  the rule does not quantify over coercion variables, but the the
  template has a cast in it.  See Note [Casts in the template]

- - - - -


6 changed files:

- compiler/GHC/Core/Opt/SpecConstr.hs
- compiler/GHC/Core/Rules.hs
- compiler/GHC/Core/SimpleOpt.hs
- + testsuite/tests/simplCore/should_compile/T23209.hs
- + testsuite/tests/simplCore/should_compile/T23209_Aux.hs
- testsuite/tests/simplCore/should_compile/all.T


Changes:

=====================================
compiler/GHC/Core/Opt/SpecConstr.hs
=====================================
@@ -67,7 +67,6 @@ import GHC.Types.Unique.FM
 import GHC.Types.Unique( hasKey )
 
 import GHC.Data.Maybe     ( orElse, catMaybes, isJust, isNothing )
-import GHC.Data.Pair
 import GHC.Data.FastString
 
 import GHC.Utils.Misc
@@ -2246,7 +2245,7 @@ Wrinkles:
 
 * The list of argument patterns, cp_args, is no longer than the
   visible lambdas of the binding, ri_arg_occs.  This is done via
-  the zipWithM in callToPats.
+  the zipWithM in callToPat.
 
 * The list of argument patterns can certainly be shorter than the
   lambdas in the function definition (under-saturated).  For example
@@ -2256,7 +2255,7 @@ Wrinkles:
 
 * In fact we deliberately shrink the list of argument patterns,
   cp_args, by trimming off all the boring ones at the end (see
-  `dropWhileEnd is_boring` in callToPats).  Since the RULE only
+  `dropWhileEnd is_boring` in callToPat).  Since the RULE only
   applies when it is saturated, this shrinking makes the RULE more
   applicable.  But it does mean that the argument patterns do not
   necessarily saturate the lambdas of the function.
@@ -2299,63 +2298,48 @@ Note [SpecConstr and casts]
 Consider (#14270) a call like
 
     let f = e
-    in ... f (K @(a |> co)) ...
+    in ... f (K @(a |> cv)) ...
 
-where 'co' is a coercion variable not in scope at f's definition site.
+where 'cv' is a coercion variable not in scope at f's definition site.
 If we aren't careful we'll get
 
-    let $sf a co = e (K @(a |> co))
-        RULE "SC:f" forall a co.  f (K @(a |> co)) = $sf a co
+    let $sf a cv = e (K @(a |> cv))
+        RULE "SC:f" forall a cv.  f (K @(a |> cv)) = $sf a co
         f = e
     in ...
 
-But alas, when we match the call we won't bind 'co', because type-matching
-(for good reasons) discards casts).
-
-I don't know how to solve this, so for now I'm just discarding any
-call patterns that
-  * Mentions a coercion variable in a type argument
-  * That is not in scope at the binding of the function
-
-I think this is very rare.
-
-It is important (e.g. #14936) that this /only/ applies to
-coercions mentioned in casts.  We don't want to be discombobulated
-by casts in terms!  For example, consider
-   f ((e1,e2) |> sym co)
-where, say,
-   f  :: Foo -> blah
-   co :: Foo ~R (Int,Int)
-
-Here we definitely do want to specialise for that pair!  We do not
-match on the structure of the coercion; instead we just match on a
-coercion variable, so the RULE looks like
-
-   forall (x::Int, y::Int, co :: (Int,Int) ~R Foo)
-     f ((x,y) |> co) = $sf x y co
-
-Often the body of f looks like
-   f arg = ...(case arg |> co' of
-                (x,y) -> blah)...
-
-so that the specialised f will turn into
-   $sf x y co = let arg = (x,y) |> co
-                in ...(case arg>| co' of
-                         (x,y) -> blah)....
-
-which will simplify to not use 'co' at all.  But we can't guarantee
-that co will end up unused, so we still pass it.  Absence analysis
-may remove it later.
-
-Note that this /also/ discards the call pattern if we have a cast in a
-/term/, although in fact Rules.match does make a very flaky and
-fragile attempt to match coercions.  e.g. a call like
-    f (Maybe Age) (Nothing |> co) blah
-    where co :: Maybe Int ~ Maybe Age
-will be discarded.  It's extremely fragile to match on the form of a
-coercion, so I think it's better just not to try.  A more complicated
-alternative would be to discard calls that mention coercion variables
-only in kind-casts, but I'm doing the simple thing for now.
+But alas, when we match the call we may fail to bind 'co', because the rule
+matcher in GHC.Core.Rules cannot reliably bind coercion variables that appear
+in casts (see Note [Casts in the template] in GHC.Core.Rules).
+
+This seems intractable (see #23209). So:
+
+* Key point: we /never/ quantify over coercion variables in a SpecConstr rule.
+  If we would need to quantify over a coercion variable, we just discard the
+  call pattern. See the test for `bad_covars` in callToPat.
+
+* However (#14936) we /do/ still allow casts in call patterns. For example
+     f ((e1,e2) |> sym co)
+  where, say,
+     f  :: Foo -> blah   -- Foo is a newtype
+     f = f_rhs
+     co :: Foo ~R (Int,Int)
+  We want to specialise on that pair!
+
+So for our function f, we might generate
+  RULE forall x y.  f ((x,y) |> co) = $sf x y
+  $sf x y = f_rhs ((x,y) |> co)
+
+This works provided the free vars of `co` are either in-scope at the
+definition of `f`, or quantified. For the latter, suppose `f` was polymorphic:
+
+     f2  :: Foo2 a -> blah   -- Foo is a newtype
+     f2 = f2_rhs
+     co2 :: Foo a ~R (a,a)
+
+Then it's fine for `co2` to mention `a`.  We'll get
+  RULE forall a (x::a) (y::a).  f2 @a ((x,y) |> co2) = $sf2 a x y
+  $sf2 @a x y = f2_rhs ((x,y) |> co2)
 -}
 
 data CallPat = CP { cp_qvars :: [Var]           -- Quantified variables
@@ -2485,12 +2469,12 @@ trim_pats env fn (SI { si_n_specs = done_spec_count }) pats
                , text "Discarding:" <+> ppr (drop n_remaining sorted_pats) ]
 
 
-callToPats :: ScEnv -> [ArgOcc] -> Call -> UniqSM (Maybe CallPat)
+callToPat :: ScEnv -> [ArgOcc] -> Call -> UniqSM (Maybe CallPat)
         -- The [Var] is the variables to quantify over in the rule
         --      Type variables come first, since they may scope
         --      over the following term variables
         -- The [CoreExpr] are the argument patterns for the rule
-callToPats env bndr_occs call@(Call fn args con_env)
+callToPat env bndr_occs call@(Call fn args con_env)
   = do  { let in_scope = getSubstInScope (sc_subst env)
 
         ; arg_tripples <- zipWith3M (argToPat env in_scope con_env) args bndr_occs (map (const NotMarkedStrict) args)
@@ -2521,32 +2505,25 @@ callToPats env bndr_occs call@(Call fn args con_env)
                 -- See Note [Free type variables of the qvar types]
                 -- See Note [Shadowing] at the top
 
-              (ktvs, ids)   = partition isTyVar qvars
-              qvars'        = scopedSort ktvs ++ map sanitise ids
+              (qktvs, qids) = partition isTyVar qvars
+              qvars'        = scopedSort qktvs ++ map sanitise qids
                 -- Order into kind variables, type variables, term variables
                 -- The kind of a type variable may mention a kind variable
                 -- and the type of a term variable may mention a type variable
 
-              sanitise id   = updateIdTypeAndMult expandTypeSynonyms id
+              sanitise id = updateIdTypeAndMult expandTypeSynonyms id
                 -- See Note [Free type variables of the qvar types]
 
-
         -- Check for bad coercion variables: see Note [SpecConstr and casts]
-        ; let bad_covars :: CoVarSet
-              bad_covars = mapUnionVarSet get_bad_covars pats
-              get_bad_covars :: CoreArg -> CoVarSet
-              get_bad_covars (Type ty) = filterVarSet bad_covar (tyCoVarsOfType ty)
-              get_bad_covars _         = emptyVarSet
-              bad_covar v = isId v && not (is_in_scope v)
-
-        ; warnPprTrace (not (isEmptyVarSet bad_covars))
+        ; let bad_covars = filter isCoVar qids
+        ; warnPprTrace (not (null bad_covars))
               "SpecConstr: bad covars"
               (ppr bad_covars $$ ppr call) $
 
-          if interesting && isEmptyVarSet bad_covars
+          if interesting && null bad_covars
           then do { let cp_res = CP { cp_qvars = qvars', cp_args = pats
                                     , cp_strict_args = concat cbv_ids }
---                  ; pprTraceM "callToPatsOut" $
+--                  ; pprTraceM "callToPatOut" $
 --                    vcat [ text "fn:" <+> ppr fn
 --                         , text "args:" <+> ppr args
 --                         , text "bndr_occs:" <+> ppr bndr_occs
@@ -2614,39 +2591,16 @@ argToPat1 env in_scope val_env (Let _ arg) arg_occ arg_str
         -- Here we can specialise for f (v,w)
         -- because the rule-matcher will look through the let.
 
-{- Disabled; see Note [Matching cases] in "GHC.Core.Rules"
-argToPat env in_scope val_env (Case scrut _ _ [(_, _, rhs)]) arg_occ
-  | exprOkForSpeculation scrut  -- See Note [Matching cases] in "GHC.Core.Rules"
-  = argToPat env in_scope val_env rhs arg_occ
--}
-
+   -- Casts: see Note [SpecConstr and casts]
 argToPat1 env in_scope val_env (Cast arg co) arg_occ arg_str
   | not (ignoreType env ty2)
   = do  { (interesting, arg', strict_args) <- argToPat env in_scope val_env arg arg_occ arg_str
         ; if not interesting then
                 wildCardPat ty2 arg_str
-          else do
-        { -- Make a wild-card pattern for the coercion
-          uniq <- getUniqueM
-        ; let co_name = mkSysTvName uniq (fsLit "sg")
-              co_var  = mkCoVar co_name (mkCoercionType Representational ty1 ty2)
-        ; return (interesting, Cast arg' (mkCoVarCo co_var), strict_args) } }
+          else
+                return (interesting, Cast arg' co, strict_args) }
   where
-    Pair ty1 ty2 = coercionKind co
-
-
-
-{-      Disabling lambda specialisation for now
-        It's fragile, and the spec_loop can be infinite
-argToPat in_scope val_env arg arg_occ
-  | is_value_lam arg
-  = return (True, arg)
-  where
-    is_value_lam (Lam v e)         -- Spot a value lambda, even if
-        | isId v       = True      -- it is inside a type lambda
-        | otherwise    = is_value_lam e
-    is_value_lam other = False
--}
+    ty2 = coercionRKind co
 
   -- Check for a constructor application
   -- NB: this *precedes* the Var case, so that we catch nullary constrs
@@ -2735,6 +2689,25 @@ argToPat1 env in_scope val_env (Var v) arg_occ arg_str
         --       f x y = letrec g z = ... in g (x,y)
         -- We don't want to specialise for that *particular* x,y
 
+
+{- Disabled; see Note [Matching cases] in "GHC.Core.Rules"
+argToPat env in_scope val_env (Case scrut _ _ [(_, _, rhs)]) arg_occ
+  | exprOkForSpeculation scrut  -- See Note [Matching cases] in "GHC.Core.Rules"
+  = argToPat env in_scope val_env rhs arg_occ
+-}
+
+{-      Disabling lambda specialisation for now
+        It's fragile, and the spec_loop can be infinite
+argToPat in_scope val_env arg arg_occ
+  | is_value_lam arg
+  = return (True, arg)
+  where
+    is_value_lam (Lam v e)         -- Spot a value lambda, even if
+        | isId v       = True      -- it is inside a type lambda
+        | otherwise    = is_value_lam e
+    is_value_lam other = False
+-}
+
   -- The default case: make a wild-card
   -- We use this for coercions too
 argToPat1 _env _in_scope _val_env arg _arg_occ arg_str


=====================================
compiler/GHC/Core/Rules.hs
=====================================
@@ -86,6 +86,7 @@ import GHC.Data.Maybe
 import GHC.Data.Bag
 import GHC.Data.List.SetOps( hasNoDups )
 
+import GHC.Utils.FV( filterFV, fvVarSet )
 import GHC.Utils.Misc as Utils
 import GHC.Utils.Outputable
 import GHC.Utils.Panic
@@ -967,45 +968,78 @@ where 'co' is non-reflexive, we simply fail.  You might wonder about
 but the Simplifer pushes the casts in an application to to the
 right, if it can, so this doesn't really arise.
 
-Note [Coercion arguments]
-~~~~~~~~~~~~~~~~~~~~~~~~~
-What if we have (f co) in the template, where the 'co' is a coercion
-argument to f?  Right now we have nothing in place to ensure that a
-coercion /argument/ in the template is a variable.  We really should,
-perhaps by abstracting over that variable.
-
-C.f. the treatment of dictionaries in GHC.HsToCore.Binds.decompseRuleLhs.
-
-For now, though, we simply behave badly, by failing in match_co.
-We really should never rely on matching the structure of a coercion
-(which is just a proof).
-
 Note [Casts in the template]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Consider the definition
+This Note concerns `matchTemplateCast`.  Consider the definition
   f x = e,
 and SpecConstr on call pattern
   f ((e1,e2) |> co)
 
-We'll make a RULE
+The danger is that We'll make a RULE
    RULE forall a,b,g.  f ((a,b)|> g) = $sf a b g
    $sf a b g = e[ ((a,b)|> g) / x ]
 
-So here is the invariant:
+This requires the rule-matcher to bind the coercion variable `g`.
+That is Very Deeply Suspicious:
+
+* It would be unreasonable to match on a structured coercion in a pattern,
+  such as    RULE   forall g.  f (x |> Sym g) = ...
+  because the strucure of a coercion is arbitrary and may change -- it's their
+  /type/ that matters.
 
-  In the template, in a cast (e |> co),
-  the cast `co` is always a /variable/.
+* We considered insisting that in a template, in a cast (e |> co), the the cast
+  `co` is always a /variable/ cv.  That looks a bit more plausible, but #23209
+  (and related tickets) shows that it's very fragile.  For example suppose `e`
+  is a variable `f`, and the simplifier has an unconditional substitution
+     [f :-> g |> co2]
+  Now the rule LHS becomes (f |> (co2 ; cv)); not a coercion variable any more!
 
-Matching should bind that variable to an actual coercion, so that we
-can use it in $sf.  So a Cast on the LHS (the template) calls
-match_co, which succeeds when the template cast is a variable -- which
-it always is.  That is why match_co has so few cases.
+In short, it is Very Deeply Suspicious for a rule to quantify over a coercion
+variable.  And SpecConstr no longer does so: see Note [SpecConstr and casts] in
+SpecConstr.
+
+It is, however, OK for a cast to appear in a template.  For example
+    newtype N a = MkN (a,a)    -- Axiom ax:N a :: (a,a) ~R N a
+    f :: N a -> bah
+    RULE forall b x:b y:b. f @b ((x,y) |> (axN @b)) = ...
+
+When matching we can just move these casts to the other side:
+    match (tmpl |> co) tgt  -->   match tmpl (tgt |> sym co)
+See matchTemplateCast.
+
+Wrinkles:
+
+(CT1) We need to be careful about scoping, and to match left-to-right, so that we
+  know the substitution [a :-> b] before we meet (co :: (a,a) ~R N a), and so we
+  can apply that substitition
+
+(CT2) Annoyingly, we still want support one case in which the RULE quantifies
+  over a coercion variable: the dreaded map/coerce RULE.
+  See Note [Getting the map/coerce RULE to work] in GHC.Core.SimpleOpt.
+
+  Since that can happen, matchTemplateCast laboriously checks whether the
+  coercion mentions a template coercion variable; and if so does the Very Deeply
+  Suspicious `match_co` instead.  It works fine for map/coerce, where the
+  coercion is always a variable and will (robustly) remain so.
 
 See also
 * Note [Coercion arguments]
 * Note [Matching coercion variables] in GHC.Core.Unify.
 * Note [Cast swizzling on rule LHSs] in GHC.Core.Opt.Simplify.Utils:
   sm_cast_swizzle is switched off in the template of a RULE
+
+Note [Coercion arguments]
+~~~~~~~~~~~~~~~~~~~~~~~~~
+What if we have (f (Coercion co)) in the template, where the 'co' is a coercion
+argument to f?  Right now we have nothing in place to ensure that a
+coercion /argument/ in the template is a variable.  We really should,
+perhaps by abstracting over that variable.
+
+C.f. the treatment of dictionaries in GHC.HsToCore.Binds.decompseRuleLhs.
+
+For now, though, we simply behave badly, by failing in match_co.
+We really should never rely on matching the structure of a coercion
+(which is just a proof).
 -}
 
 ----------------------
@@ -1067,14 +1101,7 @@ match renv subst e1 (Cast e2 co2) mco
     -- This is important: see Note [Cancel reflexive casts]
 
 match renv subst (Cast e1 co1) e2 mco
-  = -- See Note [Casts in the template]
-    do { let co2 = case mco of
-                     MRefl   -> mkRepReflCo (exprType e2)
-                     MCo co2 -> co2
-       ; subst1 <- match_co renv subst co1 co2
-         -- If match_co succeeds, then (exprType e1) = (exprType e2)
-         -- Hence the MRefl in the next line
-       ; match renv subst1 e1 e2 MRefl }
+  = matchTemplateCast renv subst e1 co1 e2 mco
 
 ------------------------ Literals ---------------------
 match _ subst (Lit lit1) (Lit lit2) mco
@@ -1297,7 +1324,7 @@ match renv subst (Lam x1 e1) e2 mco
         in_scope_env = ISE in_scope (rv_unf renv)
         -- extendInScopeSetSet: The InScopeSet of rn_env is not necessarily
         -- a superset of the free vars of e2; it is only guaranteed a superset of
-        -- applyng the (rnEnvR rn_env) substitution to e2. But exprIsLambda_maybe
+        -- applying the (rnEnvR rn_env) substitution to e2. But exprIsLambda_maybe
         -- wants an in-scope set that includes all the free vars of its argument.
         -- Hence adding adding (exprFreeVars casted_e2) to the in-scope set (#23630)
   , Just (x2, e2', ts) <- exprIsLambda_maybe in_scope_env casted_e2
@@ -1456,6 +1483,40 @@ Hence
 -}
 
 -------------
+matchTemplateCast
+    :: RuleMatchEnv -> RuleSubst
+    -> CoreExpr -> Coercion
+    -> CoreExpr -> MCoercion
+    -> Maybe RuleSubst
+matchTemplateCast renv subst e1 co1 e2 mco
+  | isEmptyVarSet $ fvVarSet $
+    filterFV (`elemVarSet` rv_tmpls renv) $    -- Check that the coercion does not
+    tyCoFVsOfCo substed_co                     -- mention any of the template variables
+  = -- This is the good path
+    -- See Note [Casts in the template]
+    match renv subst e1 e2 (checkReflexiveMCo (mkTransMCoL mco (mkSymCo substed_co)))
+
+  | otherwise
+  = -- This is the Deeply Suspicious Path
+    do { let co2 = case mco of
+                     MRefl   -> mkRepReflCo (exprType e2)
+                     MCo co2 -> co2
+       ; subst1 <- match_co renv subst co1 co2
+         -- If match_co succeeds, then (exprType e1) = (exprType e2)
+         -- Hence the MRefl in the next line
+       ; match renv subst1 e1 e2 MRefl }
+  where
+    substed_co = substCo current_subst co1
+
+    current_subst :: Subst
+    current_subst = mkTCvSubst (rnInScopeSet (rv_lcl renv))
+                               (rs_tv_subst subst)
+                               emptyCvSubstEnv
+       -- emptyCvSubstEnv: ugh!
+       -- If there were any CoVar substitutions they would be in
+       -- rs_id_subst; but we don't expect there to be any; see
+       -- Note [Casts in the template]
+
 match_co :: RuleMatchEnv
          -> RuleSubst
          -> Coercion


=====================================
compiler/GHC/Core/SimpleOpt.hs
=====================================
@@ -818,35 +818,40 @@ The naive core produced for this is
 
 This matches literal uses of `map coerce` in code, but that's not what we
 want. We want it to match, say, `map MkAge` (where newtype Age = MkAge Int)
-too. Some of this is addressed by compulsorily unfolding coerce on the LHS,
-yielding
+too.  Achieving all this is surprisingly tricky:
 
-  forall a b (dict :: Coercible * a b).
-    map @a @b (\(x :: a) -> case dict of
-      MkCoercible (co :: a ~R# b) -> x |> co) = ...
+(MC1) We must compulsorily unfold MkAge to a cast.
+      See Note [Compulsory newtype unfolding] in GHC.Types.Id.Make
 
-Getting better. But this isn't exactly what gets produced. This is because
-Coercible essentially has ~R# as a superclass, and superclasses get eagerly
-extracted during solving. So we get this:
+(MC2) We must compulsorily unfolding coerce on the rule LHS, yielding
+        forall a b (dict :: Coercible * a b).
+          map @a @b (\(x :: a) -> case dict of
+            MkCoercible (co :: a ~R# b) -> x |> co) = ...
 
-  forall a b (dict :: Coercible * a b).
-    case Coercible_SCSel @* @a @b dict of
-      _ [Dead] -> map @a @b (\(x :: a) -> case dict of
-                               MkCoercible (co :: a ~R# b) -> x |> co) = ...
-
-Unfortunately, this still abstracts over a Coercible dictionary. We really
-want it to abstract over the ~R# evidence. So, we have Desugar.unfold_coerce,
-which transforms the above to (see also Note [Desugaring coerce as cast] in
-Desugar)
-
-  forall a b (co :: a ~R# b).
-    let dict = MkCoercible @* @a @b co in
-    case Coercible_SCSel @* @a @b dict of
-      _ [Dead] -> map @a @b (\(x :: a) -> case dict of
-         MkCoercible (co :: a ~R# b) -> x |> co) = let dict = ... in ...
-
-Now, we need simpleOptExpr to fix this up. It does so by taking three
-separate actions:
+  Getting better. But this isn't exactly what gets produced. This is because
+  Coercible essentially has ~R# as a superclass, and superclasses get eagerly
+  extracted during solving. So we get this:
+
+    forall a b (dict :: Coercible * a b).
+      case Coercible_SCSel @* @a @b dict of
+        _ [Dead] -> map @a @b (\(x :: a) -> case dict of
+                                 MkCoercible (co :: a ~R# b) -> x |> co) = ...
+
+  Unfortunately, this still abstracts over a Coercible dictionary. We really
+  want it to abstract over the ~R# evidence. So, we have Desugar.unfold_coerce,
+  which transforms the above to
+  Desugar)
+
+    forall a b (co :: a ~R# b).
+      let dict = MkCoercible @* @a @b co in
+      case Coercible_SCSel @* @a @b dict of
+        _ [Dead] -> map @a @b (\(x :: a) -> case dict of
+           MkCoercible (co :: a ~R# b) -> x |> co) = let dict = ... in ...
+
+  See Note [Desugaring coerce as cast] in GHC.HsToCore
+
+(MC3) Now, we need simpleOptExpr to fix this up. It does so by taking three
+  separate actions:
   1. Inline certain non-recursive bindings. The choice whether to inline
      is made in simple_bind_pair. Note the rather specific check for
      MkCoercible in there.
@@ -858,6 +863,10 @@ separate actions:
      just packed and inline them. This is also done in simple_opt_expr's
      `go` function.
 
+(MC4) The map/coerce rule is the only compelling reason for having a RULE that
+  quantifies over a coercion variable, something that is otherwise Very Deeply
+  Suspicous.  See Note [Casts in the template] in GHC.Core.Rules. Ugh!
+
 This is all a fair amount of special-purpose hackery, but it's for
 a good cause. And it won't hurt other RULES and such that it comes across.
 


=====================================
testsuite/tests/simplCore/should_compile/T23209.hs
=====================================
@@ -0,0 +1,12 @@
+{-# LANGUAGE UnboxedTuples #-}
+{-# OPTIONS_GHC -O2 #-}
+
+-- This gave a Lint crash
+
+module T23209 where
+
+import T23209_Aux
+
+f a = let w = if a then Allocator (ArrayWriter s)
+                   else Allocator (ArrayWriter e)
+      in case combine w w of


=====================================
testsuite/tests/simplCore/should_compile/T23209_Aux.hs
=====================================
@@ -0,0 +1,19 @@
+{-# LANGUAGE UnboxedTuples #-}
+{-# OPTIONS_GHC -O #-}
+module T23209_Aux where
+
+newtype I = MkI { uI :: () -> () }
+newtype ArrayWriter = ArrayWriter (() -> I)
+data Allocator = Allocator !ArrayWriter
+
+combine :: Allocator -> Allocator -> (# () -> () #)
+combine (Allocator (ArrayWriter w1)) (Allocator (ArrayWriter w2)) =
+  (# \s -> id' (uI (w1 ()) (uI (w2 ()) s)) #)
+
+e, s :: () -> I
+e x = MkI id
+s x = MkI id
+{-# NOINLINE s #-}
+
+id' :: () -> ()
+id' x = x


=====================================
testsuite/tests/simplCore/should_compile/all.T
=====================================
@@ -508,4 +508,6 @@ test('T24014', normal, compile, ['-dcore-lint'])
 test('T24029', normal, compile, [''])
 test('T21348', normal, compile, ['-O'])
 test('T21917', normal, compile, ['-O -fkeep-auto-rules -ddump-rules'])
-
+test('T23209', [extra_files(['T23209_Aux.hs'])], multimod_compile, ['T23209', '-v0 -O'])
+test('T24229a', [ grep_errmsg(r'wfoo') ], compile, ['-O2 -ddump-simpl -dno-typeable-binds -dsuppress-all -dsuppress-uniques -dppr-cols=99999'])
+test('T24229b', [ grep_errmsg(r'wfoo') ], compile, ['-O2 -ddump-simpl -dno-typeable-binds -dsuppress-all -dsuppress-uniques -dppr-cols=99999'])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/401c02ed7974ecda4abfa78721f49b3c4c835446

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/401c02ed7974ecda4abfa78721f49b3c4c835446
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/20231130/975a1223/attachment-0001.html>


More information about the ghc-commits mailing list