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.