[Git][ghc/ghc][wip/nested-cpr-2019] Don't store CPR info for data structures that are NOINLINE
Sebastian Graf
gitlab at gitlab.haskell.org
Mon Sep 28 15:46:18 UTC 2020
Sebastian Graf pushed to branch wip/nested-cpr-2019 at Glasgow Haskell Compiler / GHC
Commits:
dac38be5 by Sebastian Graf at 2020-09-28T17:46:09+02:00
Don't store CPR info for data structures that are NOINLINE
- - - - -
6 changed files:
- compiler/GHC/Core/Opt/CprAnal.hs
- testsuite/tests/numeric/should_compile/T14465.stdout
- testsuite/tests/simplCore/should_compile/T13143.stderr
- testsuite/tests/simplCore/should_compile/T17673.stderr
- testsuite/tests/simplCore/should_compile/T7360.stderr
- testsuite/tests/stranal/sigs/T18086.stderr
Changes:
=====================================
compiler/GHC/Core/Opt/CprAnal.hs
=====================================
@@ -25,7 +25,7 @@ import GHC.Types.Basic
import GHC.Core.DataCon
import GHC.Types.Id
import GHC.Types.Id.Info
-import GHC.Core.Utils ( dumpIdInfoOfProgram )
+import GHC.Core.Utils (exprIsHNF, dumpIdInfoOfProgram )
import GHC.Core.TyCon
import GHC.Core.Type
import GHC.Core.Multiplicity
@@ -346,6 +346,8 @@ cprAnalBind top_lvl env widening args id rhs
rhs_ty'
-- See Note [CPR for thunks]
| stays_thunk = trimCprTy rhs_ty
+ -- See Note [CPR for expandable unfoldings]
+ | stays_data = topCprType
-- See Note [CPR for sum types]
| returns_sum = trimCprTy rhs_ty
| otherwise = rhs_ty
@@ -358,8 +360,10 @@ cprAnalBind top_lvl env widening args id rhs
-- See Note [CPR for thunks]
stays_thunk = is_thunk && not_strict
- is_thunk = idArity id == 0 && not (isJoinId id)
+ is_thunk = not (exprIsHNF rhs) && not (isJoinId id)
not_strict = not (isStrictDmd (idDemandInfo id))
+ -- See Note [CPR for expandable unfoldings]
+ stays_data = not is_thunk && idArity id == 0 && not_strict
-- See Note [CPR for sum types]
(_, ret_ty) = splitPiTys (idType id)
not_a_prod = isNothing (deepSplitProductType_maybe (ae_fam_envs env) ret_ty)
@@ -764,7 +768,13 @@ instead we keep on cprAnal'ing through *expandable* unfoldings for these arity
In practice, GHC generates a lot of (nested) TyCon and KindRep bindings, one
for each data declaration. It's wasteful to attach CPR signatures to each of
-them (and intractable in case of Nested CPR).
+them (and intractable in case of Nested CPR.
+
+Rather than discarding CPR signatures for expandable data structures only, we
+also do so for non-expandable things ('stays_data'). The reason is that if a
+data structure has no unfolding (or if the user said NOINLINE), then we don't
+want to store CPR signatures. The generated KindReps fall into this category, so
+this is really a mandatory special case.
Also we don't need to analyse RHSs of expandable bindings: The CPR signature of
the binding is never consulted and there may not be let or case expressions
=====================================
testsuite/tests/numeric/should_compile/T14465.stdout
=====================================
@@ -55,7 +55,6 @@ M.minusOne1 = 1
-- RHS size: {terms: 11, types: 4, coercions: 0, joins: 0/0}
minusOne :: Natural
[GblId,
- Cpr=*1(#),
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False,
WorkFree=True, Expandable=False, Guidance=IF_ARGS [] 40 0}]
minusOne
=====================================
testsuite/tests/simplCore/should_compile/T13143.stderr
=====================================
@@ -33,7 +33,6 @@ T13143.$trModule4 = "main"#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
T13143.$trModule3 :: GHC.Types.TrName
[GblId,
- Cpr=#c1(#),
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
T13143.$trModule3 = GHC.Types.TrNameS T13143.$trModule4
@@ -48,7 +47,6 @@ T13143.$trModule2 = "T13143"#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
T13143.$trModule1 :: GHC.Types.TrName
[GblId,
- Cpr=#c1(#),
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
T13143.$trModule1 = GHC.Types.TrNameS T13143.$trModule2
@@ -56,7 +54,6 @@ T13143.$trModule1 = GHC.Types.TrNameS T13143.$trModule2
-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
T13143.$trModule :: GHC.Types.Module
[GblId,
- Cpr=#c1(#c1(#), #c1(#)),
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
T13143.$trModule
=====================================
testsuite/tests/simplCore/should_compile/T17673.stderr
=====================================
@@ -1,6 +1,6 @@
==================== Tidy Core ====================
-Result size of Tidy Core = {terms: 56, types: 67, coercions: 5, joins: 0/0}
+Result size of Tidy Core = {terms: 55, types: 82, coercions: 6, joins: 0/0}
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
T17673.$trModule4 :: GHC.Prim.Addr#
@@ -9,7 +9,7 @@ T17673.$trModule4 = "main"#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
T17673.$trModule3 :: GHC.Types.TrName
-[GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}]
+[GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
T17673.$trModule3 = GHC.Types.TrNameS T17673.$trModule4
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
@@ -19,48 +19,45 @@ T17673.$trModule2 = "T17673"#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
T17673.$trModule1 :: GHC.Types.TrName
-[GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 20}]
+[GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
T17673.$trModule1 = GHC.Types.TrNameS T17673.$trModule2
-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
T17673.$trModule :: GHC.Types.Module
-[GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 30}]
+[GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
T17673.$trModule = GHC.Types.Module T17673.$trModule3 T17673.$trModule1
--- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
-lvl :: Int
-[GblId, Unf=OtherCon []]
-lvl = GHC.Types.I# 1#
-
Rec {
--- RHS size: {terms: 27, types: 31, coercions: 0, joins: 0/0}
-T17673.$wfacIO [InlPrag=NOINLINE, Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.State# GHC.Prim.RealWorld -> (# GHC.Prim.State# GHC.Prim.RealWorld, Int #)
+-- RHS size: {terms: 23, types: 29, coercions: 0, joins: 0/0}
+T17673.$wfacIO [InlPrag=NOINLINE, Occ=LoopBreaker] :: GHC.Prim.Int# -> GHC.Prim.State# GHC.Prim.RealWorld -> (# GHC.Prim.State# GHC.Prim.RealWorld, GHC.Prim.Int# #)
[GblId, Arity=2, Str=<L,U><L,U>, Unf=OtherCon []]
T17673.$wfacIO
= \ (ww :: GHC.Prim.Int#) (w :: GHC.Prim.State# GHC.Prim.RealWorld) ->
case GHC.Prim.<# ww 2# of {
- __DEFAULT -> case T17673.$wfacIO (GHC.Prim.-# ww 1#) w of { (# ipv, ipv1 #) -> (# ipv, case ipv1 of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.*# ww y) } #) };
- 1# -> (# w, lvl #)
+ __DEFAULT -> case T17673.$wfacIO (GHC.Prim.-# ww 1#) w of { (# ww2, ww3 #) -> (# ww2, GHC.Prim.*# ww ww3 #) };
+ 1# -> (# w, 1# #)
}
end Rec }
--- RHS size: {terms: 8, types: 5, coercions: 0, joins: 0/0}
-T17673.facIO1 [InlPrag=NOUSERINLINE[-1]] :: Int -> GHC.Prim.State# GHC.Prim.RealWorld -> (# GHC.Prim.State# GHC.Prim.RealWorld, Int #)
+-- RHS size: {terms: 14, types: 23, coercions: 0, joins: 0/0}
+T17673.facIO1 [InlPrag=NOUSERINLINE[final]] :: Int -> GHC.Prim.State# GHC.Prim.RealWorld -> (# GHC.Prim.State# GHC.Prim.RealWorld, Int #)
[GblId,
Arity=2,
Str=<S,1*U(U)><L,U>,
+ Cpr=*c1(*, #c1(#)),
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False)
- Tmpl= \ (w [Occ=Once!] :: Int) (w1 [Occ=Once] :: GHC.Prim.State# GHC.Prim.RealWorld) -> case w of { GHC.Types.I# ww1 [Occ=Once] -> T17673.$wfacIO ww1 w1 }}]
-T17673.facIO1 = \ (w :: Int) (w1 :: GHC.Prim.State# GHC.Prim.RealWorld) -> case w of { GHC.Types.I# ww1 -> T17673.$wfacIO ww1 w1 }
+ Tmpl= \ (w [Occ=Once1!] :: Int) (w1 [Occ=Once1] :: GHC.Prim.State# GHC.Prim.RealWorld) -> case w of { GHC.Types.I# ww1 [Occ=Once1] -> case T17673.$wfacIO ww1 w1 of { (# ww3 [Occ=Once1], ww4 [Occ=Once1] #) -> (# ww3, GHC.Types.I# ww4 #) } }}]
+T17673.facIO1 = \ (w :: Int) (w1 :: GHC.Prim.State# GHC.Prim.RealWorld) -> case w of { GHC.Types.I# ww1 -> case T17673.$wfacIO ww1 w1 of { (# ww3, ww4 #) -> (# ww3, GHC.Types.I# ww4 #) } }
--- RHS size: {terms: 1, types: 0, coercions: 5, joins: 0/0}
-facIO [InlPrag=NOUSERINLINE[-1]] :: Int -> IO Int
+-- RHS size: {terms: 1, types: 0, coercions: 6, joins: 0/0}
+facIO [InlPrag=NOUSERINLINE[final]] :: Int -> IO Int
[GblId,
Arity=2,
Str=<S,1*U(U)><L,U>,
+ Cpr=*c1(*, #c1(#)),
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)
- Tmpl= T17673.facIO1 `cast` (<Int>_R ->_R Sym (GHC.Types.N:IO[0] <Int>_R) :: (Int -> GHC.Prim.State# GHC.Prim.RealWorld -> (# GHC.Prim.State# GHC.Prim.RealWorld, Int #)) ~R# (Int -> IO Int))}]
-facIO = T17673.facIO1 `cast` (<Int>_R ->_R Sym (GHC.Types.N:IO[0] <Int>_R) :: (Int -> GHC.Prim.State# GHC.Prim.RealWorld -> (# GHC.Prim.State# GHC.Prim.RealWorld, Int #)) ~R# (Int -> IO Int))
+ Tmpl= T17673.facIO1 `cast` (<Int>_R # <'Many>_N ->_R Sym (GHC.Types.N:IO[0] <Int>_R) :: (Int -> GHC.Prim.State# GHC.Prim.RealWorld -> (# GHC.Prim.State# GHC.Prim.RealWorld, Int #)) ~R# (Int -> IO Int))}]
+facIO = T17673.facIO1 `cast` (<Int>_R # <'Many>_N ->_R Sym (GHC.Types.N:IO[0] <Int>_R) :: (Int -> GHC.Prim.State# GHC.Prim.RealWorld -> (# GHC.Prim.State# GHC.Prim.RealWorld, Int #)) ~R# (Int -> IO Int))
=====================================
testsuite/tests/simplCore/should_compile/T7360.stderr
=====================================
@@ -92,9 +92,7 @@ T7360.$trModule
-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0}
$krep :: GHC.Types.KindRep
-[GblId,
- Cpr=#c1(#c1(#, #, #c1(#c1(#), #c1(#)), #c1(#), #, #c5(*)), *),
- Unf=OtherCon []]
+[GblId, Unf=OtherCon []]
$krep
= GHC.Types.KindRepTyConApp
GHC.Types.$tcInt (GHC.Types.[] @GHC.Types.KindRep)
@@ -129,9 +127,7 @@ T7360.$tcFoo
-- RHS size: {terms: 3, types: 1, coercions: 0, joins: 0/0}
T7360.$tc'Foo4 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep
-[GblId,
- Cpr=#c1(#c1(#, #, #c1(#c1(#), #c1(#)), #c1(#), #, #c5(*)), *),
- Unf=OtherCon []]
+[GblId, Unf=OtherCon []]
T7360.$tc'Foo4
= GHC.Types.KindRepTyConApp
T7360.$tcFoo (GHC.Types.[] @GHC.Types.KindRep)
@@ -194,10 +190,7 @@ T7360.$tc'Foo2
-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
T7360.$tc'Foo9 [InlPrag=NOUSERINLINE[~]] :: GHC.Types.KindRep
-[GblId,
- Cpr=#c4(#c1(#c1(#, #, #c1(#, #), #c1(#), #, #c5(*)), *),
- #c1(#c1(#, #, #c1(#, #), #c1(#), #, #c5(*)), *)),
- Unf=OtherCon []]
+[GblId, Unf=OtherCon []]
T7360.$tc'Foo9 = GHC.Types.KindRepFun $krep T7360.$tc'Foo4
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
=====================================
testsuite/tests/stranal/sigs/T18086.stderr
=====================================
@@ -7,9 +7,9 @@ T18086.panic: <L,U>x
==================== Cpr signatures ====================
-T18086.$trModule:
-T18086.m: b
-T18086.panic:
+T18086.$trModule: *
+T18086.m: *b
+T18086.panic: *
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dac38be5dbeea5a7a03c2c7cb2f893f97ac7f4bb
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/dac38be5dbeea5a7a03c2c7cb2f893f97ac7f4bb
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/20200928/59314ba0/attachment-0001.html>
More information about the ghc-commits
mailing list