Simon Peyton Jones pushed to branch wip/andreask/spec_tyfams at Glasgow Haskell Compiler / GHC Commits: d95dd951 by Simon Peyton Jones at 2025-07-06T23:17:26+01:00 Accept change to T23398 - - - - - 2 changed files: - testsuite/tests/dmdanal/should_compile/T23398.hs - testsuite/tests/dmdanal/should_compile/T23398.stderr Changes: ===================================== testsuite/tests/dmdanal/should_compile/T23398.hs ===================================== @@ -6,10 +6,11 @@ type PairDict a = (Eq a, Show a) foo :: PairDict a => a -> a -> String foo x y | x==y = show x | otherwise = show y - --- In worker/wrapper we'd like to unbox the pair --- but not (Eq a) and (Show a) +-- In worker/wrapper we don't want to unbox PairDict +-- See (DNB1) Note [Do not unbox class dictionaries] in GHC.Core.Opt.DmdAnal bar :: (a ~ b, Show a) => Int -> a -> (b, String) bar 0 x = (x, show x) bar n x = bar (n-1) x +-- ...but we do want to unbox the (a~b) +-- see (DNB2) in the same Note ===================================== testsuite/tests/dmdanal/should_compile/T23398.stderr ===================================== @@ -1,42 +1,35 @@ ==================== Tidy Core ==================== Result size of Tidy Core - = {terms: 76, types: 117, coercions: 4, joins: 0/0} + = {terms: 65, types: 107, coercions: 4, joins: 0/0} --- RHS size: {terms: 18, types: 11, coercions: 0, joins: 0/0} -T23398.$wfoo [InlPrag=[2]] - :: forall a. (Eq a, Show a) => a -> a -> String -[GblId[StrictWorker([!, !])], - Arity=4, - Str=<L><L>, - Unf=Unf{Src=<vanilla>, TopLvl=True, - Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=IF_ARGS [30 60 0 0] 120 0}] -T23398.$wfoo - = \ (@a) (ww :: Eq a) (ww1 :: Show a) (eta :: a) (eta1 :: a) -> - case == @a ww eta eta1 of { - False -> show @a ww1 eta1; - True -> show @a ww1 eta - } - --- RHS size: {terms: 12, types: 12, coercions: 0, joins: 0/0} -foo [InlPrag=[2]] :: forall a. PairDict a => a -> a -> String +-- RHS size: {terms: 20, types: 21, coercions: 0, joins: 0/0} +foo :: forall a. PairDict a => a -> a -> String [GblId, Arity=3, - Str=<L><L>, - Unf=Unf{Src=StableSystem, TopLvl=True, + Str=<L><L>, + Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, - Guidance=ALWAYS_IF(arity=3,unsat_ok=True,boring_ok=False) - Tmpl= \ (@a) - ($dCTuple2 [Occ=Once1!] :: PairDict a) - (eta [Occ=Once1] :: a) - (eta1 [Occ=Once1] :: a) -> - case $dCTuple2 of { (ww [Occ=Once1], ww1 [Occ=Once1]) -> - T23398.$wfoo @a ww ww1 eta eta1 - }}] + Guidance=IF_ARGS [90 0 0] 180 0}] foo = \ (@a) ($dCTuple2 :: PairDict a) (eta :: a) (eta1 :: a) -> - case $dCTuple2 of { (ww, ww1) -> T23398.$wfoo @a ww ww1 eta eta1 } + case == + @a + (GHC.Internal.Classes.$p0CTuple2 @(Eq a) @(Show a) $dCTuple2) + eta + eta1 + of { + False -> + show + @a + (GHC.Internal.Classes.$p1CTuple2 @(Eq a) @(Show a) $dCTuple2) + eta1; + True -> + show + @a + (GHC.Internal.Classes.$p1CTuple2 @(Eq a) @(Show a) $dCTuple2) + eta + } Rec { -- RHS size: {terms: 21, types: 19, coercions: 3, joins: 0/0} View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d95dd9514120408be196786e91d6b4f5... -- View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/d95dd9514120408be196786e91d6b4f5... You're receiving this email because of your account on gitlab.haskell.org.