Simon Peyton Jones pushed to branch wip/T26115 at Glasgow Haskell Compiler / GHC Commits: 649ab08b by Simon Peyton Jones at 2025-06-20T15:28:28+01:00 Discard outer casts - - - - - f0dc94fc by Simon Peyton Jones at 2025-06-20T17:36:07+01:00 Nearly there - - - - - 8 changed files: - compiler/GHC/Core.hs - compiler/GHC/HsToCore/Binds.hs - + testsuite/tests/simplCore/should_compile/T26115.hs - + testsuite/tests/simplCore/should_compile/T26115.stderr - + testsuite/tests/simplCore/should_compile/T26116.hs - + testsuite/tests/simplCore/should_compile/T26116.stderr - + testsuite/tests/simplCore/should_compile/T26117.hs - testsuite/tests/simplCore/should_compile/all.T Changes: ===================================== compiler/GHC/Core.hs ===================================== @@ -39,7 +39,7 @@ module GHC.Core ( isId, cmpAltCon, cmpAlt, ltAlt, -- ** Simple 'Expr' access functions and predicates - bindersOf, bindersOfBinds, rhssOfBind, rhssOfAlts, + bindersOf, bindersOfBinds, rhssOfBind, rhssOfBinds, rhssOfAlts, foldBindersOfBindStrict, foldBindersOfBindsStrict, collectBinders, collectTyBinders, collectTyAndValBinders, collectNBinders, collectNValBinders_maybe, @@ -2154,6 +2154,11 @@ rhssOfBind :: Bind b -> [Expr b] rhssOfBind (NonRec _ rhs) = [rhs] rhssOfBind (Rec pairs) = [rhs | (_,rhs) <- pairs] +rhssOfBinds :: [Bind b] -> [Expr b] +rhssOfBinds [] = [] +rhssOfBinds (NonRec _ rhs : bs) = rhs : rhssOfBinds bs +rhssOfBinds (Rec pairs : bs) = map snd pairs ++ rhssOfBinds bs + rhssOfAlts :: [Alt b] -> [Expr b] rhssOfAlts alts = [e | Alt _ _ e <- alts] ===================================== compiler/GHC/HsToCore/Binds.hs ===================================== @@ -66,11 +66,11 @@ import GHC.Builtin.Types ( naturalTy, typeSymbolKind, charTy ) import GHC.Tc.Types.Evidence import GHC.Types.Id -import GHC.Types.Id.Info (IdDetails(..)) +import GHC.Types.Id.Info import GHC.Types.Name import GHC.Types.Var.Set import GHC.Types.Var.Env -import GHC.Types.Var( EvVar ) +import GHC.Types.Var( EvVar, mkLocalVar ) import GHC.Types.SrcLoc import GHC.Types.Basic import GHC.Types.Unique.Set( nonDetEltsUniqSet ) @@ -1141,7 +1141,7 @@ dsSpec poly_rhs (SpecPrag poly_id spec_co spec_inl) dsSpec poly_rhs (SpecPragE { spe_fn_nm = poly_nm , spe_fn_id = poly_id - , spe_inl = inl + , spe_inl = spec_inl , spe_bndrs = bndrs , spe_call = the_call }) -- SpecPragE case: See Note [Handling new-form SPECIALISE pragmas] in GHC.Tc.Gen.Sig @@ -1149,68 +1149,134 @@ dsSpec poly_rhs (SpecPragE { spe_fn_nm = poly_nm unsetWOptM Opt_WarnIdentities $ zapUnspecables $ dsLExpr the_call - ; dsSpec_help poly_nm poly_id poly_rhs inl bndrs ds_call } + ; dsSpec_help poly_nm poly_id poly_rhs spec_inl bndrs ds_call } dsSpec_help :: Name -> Id -> CoreExpr -- Function to specialise -> InlinePragma -> [Var] -> CoreExpr -> DsM (Maybe (OrdList (Id,CoreExpr), CoreRule)) -dsSpec_help poly_nm poly_id poly_rhs inl orig_bndrs ds_call - = do { - -- Simplify the (desugared) call; see wrinkle (SP1) - -- in Note [Desugaring new-form SPECIALISE pragmas] - ; dflags <- getDynFlags - ; let simpl_opts = initSimpleOpts dflags - core_call = simpleOptExprNoInline simpl_opts ds_call - - ; case decomposeCall poly_id core_call of { - Nothing -> do { diagnosticDs (DsRuleLhsTooComplicated ds_call core_call) - ; return Nothing } ; - +dsSpec_help poly_nm poly_id poly_rhs spec_inl orig_bndrs ds_call + = do { mb_call_info <- decomposeCall poly_id ds_call + ; case mb_call_info of { + Nothing -> return Nothing ; Just (binds, rule_lhs_args) -> - do { let locals = mkVarSet orig_bndrs `extendVarSetList` bindersOfBinds binds + do { dflags <- getDynFlags + ; this_mod <- getModule + ; uniq <- newUnique + ; let locals = mkVarSet orig_bndrs `extendVarSetList` bindersOfBinds binds is_local :: Var -> Bool is_local v = v `elemVarSet` locals rule_bndrs = scopedSort (exprsSomeFreeVarsList is_local rule_lhs_args) - rn_binds = getRenamings orig_bndrs binds rule_bndrs + rn_binds = getRenamings orig_bndrs binds rule_bndrs - spec_binds = pickSpecBinds is_local (mkVarSet rule_bndrs) - (rn_binds ++ binds) + spec_binds = pickSpecBinds is_local (mkVarSet rule_bndrs) binds + -- Make spec_bndrs, the variables to pass to the specialised + -- function, by filtering out the rule_bndrs that aren't needed spec_binds_bndr_set = mkVarSet (bindersOfBinds spec_binds) + `minusVarSet` exprsFreeVars (rhssOfBinds rn_binds) spec_bndrs = filterOut (`elemVarSet` spec_binds_bndr_set) rule_bndrs - mk_spec_body fn_body = mkLets spec_binds $ + mk_spec_body fn_body = mkLets (rn_binds ++ spec_binds) $ mkApps fn_body rule_lhs_args -- ToDo: not mkCoreApps! That uses exprType on fun which -- fails in specUnfolding, sigh + poly_name = idName poly_id + spec_occ = mkSpecOcc (getOccName poly_name) + spec_name = mkInternalName uniq spec_occ (getSrcSpan poly_name) + id_inl = idInlinePragma poly_id + + simpl_opts = initSimpleOpts dflags + fn_unf = realIdUnfolding poly_id + spec_unf = specUnfolding simpl_opts spec_bndrs mk_spec_body rule_lhs_args fn_unf + spec_info = vanillaIdInfo + `setInlinePragInfo` specFunInlinePrag poly_id id_inl spec_inl + `setUnfoldingInfo` spec_unf + spec_id = mkLocalVar (idDetails poly_id) spec_name ManyTy spec_ty spec_info + -- Specialised binding is toplevel, hence Many. + + -- The RULE looks like + -- RULE "USPEC" forall rule_bndrs. f rule_lhs_args = $sf spec_bndrs + -- The specialised function looks like + -- $sf spec_bndrs = mk_spec_body <f's original rhs> + -- We also use mk_spec_body to specialise the methods in f's stable unfolding + -- NB: spec_bindrs is a subset of rule_bndrs + rule = mkSpecRule dflags this_mod False rule_act (text "USPEC") + poly_id rule_bndrs rule_lhs_args + (mkVarApps (Var spec_id) spec_bndrs) + + rule_ty = exprType (mkApps (Var poly_id) rule_lhs_args) + spec_ty = mkLamTypes spec_bndrs rule_ty + spec_rhs = mkLams spec_bndrs (mk_spec_body poly_rhs) + + result = (unitOL (spec_id, spec_rhs), rule) + -- NB: do *not* use makeCorePair on (spec_id,spec_rhs), because + -- makeCorePair overwrites the unfolding, which we have + -- just created using specUnfolding ; tracePm "dsSpec(new route)" $ vcat [ text "poly_id" <+> ppr poly_id , text "unfolding" <+> ppr (realIdUnfolding poly_id) , text "orig_bndrs" <+> pprCoreBinders orig_bndrs + , text "locals" <+> ppr locals + , text "fvs" <+> ppr (exprsSomeFreeVarsList is_local rule_lhs_args) , text "ds_call" <+> ppr ds_call - , text "core_call" <+> ppr core_call , text "binds" <+> ppr binds - , text "rule_bndrs" <+> ppr rule_bndrs , text "rule_lhs_args" <+> ppr rule_lhs_args + , text "rule_bndrs" <+> ppr rule_bndrs , text "spec_bndrs" <+> ppr spec_bndrs , text "rn_binds" <+> ppr rn_binds , text "spec_binds" <+> ppr spec_binds ] - ; finishSpecPrag poly_nm poly_rhs - rule_bndrs poly_id rule_lhs_args - spec_bndrs mk_spec_body inl } } } + ; dsWarnOrphanRule rule + + ; case checkUselessSpecPrag poly_id rule_lhs_args spec_bndrs + no_act_spec spec_inl rule_act of + Nothing -> return (Just result) + + Just reason -> do { diagnosticDs $ DsUselessSpecialisePragma poly_nm is_dfun reason + ; if uselessSpecialisePragmaKeepAnyway reason + then return (Just result) + else return Nothing } } } } + + where + -- See Note [Activation pragmas for SPECIALISE] + -- no_act_spec is True if the user didn't write an explicit + -- phase specification in the SPECIALISE pragma + id_inl = idInlinePragma poly_id + inl_prag_act = inlinePragmaActivation id_inl + spec_prag_act = inlinePragmaActivation spec_inl + no_act_spec = case inlinePragmaSpec spec_inl of + NoInline _ -> isNeverActive spec_prag_act + Opaque _ -> isNeverActive spec_prag_act + _ -> isAlwaysActive spec_prag_act + rule_act | no_act_spec = inl_prag_act -- Inherit + | otherwise = spec_prag_act -- Specified by user + + is_dfun = case idDetails poly_id of + DFunId {} -> True + _ -> False decomposeCall :: Id -> CoreExpr - -> Maybe ( [CoreBind] - , [CoreExpr] ) -- Args of the call -decomposeCall poly_id binds - = go [] binds + -> DsM (Maybe ([CoreBind], [CoreExpr] )) +-- Decompose the call into (let <binds> in f <args>) +decomposeCall poly_id ds_call + = do { -- Simplify the (desugared) call; see wrinkle (SP1) + -- in Note [Desugaring new-form SPECIALISE pragmas] + ; dflags <- getDynFlags + ; let simpl_opts = initSimpleOpts dflags + core_call = simpleOptExprNoInline simpl_opts ds_call + + ; case go [] core_call of { + Nothing -> do { diagnosticDs (DsRuleLhsTooComplicated ds_call core_call) + ; return Nothing } ; + Just result -> return (Just result) } } where - go acc (Let bind body) - = go (bind:acc) body + go :: [CoreBind] -> CoreExpr -> Maybe ([CoreBind],[CoreExpr]) + go acc (Let bind body) = go (bind:acc) body + go acc (Cast e _) = go acc e -- Discard outer casts + -- ToDo: document this go acc e | (Var fun, args) <- collectArgs e = assertPpr (fun == poly_id) (ppr fun $$ ppr poly_id) $ @@ -1218,6 +1284,40 @@ decomposeCall poly_id binds | otherwise = Nothing + -- Is this SPECIALISE pragma useless? +checkUselessSpecPrag :: Id -> [CoreExpr] + -> [Var] -> Bool -> InlinePragma -> Activation + -> Maybe UselessSpecialisePragmaReason +checkUselessSpecPrag poly_id rule_lhs_args + spec_bndrs no_act_spec spec_inl rule_act + | isJust (isClassOpId_maybe poly_id) + -- There is no point in trying to specialise a class op + -- Moreover, classops don't (currently) have an inl_sat arity set + -- (it would be Just 0) and that in turn makes makeCorePair bleat + = Just UselessSpecialiseForClassMethodSelector + + | no_act_spec, isNeverActive rule_act + -- Function is NOINLINE, and the specialisation inherits that + -- See Note [Activation pragmas for SPECIALISE] + = Just UselessSpecialiseForNoInlineFunction + + | all is_nop_arg rule_lhs_args, not (isInlinePragma spec_inl) + -- The specialisation does nothing. + -- But don't complain if it is SPECIALISE INLINE (#4444) + = Just UselessSpecialiseNoSpecialisation + + | otherwise + = Nothing + + where + is_nop_arg (Type {}) = True + is_nop_arg (Coercion {}) = True + is_nop_arg (Cast e _) = is_nop_arg e + is_nop_arg (Tick _ e) = is_nop_arg e + is_nop_arg (Var x) = x `elem` spec_bndrs + is_nop_arg _ = False + + getRenamings :: [Var] -> [CoreBind] -- orig_bndrs and bindings -> [Var] -- rule_bndrs -> [CoreBind] -- Binds some of the orig_bndrs to a rule_bndr @@ -1238,8 +1338,8 @@ getRenamings orig_bndrs binds rule_bndrs go (bind : binds) | NonRec b rhs <- bind , Just (v, mco) <- getCastedVar rhs - , Just e <- lookupVarEnv renamings v - = extendVarEnv renamings b (mkCastMCo e (mkSymMCo mco)) + , Just e <- lookupVarEnv renamings b + = extendVarEnv renamings v (mkCastMCo e (mkSymMCo mco)) | otherwise = renamings where @@ -1256,201 +1356,12 @@ pickSpecBinds is_local known_bndrs (bind:binds) where keep_me rhs = isEmptyVarSet (exprSomeFreeVars bad_var rhs) bad_var v = is_local v && not (v `elemVarSet` known_bndrs) -{- -grabSpecBinds :: (Var -> Bool) -> VarSet -> [CoreBind] - -> ([CoreBind], [CoreBind]) -grabSpecBinds is_local rule_bndrs rev_binds - = (reverse rename_binds, spec_binds) - where - (known_bndrs, (rename_binds, other_binds)) - = get_renamings rule_bndrs ([],[]) rev_binds - spec_binds = pick_spec_binds known_bndrs other_binds - - ------------------------ - get_renamings :: VarSet -- Variables bound by a successful match on the call - -> ([CoreBind],[CoreBind]) -- Accumulating parameter, in order - -> [CoreBind] -- Reversed, innermost first - -> ( VarSet - , ([CoreBind] -- Renamings, in order - , [CoreBind])) -- Other bindings, in order - get_renamings bndrs acc [] = (bndrs, acc) - - get_renamings bndrs (rn_binds, other_binds) (bind : binds) - | NonRec d r <- bind - , d `elemVarSet` bndrs - , Just (v, mco) <- getCastedVar r - , is_local v - , let flipped_bind = NonRec v (mkCastMCo (Var d) (mkSymMCo mco)) - = get_renamings (bndrs `extendVarSet` v) - (flipped_bind:rn_binds, other_binds) - binds - | otherwise - = get_renamings bndrs - (rn_binds, bind:other_binds) - binds - - ------------------------ - pick_spec_binds :: VarSet -> [CoreBind] -> [CoreBind] - pick_spec_binds _ [] = [] - pick_spec_binds known_bndrs (bind:binds) - | all keep_me (rhssOfBind bind) - , let known_bndrs' = known_bndrs `extendVarSetList` bindersOf bind - = bind : pick_spec_binds known_bndrs' binds - | otherwise - = pick_spec_binds known_bndrs binds - where - keep_me rhs = isEmptyVarSet (exprSomeFreeVars bad_var rhs) - bad_var v = is_local v && not (v `elemVarSet` known_bndrs) --} getCastedVar :: CoreExpr -> Maybe (Var, MCoercionR) getCastedVar (Var v) = Just (v, MRefl) getCastedVar (Cast (Var v) co) = Just (v, MCo co) getCastedVar _ = Nothing -{- - where - go :: VarSet -- Quantified variables, or dependencies thereof - -> [CoreBind] -- Reversed list of constant evidence bindings - -> CoreExpr - -> Maybe (IdSet, [CoreBind], [CoreExpr]) - go qevs acc (Cast e _) - = go qevs acc e - go qevs acc (Let bind e) - | not (all (isPredTy . varType) bndrs) - -- A normal 'let' is too complicated - -- But we definitely include quantified constraints - -- E.g. this is fine: let (d :: forall a. Eq a => Eq (f a) = d2) - = Nothing - - -- (a) (1) in Note [prepareSpecLHS] - | all (transfer_to_spec_rhs qevs) $ - rhssOfBind bind -- One of the `const_binds` - = go qevs (bind:acc) e - - -- (a) (2) in Note [prepareSpecLHS] - | otherwise - = go (qevs `extendVarSetList` bndrs) acc e - where - bndrs = bindersOf bind - - go qevs acc e - | (Var fun, args) <- collectArgs e - -- (a) (3) in Note [prepareSpecLHS] - = assertPpr (fun == poly_id) (ppr fun $$ ppr poly_id) $ - Just (qevs, reverse acc, args) - | otherwise - = Nothing - - transfer_to_spec_rhs qevs rhs - where - is_quant_id v = isId v && v `elemVarSet` qevs - -- See (a) (2) in Note [prepareSpecLHS] --} - -finishSpecPrag :: Name -> CoreExpr -- RHS to specialise - -> [Var] -> Id -> [CoreExpr] -- RULE LHS pattern - -> [Var] -> (CoreExpr -> CoreExpr) -> InlinePragma -- Specialised form - -> DsM (Maybe (OrdList (Id,CoreExpr), CoreRule)) -finishSpecPrag poly_nm poly_rhs rule_bndrs poly_id rule_lhs_args - spec_bndrs mk_spec_body spec_inl - | Just reason <- mb_useless - = do { diagnosticDs $ DsUselessSpecialisePragma poly_nm is_dfun reason - ; if uselessSpecialisePragmaKeepAnyway reason - then Just <$> finish_prag - else return Nothing } - - | otherwise - = Just <$> finish_prag - - where - -- The RULE looks like - -- RULE "USPEC" forall rule_bndrs. f rule_lhs_args = $sf spec_bndrs - -- The specialised function looks like - -- $sf spec_bndrs = mk_spec_body <f's original rhs> - -- We also use mk_spec_body to specialise the methods in f's stable unfolding - -- NB: spec_bindrs is a subset of rule_bndrs - finish_prag - = do { this_mod <- getModule - ; uniq <- newUnique - ; dflags <- getDynFlags - ; let poly_name = idName poly_id - spec_occ = mkSpecOcc (getOccName poly_name) - spec_name = mkInternalName uniq spec_occ (getSrcSpan poly_name) - - simpl_opts = initSimpleOpts dflags - fn_unf = realIdUnfolding poly_id - spec_unf = specUnfolding simpl_opts spec_bndrs mk_spec_body rule_lhs_args fn_unf - spec_id = mkLocalId spec_name ManyTy spec_ty - -- Specialised binding is toplevel, hence Many. - `setInlinePragma` specFunInlinePrag poly_id id_inl spec_inl - `setIdUnfolding` spec_unf - - rule = mkSpecRule dflags this_mod False rule_act (text "USPEC") - poly_id rule_bndrs rule_lhs_args - (mkVarApps (Var spec_id) spec_bndrs) - - rule_ty = exprType (mkApps (Var poly_id) rule_lhs_args) - spec_ty = mkLamTypes spec_bndrs rule_ty - spec_rhs = mkLams spec_bndrs (mk_spec_body poly_rhs) - - ; dsWarnOrphanRule rule - - ; tracePm "dsSpec" (vcat - [ text "fun:" <+> ppr poly_id - , text "spec_bndrs:" <+> ppr spec_bndrs - , text "rule_lhs_args:" <+> ppr rule_lhs_args ]) - ; return (unitOL (spec_id, spec_rhs), rule) } - -- NB: do *not* use makeCorePair on (spec_id,spec_rhs), because - -- makeCorePair overwrites the unfolding, which we have - -- just created using specUnfolding - - -- Is this SPECIALISE pragma useless? - mb_useless :: Maybe UselessSpecialisePragmaReason - mb_useless - | isJust (isClassOpId_maybe poly_id) - -- There is no point in trying to specialise a class op - -- Moreover, classops don't (currently) have an inl_sat arity set - -- (it would be Just 0) and that in turn makes makeCorePair bleat - = Just UselessSpecialiseForClassMethodSelector - - | no_act_spec, isNeverActive rule_act - -- Function is NOINLINE, and the specialisation inherits that - -- See Note [Activation pragmas for SPECIALISE] - = Just UselessSpecialiseForNoInlineFunction - - | all is_nop_arg rule_lhs_args, not (isInlinePragma spec_inl) - -- The specialisation does nothing. - -- But don't complain if it is SPECIALISE INLINE (#4444) - = Just UselessSpecialiseNoSpecialisation - - | otherwise - = Nothing - - -- See Note [Activation pragmas for SPECIALISE] - -- no_act_spec is True if the user didn't write an explicit - -- phase specification in the SPECIALISE pragma - id_inl = idInlinePragma poly_id - inl_prag_act = inlinePragmaActivation id_inl - spec_prag_act = inlinePragmaActivation spec_inl - no_act_spec = case inlinePragmaSpec spec_inl of - NoInline _ -> isNeverActive spec_prag_act - Opaque _ -> isNeverActive spec_prag_act - _ -> isAlwaysActive spec_prag_act - rule_act | no_act_spec = inl_prag_act -- Inherit - | otherwise = spec_prag_act -- Specified by user - - is_nop_arg (Type {}) = True - is_nop_arg (Coercion {}) = True - is_nop_arg (Cast e _) = is_nop_arg e - is_nop_arg (Tick _ e) = is_nop_arg e - is_nop_arg (Var x) = x `elem` spec_bndrs - is_nop_arg _ = False - - is_dfun = case idDetails poly_id of - DFunId {} -> True - _ -> False - specFunInlinePrag :: Id -> InlinePragma -> InlinePragma -> InlinePragma -- See Note [Activation pragmas for SPECIALISE] ===================================== testsuite/tests/simplCore/should_compile/T26115.hs ===================================== @@ -0,0 +1,10 @@ +module T26115 where + +class C a b where { op1, op2 :: a -> b -> Bool + ; op2 = op1 } + +instance C Bool b where { op1 _ _ = True } + +instance C p q => C [p] q where + op1 [x] y = op1 x y + {-# SPECIALISE instance C [Bool] b #-} ===================================== testsuite/tests/simplCore/should_compile/T26115.stderr ===================================== @@ -0,0 +1,6 @@ +[GblId[DFunId], + Unf=DFun: \ (@b_awW) -> +[GblId[DFunId], + Unf=DFun: \ (@b_aBU) -> +[GblId[DFunId], + Unf=DFun: \ (@p_awR) (@q_awS) (v_B1 :: C p_awR q_awS) -> ===================================== testsuite/tests/simplCore/should_compile/T26116.hs ===================================== @@ -0,0 +1,18 @@ +{-# LANGUAGE QuantifiedConstraints #-} +{-# OPTIONS_GHC -fno-warn-missing-methods #-} + +module T26116 where + +data T a = MkT a + +instance Eq (T a) where + x == y = True + +class (forall b. Eq (T b)) => D a where { dop :: a -> a } + +class C f a where { op1,op2 :: f a -> Int } + +instance (Eq (f a), D a) => C f a where + op1 x | x==x = 3 + | otherwise = 4 + {-# SPECIALISE instance D a => C T a #-} ===================================== testsuite/tests/simplCore/should_compile/T26116.stderr ===================================== @@ -0,0 +1,12 @@ + +==================== Tidy Core rules ==================== +"USPEC $cop1 @T @_" + forall (@a) ($dD :: D a) ($dEq :: Eq (T a)). + $fCTYPEfa_$cop1 @T @a $dEq $dD + = \ _ [Occ=Dead] -> I# 3# +"USPEC $fCTYPEfa @T @_" + forall (@a) ($dD :: D a) ($dEq :: Eq (T a)). + $fCTYPEfa @T @a $dEq $dD + = $fCTYPEfa_$s$fCTYPEfa @a $dD + + ===================================== testsuite/tests/simplCore/should_compile/T26117.hs ===================================== @@ -0,0 +1,15 @@ +{-# LANGUAGE UndecidableInstances, TypeFamilies #-} + +module T26117 where + +type family F a +type instance F Int = Bool + +class Eq (F a) => D a b where { dop1, dop2 :: a -> b -> b } + +class C a b where { op1,op2 :: F a -> a -> b -> Int } + +instance (Eq (F a), D a b) => C a [b] where + op1 x _ _ | x==x = 3 + | otherwise = 4 + {-# SPECIALISE instance D Int b => C Int [b] #-} ===================================== testsuite/tests/simplCore/should_compile/all.T ===================================== @@ -548,3 +548,6 @@ test('T25965', normal, compile, ['-O']) test('T25703', [grep_errmsg(r'SPEC')], compile, ['-O -fpolymorphic-specialisation -ddump-rule-firings']) test('T25703a', [grep_errmsg(r'SPEC')], compile, ['-O -fpolymorphic-specialisation -ddump-rule-firings']) +test('T26115', [grep_errmsg(r'DFun')], compile, ['-O -ddump-simpl']) +test('T26116', normal, compile, ['-O -ddump-rules']) + View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d765a87164bdffd2a6494108b3fbcf1... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/d765a87164bdffd2a6494108b3fbcf1... You're receiving this email because of your account on gitlab.haskell.org.