[Git][ghc/ghc][wip/refactor-demand] 2 commits: Accept some test outputs
Sebastian Graf
gitlab at gitlab.haskell.org
Thu Oct 29 16:49:35 UTC 2020
Sebastian Graf pushed to branch wip/refactor-demand at Glasgow Haskell Compiler / GHC
Commits:
48f6ac14 by Sebastian Graf at 2020-10-29T17:28:55+01:00
Accept some test outputs
- - - - -
fc784641 by Sebastian Graf at 2020-10-29T17:49:27+01:00
Fix absDmd
- - - - -
20 changed files:
- compiler/GHC/Core/Opt/DmdAnal.hs
- compiler/GHC/Types/Demand.hs
- testsuite/tests/numeric/should_compile/T14465.stdout
- testsuite/tests/numeric/should_compile/T7116.stdout
- testsuite/tests/simplCore/should_compile/T13143.stderr
- testsuite/tests/simplCore/should_compile/T3717.stderr
- testsuite/tests/simplCore/should_compile/T3772.stdout
- testsuite/tests/simplCore/should_compile/T4201.stdout
- testsuite/tests/simplCore/should_compile/T4930.stderr
- testsuite/tests/simplCore/should_compile/T7360.stderr
- testsuite/tests/simplCore/should_compile/par01.stderr
- testsuite/tests/simplCore/should_compile/spec-inline.stderr
- testsuite/tests/stranal/sigs/BottomFromInnerLambda.stderr
- testsuite/tests/stranal/sigs/NewtypeArity.stderr
- testsuite/tests/stranal/sigs/StrAnalExample.stderr
- testsuite/tests/stranal/sigs/T12370.stderr
- testsuite/tests/stranal/sigs/T17932.stderr
- testsuite/tests/stranal/sigs/T18086.stderr
- testsuite/tests/stranal/sigs/T8569.stderr
- testsuite/tests/stranal/sigs/T8598.stderr
Changes:
=====================================
compiler/GHC/Core/Opt/DmdAnal.hs
=====================================
@@ -217,7 +217,7 @@ dmdAnal' env dmd (Lam var body)
(body_ty, Lam var body')
| otherwise
- = let (n, body_dmd) = peelCallDmd dmd
+ = let (n, body_dmd) = peelCallDmd dmd
-- body_dmd: a demand to analyze the body
(body_ty, body') = dmdAnal env body_dmd body
@@ -965,7 +965,8 @@ dmdFix top_lvl env let_dmd orig_pairs
-- so this can significantly reduce the number of iterations needed
my_downRhs (env, lazy_fv) (id,rhs)
- = ((env', lazy_fv'), (id', rhs'))
+ = -- pprTrace "my_downRhs" (ppr id $$ ppr (idStrictness id) $$ ppr sig) $
+ ((env', lazy_fv'), (id', rhs'))
where
(lazy_fv1, sig, rhs') = dmdAnalRhsLetDown (Just bndrs) env let_dmd id rhs
lazy_fv' = plusVarEnv_C plusDmd lazy_fv lazy_fv1
@@ -1120,7 +1121,7 @@ annotateLamIdBndr env arg_of_dfun dmd_ty id
-- For lambdas we add the demand to the argument demands
-- Only called for Ids
= ASSERT( isId id )
- -- pprTrace "annLamBndr" (vcat [ppr id, ppr _dmd_ty]) $
+ -- pprTrace "annLamBndr" (vcat [ppr id, ppr dmd_ty, ppr final_ty]) $
(final_ty, setIdDemandInfo id dmd)
where
-- Watch out! See note [Lambda-bound unfoldings]
@@ -1325,7 +1326,8 @@ findBndrsDmds env dmd_ty bndrs
findBndrDmd :: AnalEnv -> Bool -> DmdType -> Id -> (DmdType, Demand)
-- See Note [Trimming a demand to a type]
findBndrDmd env arg_of_dfun dmd_ty id
- = (dmd_ty', dmd')
+ = -- pprTrace "findBndrDmd" (ppr id $$ ppr dmd_ty $$ ppr starting_dmd $$ ppr dmd') $
+ (dmd_ty', dmd')
where
dmd' = strictify $
trimToType starting_dmd (findTypeShape fam_envs id_ty)
=====================================
compiler/GHC/Types/Demand.hs
=====================================
@@ -501,7 +501,7 @@ polyDmd C_10 = C_10 :* poly10
topDmd, absDmd, botDmd, seqDmd :: Demand
strictApply1Dmd, lazyApply1Dmd, lazyApply2Dmd :: Demand
topDmd = polyDmd C_0N
-absDmd = polyDmd C_01
+absDmd = polyDmd C_00
botDmd = polyDmd C_10
seqDmd = C_11 :* seqCleanDmd
strictApply1Dmd = C_1N :* Call C_1N topCleanDmd
@@ -1124,7 +1124,8 @@ strictenDmd (n :* cd) = plusCard C_10 n :* cd
-- see Note [Asymmetry of 'plus*']
multDmdType :: Card -> DmdType -> BothDmdArg
multDmdType n (DmdType fv _ res_ty)
- = (multDmdEnv n fv, multDivergence n res_ty)
+ = -- pprTrace "multDmdType" (ppr n $$ ppr fv $$ ppr (multDmdEnv n fv)) $
+ (multDmdEnv n fv, multDivergence n res_ty)
-- | In a non-strict scenario, we might not force the Divergence, in which case
-- we might converge, hence Dunno.
@@ -1163,7 +1164,8 @@ multTrivial _ _ _ = Nothing
multUnsat :: Card -> DmdType -> DmdType
multUnsat n (DmdType fv args res_ty)
- = DmdType (multDmdEnv n fv)
+ = -- pprTrace "multUnsat" (ppr n $$ ppr fv $$ ppr (multDmdEnv n fv)) $
+ DmdType (multDmdEnv n fv)
(map (multDmd n) args)
(multDivergence n res_ty)
@@ -1423,8 +1425,7 @@ instance Outputable StrictSig where
-- Used for printing top-level strictness pragmas in interface files
pprIfaceStrictSig :: StrictSig -> SDoc
-pprIfaceStrictSig (StrictSig (DmdType _ dmds res))
- = hcat (map ppr dmds) <> ppr res
+pprIfaceStrictSig = ppr
-- | Turns a 'DmdType' computed for the particular 'Arity' into a 'StrictSig'
-- unleashable at that arity. See Note [Understanding DmdType and StrictSig]
=====================================
testsuite/tests/numeric/should_compile/T14465.stdout
=====================================
@@ -78,7 +78,7 @@ twoTimesTwo = 4
plusOne :: Natural -> Natural
[GblId,
Arity=1,
- Str=<S,1*U>,
+ Str=<SU>,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
=====================================
testsuite/tests/numeric/should_compile/T7116.stdout
=====================================
@@ -43,7 +43,7 @@ T7116.$trModule
dr :: Double -> Double
[GblId,
Arity=1,
- Str=<S,1*U(U)>,
+ Str=<S(U)>,
Cpr=m1,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
@@ -60,7 +60,7 @@ dr
dl :: Double -> Double
[GblId,
Arity=1,
- Str=<S,1*U(U)>,
+ Str=<S(U)>,
Cpr=m1,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
@@ -73,7 +73,7 @@ dl = dr
fr :: Float -> Float
[GblId,
Arity=1,
- Str=<S,1*U(U)>,
+ Str=<S(U)>,
Cpr=m1,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
@@ -92,7 +92,7 @@ fr
fl :: Float -> Float
[GblId,
Arity=1,
- Str=<S,1*U(U)>,
+ Str=<S(U)>,
Cpr=m1,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
=====================================
testsuite/tests/simplCore/should_compile/T13143.stderr
=====================================
@@ -7,7 +7,7 @@ Rec {
-- RHS size: {terms: 4, types: 4, coercions: 0, joins: 0/0}
T13143.$wf [InlPrag=NOINLINE, Occ=LoopBreaker]
:: forall {a}. (# #) -> a
-[GblId, Arity=1, Str=<B,A>b, Cpr=b, Unf=OtherCon []]
+[GblId, Arity=1, Str=<B>b, Cpr=b, Unf=OtherCon []]
T13143.$wf = \ (@a) _ [Occ=Dead] -> T13143.$wf @a GHC.Prim.(##)
end Rec }
@@ -15,7 +15,7 @@ end Rec }
f [InlPrag=[final]] :: forall a. Int -> a
[GblId,
Arity=1,
- Str=<B,A>b,
+ Str=<B>b,
Cpr=b,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
@@ -65,47 +65,43 @@ lvl :: Int
lvl = T13143.$wf @Int GHC.Prim.(##)
Rec {
--- RHS size: {terms: 28, types: 7, coercions: 0, joins: 0/0}
+-- RHS size: {terms: 31, types: 9, coercions: 0, joins: 0/0}
T13143.$wg [InlPrag=[2], Occ=LoopBreaker]
- :: Bool -> Bool -> GHC.Prim.Int# -> GHC.Prim.Int#
-[GblId, Arity=3, Str=<S,1*U><S,1*U><L,U>, Unf=OtherCon []]
+ :: Bool -> Bool -> Int -> GHC.Prim.Int#
+[GblId, Arity=3, Str=<SU><U><U(U)>, Unf=OtherCon []]
T13143.$wg
- = \ (w :: Bool) (w1 :: Bool) (ww :: GHC.Prim.Int#) ->
+ = \ (w :: Bool) (w1 :: Bool) (w2 :: Int) ->
case w of {
False ->
case w1 of {
- False -> T13143.$wg GHC.Types.False GHC.Types.True ww;
- True -> GHC.Prim.+# ww 1#
+ False -> T13143.$wg GHC.Types.False GHC.Types.True w2;
+ True -> case w2 of { GHC.Types.I# x -> GHC.Prim.+# x 1# }
};
True ->
case w1 of {
- False -> T13143.$wg GHC.Types.True GHC.Types.True ww;
+ False -> T13143.$wg GHC.Types.True GHC.Types.True w2;
True -> case lvl of wild2 { }
}
}
end Rec }
--- RHS size: {terms: 14, types: 6, coercions: 0, joins: 0/0}
+-- RHS size: {terms: 11, types: 4, coercions: 0, joins: 0/0}
g [InlPrag=[2]] :: Bool -> Bool -> Int -> Int
[GblId,
Arity=3,
- Str=<S,1*U><S,1*U><S,1*U(U)>,
+ Str=<SU><U><U(U)>,
Cpr=m1,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=3,unsat_ok=True,boring_ok=False)
Tmpl= \ (w [Occ=Once1] :: Bool)
(w1 [Occ=Once1] :: Bool)
- (w2 [Occ=Once1!] :: Int) ->
- case w2 of { GHC.Types.I# ww1 [Occ=Once1] ->
- case T13143.$wg w w1 ww1 of ww2 [Occ=Once1] { __DEFAULT ->
- GHC.Types.I# ww2
- }
+ (w2 [Occ=Once1] :: Int) ->
+ case T13143.$wg w w1 w2 of ww [Occ=Once1] { __DEFAULT ->
+ GHC.Types.I# ww
}}]
g = \ (w :: Bool) (w1 :: Bool) (w2 :: Int) ->
- case w2 of { GHC.Types.I# ww1 ->
- case T13143.$wg w w1 ww1 of ww2 { __DEFAULT -> GHC.Types.I# ww2 }
- }
+ case T13143.$wg w w1 w2 of ww { __DEFAULT -> GHC.Types.I# ww }
=====================================
testsuite/tests/simplCore/should_compile/T3717.stderr
=====================================
@@ -43,7 +43,7 @@ Rec {
-- RHS size: {terms: 10, types: 2, coercions: 0, joins: 0/0}
T3717.$wfoo [InlPrag=[2], Occ=LoopBreaker]
:: GHC.Prim.Int# -> GHC.Prim.Int#
-[GblId, Arity=1, Str=<S,1*U>, Unf=OtherCon []]
+[GblId, Arity=1, Str=<SU>, Unf=OtherCon []]
T3717.$wfoo
= \ (ww :: GHC.Prim.Int#) ->
case ww of ds {
@@ -56,7 +56,7 @@ end Rec }
foo [InlPrag=[2]] :: Int -> Int
[GblId,
Arity=1,
- Str=<S(S),1*U(1*U)>,
+ Str=<S(SU)>,
Cpr=m1,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
=====================================
testsuite/tests/simplCore/should_compile/T3772.stdout
=====================================
@@ -42,7 +42,7 @@ T3772.$trModule
Rec {
-- RHS size: {terms: 10, types: 2, coercions: 0, joins: 0/0}
$wxs :: GHC.Prim.Int# -> ()
-[GblId, Arity=1, Str=<S,1*U>, Unf=OtherCon []]
+[GblId, Arity=1, Str=<SU>, Unf=OtherCon []]
$wxs
= \ (ww :: GHC.Prim.Int#) ->
case ww of ds1 {
@@ -53,7 +53,7 @@ end Rec }
-- RHS size: {terms: 10, types: 2, coercions: 0, joins: 0/0}
T3772.$wfoo [InlPrag=NOINLINE] :: GHC.Prim.Int# -> ()
-[GblId, Arity=1, Str=<L,U>, Unf=OtherCon []]
+[GblId, Arity=1, Str=<U>, Unf=OtherCon []]
T3772.$wfoo
= \ (ww :: GHC.Prim.Int#) ->
case GHC.Prim.<# 0# ww of {
@@ -65,7 +65,7 @@ T3772.$wfoo
foo [InlPrag=[final]] :: Int -> ()
[GblId,
Arity=1,
- Str=<S,1*U(U)>,
+ Str=<S(U)>,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False)
=====================================
testsuite/tests/simplCore/should_compile/T4201.stdout
=====================================
@@ -1,4 +1,4 @@
[HasNoCafRefs, LambdaFormInfo: LFReEntrant 1, Arity: 1,
- Strictness: <S,1*U>,
+ Strictness: <SU>,
Unfolding: InlineRule (0, True, True)
bof `cast` (Sym (N:Foo[0]) %<'Many>_N ->_R <T>_R)]
=====================================
testsuite/tests/simplCore/should_compile/T4930.stderr
=====================================
@@ -43,7 +43,7 @@ Rec {
-- RHS size: {terms: 17, types: 3, coercions: 0, joins: 0/0}
T4930.$wfoo [InlPrag=[2], Occ=LoopBreaker]
:: GHC.Prim.Int# -> GHC.Prim.Int#
-[GblId, Arity=1, Str=<L,U>, Unf=OtherCon []]
+[GblId, Arity=1, Str=<U>, Unf=OtherCon []]
T4930.$wfoo
= \ (ww :: GHC.Prim.Int#) ->
case GHC.Prim.<# ww 5# of {
@@ -56,7 +56,7 @@ end Rec }
foo [InlPrag=[2]] :: Int -> Int
[GblId,
Arity=1,
- Str=<S,1*U(U)>,
+ Str=<S(U)>,
Cpr=m1,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
=====================================
testsuite/tests/simplCore/should_compile/T7360.stderr
=====================================
@@ -8,7 +8,7 @@ T7360.$WFoo3 [InlPrag=INLINE[final] CONLIKE] :: Int %1 -> Foo
[GblId[DataConWrapper],
Arity=1,
Caf=NoCafRefs,
- Str=<S,U>,
+ Str=<SU>,
Cpr=m3,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
@@ -21,7 +21,7 @@ T7360.$WFoo3
-- RHS size: {terms: 5, types: 2, coercions: 0, joins: 0/0}
fun1 [InlPrag=NOINLINE] :: Foo -> ()
-[GblId, Arity=1, Str=<S,1*U>, Unf=OtherCon []]
+[GblId, Arity=1, Str=<SU>, Unf=OtherCon []]
fun1 = \ (x :: Foo) -> case x of { __DEFAULT -> GHC.Tuple.() }
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
@@ -35,7 +35,7 @@ T7360.fun4 = fun1 T7360.Foo1
fun2 :: forall {a}. [a] -> ((), Int)
[GblId,
Arity=1,
- Str=<L,1*U>,
+ Str=<U>,
Cpr=m1,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
=====================================
testsuite/tests/simplCore/should_compile/par01.stderr
=====================================
@@ -6,7 +6,7 @@ Result size of CorePrep
Rec {
-- RHS size: {terms: 7, types: 3, coercions: 0, joins: 0/0}
Par01.depth [Occ=LoopBreaker] :: GHC.Types.Int -> GHC.Types.Int
-[GblId, Arity=1, Str=<L,U>, Unf=OtherCon []]
+[GblId, Arity=1, Str=<U>, Unf=OtherCon []]
Par01.depth
= \ (d :: GHC.Types.Int) ->
case GHC.Prim.par# @GHC.Types.Int d of { __DEFAULT ->
=====================================
testsuite/tests/simplCore/should_compile/spec-inline.stderr
=====================================
@@ -54,7 +54,7 @@ Rec {
-- RHS size: {terms: 40, types: 5, coercions: 0, joins: 0/0}
Roman.foo_$s$wgo [Occ=LoopBreaker]
:: GHC.Prim.Int# -> GHC.Prim.Int# -> GHC.Prim.Int#
-[GblId, Arity=2, Str=<L,A><L,U>, Unf=OtherCon []]
+[GblId, Arity=2, Str=<U><U>, Unf=OtherCon []]
Roman.foo_$s$wgo
= \ (sc :: GHC.Prim.Int#) (sc1 :: GHC.Prim.Int#) ->
case GHC.Prim.<=# sc1 0# of {
@@ -76,7 +76,7 @@ end Rec }
Roman.$wgo [InlPrag=[2]] :: Maybe Int -> Maybe Int -> GHC.Prim.Int#
[GblId,
Arity=2,
- Str=<S,1*U><S,1*U>,
+ Str=<SU><SU>,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [61 30] 249 0}]
Roman.$wgo
@@ -111,7 +111,7 @@ Roman.$wgo
Roman.foo_go [InlPrag=[2]] :: Maybe Int -> Maybe Int -> Int
[GblId,
Arity=2,
- Str=<S,1*U><S,1*U>,
+ Str=<SU><SU>,
Cpr=m1,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
@@ -143,7 +143,7 @@ Roman.foo1 = GHC.Maybe.Just @Int Roman.foo2
foo :: Int -> Int
[GblId,
Arity=1,
- Str=<S,1*U(U)>,
+ Str=<S(U)>,
Cpr=m1,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
=====================================
testsuite/tests/stranal/sigs/BottomFromInnerLambda.stderr
=====================================
@@ -1,8 +1,8 @@
==================== Strictness signatures ====================
BottomFromInnerLambda.$trModule:
-BottomFromInnerLambda.expensive: <S(S),1*U(U)>
-BottomFromInnerLambda.f: <S(S),1*U(U)>
+BottomFromInnerLambda.expensive: <S(SU)>
+BottomFromInnerLambda.f: <S(SU)>
@@ -15,7 +15,7 @@ BottomFromInnerLambda.f:
==================== Strictness signatures ====================
BottomFromInnerLambda.$trModule:
-BottomFromInnerLambda.expensive: <S(S),1*U(1*U)>
-BottomFromInnerLambda.f: <S(S),1*U(1*U)>
+BottomFromInnerLambda.expensive: <S(SU)>
+BottomFromInnerLambda.f: <S(SU)>
=====================================
testsuite/tests/stranal/sigs/NewtypeArity.stderr
=====================================
@@ -3,8 +3,8 @@
Test.$tc'MkT:
Test.$tcT:
Test.$trModule:
-Test.t: <S,1*U(U)><S,1*U(U)>
-Test.t2: <S,1*U(U)><S,1*U(U)>
+Test.t: <S(U)><S(U)>
+Test.t2: <S(U)><S(U)>
@@ -21,7 +21,7 @@ Test.t2: m1
Test.$tc'MkT:
Test.$tcT:
Test.$trModule:
-Test.t: <S,1*U(U)><S,1*U(U)>
-Test.t2: <S,1*U(U)><S,1*U(U)>
+Test.t: <S(U)><S(U)>
+Test.t2: <S(U)><S(U)>
=====================================
testsuite/tests/stranal/sigs/StrAnalExample.stderr
=====================================
@@ -1,7 +1,7 @@
==================== Strictness signatures ====================
StrAnalExample.$trModule:
-StrAnalExample.foo: <S,1*U>
+StrAnalExample.foo: <SU>
@@ -13,6 +13,6 @@ StrAnalExample.foo:
==================== Strictness signatures ====================
StrAnalExample.$trModule:
-StrAnalExample.foo: <S,1*U>
+StrAnalExample.foo: <SU>
=====================================
testsuite/tests/stranal/sigs/T12370.stderr
=====================================
@@ -1,8 +1,8 @@
==================== Strictness signatures ====================
T12370.$trModule:
-T12370.bar: <S,1*U(U)><S,1*U(U)>
-T12370.foo: <S(SS),1*U(1*U(U),1*U(U))>
+T12370.bar: <S(U)><S(U)>
+T12370.foo: <S(S(U),S(U))>
@@ -15,7 +15,7 @@ T12370.foo: m1
==================== Strictness signatures ====================
T12370.$trModule:
-T12370.bar: <S,1*U(U)><S,1*U(U)>
-T12370.foo: <S(SS),1*U(1*U(U),1*U(U))>
+T12370.bar: <S(U)><S(U)>
+T12370.foo: <S(S(U),S(U))>
=====================================
testsuite/tests/stranal/sigs/T17932.stderr
=====================================
@@ -5,7 +5,7 @@ T17932.$tc'X:
T17932.$tcOptions:
T17932.$tcX:
T17932.$trModule:
-T17932.flags: <S(SS),1*U(1*U,1*U)>
+T17932.flags: <S(SU,SU)>
@@ -25,6 +25,6 @@ T17932.$tc'X:
T17932.$tcOptions:
T17932.$tcX:
T17932.$trModule:
-T17932.flags: <S(SS),1*U(1*U,1*U)>
+T17932.flags: <S(SU,SU)>
=====================================
testsuite/tests/stranal/sigs/T18086.stderr
=====================================
@@ -1,8 +1,8 @@
==================== Strictness signatures ====================
T18086.$trModule:
-T18086.m: <L,U>x
-T18086.panic: <L,U>x
+T18086.m: <U>x
+T18086.panic: <U>x
@@ -15,7 +15,7 @@ T18086.panic:
==================== Strictness signatures ====================
T18086.$trModule:
-T18086.m: <L,U>x
-T18086.panic: <L,U>x
+T18086.m: <U>x
+T18086.panic: <U>x
=====================================
testsuite/tests/stranal/sigs/T8569.stderr
=====================================
@@ -4,7 +4,7 @@ T8569.$tc'Rdata:
T8569.$tc'Rint:
T8569.$tcRep:
T8569.$trModule:
-T8569.addUp: <S,1*U><L,U>
+T8569.addUp: <SU><U>
@@ -22,6 +22,6 @@ T8569.$tc'Rdata:
T8569.$tc'Rint:
T8569.$tcRep:
T8569.$trModule:
-T8569.addUp: <S,1*U><L,U>
+T8569.addUp: <SU><U>
=====================================
testsuite/tests/stranal/sigs/T8598.stderr
=====================================
@@ -1,7 +1,7 @@
==================== Strictness signatures ====================
T8598.$trModule:
-T8598.fun: <S,1*U(U)>
+T8598.fun: <S(U)>
@@ -13,6 +13,6 @@ T8598.fun: m1
==================== Strictness signatures ====================
T8598.$trModule:
-T8598.fun: <S,1*U(U)>
+T8598.fun: <S(U)>
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7f20604ea6ea134eb6298529ff61cd539865877e...fc7846415edc626333e636780ba959d397401265
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/compare/7f20604ea6ea134eb6298529ff61cd539865877e...fc7846415edc626333e636780ba959d397401265
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/20201029/05907d14/attachment-0001.html>
More information about the ghc-commits
mailing list