summaryrefslogtreecommitdiff
path: root/testsuite
diff options
context:
space:
mode:
Diffstat (limited to 'testsuite')
-rw-r--r--testsuite/tests/arityanal/should_compile/Arity04.stderr41
-rw-r--r--testsuite/tests/arityanal/should_compile/T18793.stderr4
-rw-r--r--testsuite/tests/cpranal/should_compile/T18174.hs2
-rw-r--r--testsuite/tests/cpranal/sigs/RecDataConCPR.hs6
-rw-r--r--testsuite/tests/numeric/should_compile/T7116.stdout8
-rw-r--r--testsuite/tests/simplCore/should_compile/T13143.stderr2
-rw-r--r--testsuite/tests/simplCore/should_compile/T13543.stderr8
-rw-r--r--testsuite/tests/simplCore/should_compile/T15056.stderr4
-rw-r--r--testsuite/tests/simplCore/should_compile/T20103.stderr8
-rw-r--r--testsuite/tests/simplCore/should_compile/T3772.stdout2
-rw-r--r--testsuite/tests/simplCore/should_compile/T4930.stderr2
-rw-r--r--testsuite/tests/simplCore/should_compile/spec-inline.stderr2
-rw-r--r--testsuite/tests/stranal/should_compile/T18894.stderr83
-rw-r--r--testsuite/tests/stranal/should_compile/T18903.stderr4
-rw-r--r--testsuite/tests/stranal/should_compile/T20746.stderr133
-rw-r--r--testsuite/tests/stranal/should_compile/T20746.stderr-mingw32132
-rw-r--r--testsuite/tests/stranal/should_compile/T20746b.stderr77
-rw-r--r--testsuite/tests/stranal/should_compile/T21128.hs11
-rw-r--r--testsuite/tests/stranal/should_compile/T21128.stderr133
-rw-r--r--testsuite/tests/stranal/should_compile/T21128a.hs11
-rw-r--r--testsuite/tests/stranal/should_compile/all.T7
-rw-r--r--testsuite/tests/stranal/sigs/DmdAnalGADTs.stderr4
-rw-r--r--testsuite/tests/stranal/sigs/HyperStrUse.stderr4
-rw-r--r--testsuite/tests/stranal/sigs/NewtypeArity.stderr8
-rw-r--r--testsuite/tests/stranal/sigs/T12370.stderr8
-rw-r--r--testsuite/tests/stranal/sigs/T13380f.stderr12
-rw-r--r--testsuite/tests/stranal/sigs/T16197b.stderr4
-rw-r--r--testsuite/tests/stranal/sigs/T16859.stderr16
-rw-r--r--testsuite/tests/stranal/sigs/T18907.stderr6
-rw-r--r--testsuite/tests/stranal/sigs/T18957.stderr16
-rw-r--r--testsuite/tests/stranal/sigs/T19407.stderr4
-rw-r--r--testsuite/tests/stranal/sigs/T19871.stderr8
-rw-r--r--testsuite/tests/stranal/sigs/T20746.hs (renamed from testsuite/tests/stranal/should_compile/T20746.hs)0
-rw-r--r--testsuite/tests/stranal/sigs/T20746.stderr21
-rw-r--r--testsuite/tests/stranal/sigs/T20746b.hs (renamed from testsuite/tests/stranal/should_compile/T20746b.hs)4
-rw-r--r--testsuite/tests/stranal/sigs/T20746b.stderr21
-rw-r--r--testsuite/tests/stranal/sigs/T21119.hs30
-rw-r--r--testsuite/tests/stranal/sigs/T21119.stderr27
-rw-r--r--testsuite/tests/stranal/sigs/T5075.stderr10
-rw-r--r--testsuite/tests/stranal/sigs/T8598.stderr4
-rw-r--r--testsuite/tests/stranal/sigs/all.T3
41 files changed, 391 insertions, 499 deletions
diff --git a/testsuite/tests/arityanal/should_compile/Arity04.stderr b/testsuite/tests/arityanal/should_compile/Arity04.stderr
index 2adcacff39..cd50e21662 100644
--- a/testsuite/tests/arityanal/should_compile/Arity04.stderr
+++ b/testsuite/tests/arityanal/should_compile/Arity04.stderr
@@ -1,47 +1,40 @@
==================== Tidy Core ====================
-Result size of Tidy Core = {terms: 39, types: 24, coercions: 0, joins: 0/0}
+Result size of Tidy Core = {terms: 34, types: 17, coercions: 0, joins: 0/0}
-- RHS size: {terms: 8, types: 3, coercions: 0, joins: 0/0}
f4g :: Int -> Int
[GblId,
Arity=1,
- Str=<1!P(L)>,
+ Str=<1!L>,
Cpr=1,
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)
Tmpl= \ (y [Occ=Once1!] :: Int) -> case y of { GHC.Types.I# x [Occ=Once1] -> GHC.Types.I# (GHC.Prim.+# x 1#) }}]
f4g = \ (y :: Int) -> case y of { GHC.Types.I# x -> GHC.Types.I# (GHC.Prim.+# x 1#) }
--- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
-lvl :: Int
-[GblId, Unf=OtherCon []]
-lvl = GHC.Types.I# 0#
-
Rec {
--- RHS size: {terms: 13, types: 4, coercions: 0, joins: 0/0}
-F4.$wf4h [InlPrag=[2], Occ=LoopBreaker] :: (Int -> Int) -> GHC.Prim.Int# -> Int
-[GblId, Arity=2, Str=<1C1(L)><1L>, Unf=OtherCon []]
-F4.$wf4h
- = \ (f :: Int -> Int) (ww :: GHC.Prim.Int#) ->
- case ww of wild {
- __DEFAULT -> F4.$wf4h f (GHC.Prim.-# wild 1#);
- 0# -> f lvl
+-- RHS size: {terms: 17, types: 6, coercions: 0, joins: 0/0}
+f4h [Occ=LoopBreaker] :: (Int -> Int) -> Int -> Int
+[GblId, Arity=2, Str=<1C1(L)><1P(SL)>, Unf=OtherCon []]
+f4h
+ = \ (f :: Int -> Int) (x :: Int) ->
+ case x of wild { GHC.Types.I# x1 ->
+ case x1 of wild1 {
+ __DEFAULT -> f4h f (GHC.Types.I# (GHC.Prim.-# wild1 1#));
+ 0# -> f wild
+ }
}
end Rec }
--- RHS size: {terms: 8, types: 5, coercions: 0, joins: 0/0}
-f4h [InlPrag=[2]] :: (Int -> Int) -> Int -> Int
-[GblId,
- Arity=2,
- Str=<1C1(L)><1!P(1L)>,
- 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= \ (f [Occ=Once1] :: Int -> Int) (x [Occ=Once1!] :: Int) -> case x of { GHC.Types.I# ww [Occ=Once1] -> F4.$wf4h f ww }}]
-f4h = \ (f :: Int -> Int) (x :: Int) -> case x of { GHC.Types.I# ww -> F4.$wf4h f ww }
+-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
+F4.f1 :: Int
+[GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
+F4.f1 = GHC.Types.I# 9#
-- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
f4 :: Int
[GblId, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=False, ConLike=False, WorkFree=False, Expandable=False, Guidance=IF_ARGS [] 30 0}]
-f4 = F4.$wf4h f4g 9#
+f4 = f4h f4g F4.f1
diff --git a/testsuite/tests/arityanal/should_compile/T18793.stderr b/testsuite/tests/arityanal/should_compile/T18793.stderr
index 6de3dea08a..13ca1c65f5 100644
--- a/testsuite/tests/arityanal/should_compile/T18793.stderr
+++ b/testsuite/tests/arityanal/should_compile/T18793.stderr
@@ -32,7 +32,7 @@ end Rec }
T18793.f_go1 [InlPrag=[2]] :: [Int] -> Int -> Int
[GblId,
Arity=2,
- Str=<1L><1!L>,
+ Str=<1L><1!P(L)>,
Cpr=1,
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= \ (ds [Occ=Once1] :: [Int]) (eta [Occ=Once1!] :: Int) -> case eta of { GHC.Types.I# ww [Occ=Once1] -> case T18793.$wgo1 ds ww of ww1 [Occ=Once1] { __DEFAULT -> GHC.Types.I# ww1 } }}]
@@ -50,7 +50,7 @@ T18793.f1 = stuff T18793.f2
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
f :: Int -> Int
-[GblId, Arity=1, Str=<1!L>, Cpr=1, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 60}]
+[GblId, Arity=1, Str=<1!P(L)>, Cpr=1, Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True, WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 60}]
f = T18793.f_go1 T18793.f1
diff --git a/testsuite/tests/cpranal/should_compile/T18174.hs b/testsuite/tests/cpranal/should_compile/T18174.hs
index bf1c02982c..69ca25a19e 100644
--- a/testsuite/tests/cpranal/should_compile/T18174.hs
+++ b/testsuite/tests/cpranal/should_compile/T18174.hs
@@ -41,7 +41,7 @@ dataConWrapper :: (Int, Int) -> Int -> (T, Int)
dataConWrapper p x = (MkT x p, x+1)
{-# NOINLINE dataConWrapper #-}
--- | Should not unbox the second component, because 'x' won't be available
+-- | Should not unbox the second component, because 'y' won't be available
-- unboxed. It terminates, though.
strictField :: T -> (Int, (Int, Int))
strictField (MkT x y) = (x, y)
diff --git a/testsuite/tests/cpranal/sigs/RecDataConCPR.hs b/testsuite/tests/cpranal/sigs/RecDataConCPR.hs
index c26ae1264f..d934509448 100644
--- a/testsuite/tests/cpranal/sigs/RecDataConCPR.hs
+++ b/testsuite/tests/cpranal/sigs/RecDataConCPR.hs
@@ -95,7 +95,7 @@ type instance E (a,b) = (E a, E b)
type instance E Char = Blub
data Blah = Blah (E (Int, (Int, Int))) -- NonRec
data Blub = Blub (E (Char, Int)) -- Rec
-data Blub2 = Blub2 (E (Bool, Int)) -- Rec, because stuck
+data Blub2 = Blub2 (E (Bool, Int)) -- Unsure, because stuck
blah :: Int -> Blah
blah n = Blah (chr n, (chr (n+1), chr (n+2)))
@@ -110,8 +110,8 @@ blub2 n = Blub2 (undefined :: E Bool, chr n)
data BootNonRec1 = BootNonRec1 BootNonRec2 -- in RecDataConCPRa.hs-boot
data BootRec1 = BootRec1 BootRec2 -- in RecDataConCPRa.hs-boot, recurses back
-bootNonRec :: Int -> BootNonRec2 -> BootNonRec1 -- Nothing, thus like NonRec
+bootNonRec :: Int -> BootNonRec2 -> BootNonRec1 -- Unsure, thus like NonRec
bootNonRec x b2 = BootNonRec1 b2
-bootRec :: Int -> BootRec2 -> BootRec1 -- Nothing, thus like NonRec
+bootRec :: Int -> BootRec2 -> BootRec1 -- Unsure, thus like NonRec
bootRec x b2 = BootRec1 b2
diff --git a/testsuite/tests/numeric/should_compile/T7116.stdout b/testsuite/tests/numeric/should_compile/T7116.stdout
index 3c30cf2e8b..90aeda659d 100644
--- a/testsuite/tests/numeric/should_compile/T7116.stdout
+++ b/testsuite/tests/numeric/should_compile/T7116.stdout
@@ -43,7 +43,7 @@ T7116.$trModule
dr :: Double -> Double
[GblId,
Arity=1,
- Str=<1!L>,
+ Str=<1!P(L)>,
Cpr=1,
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=<1!L>,
+ Str=<1!P(L)>,
Cpr=1,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
@@ -71,7 +71,7 @@ dl = dr
fr :: Float -> Float
[GblId,
Arity=1,
- Str=<1!L>,
+ Str=<1!P(L)>,
Cpr=1,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
@@ -90,7 +90,7 @@ fr
fl :: Float -> Float
[GblId,
Arity=1,
- Str=<1!L>,
+ Str=<1!P(L)>,
Cpr=1,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
diff --git a/testsuite/tests/simplCore/should_compile/T13143.stderr b/testsuite/tests/simplCore/should_compile/T13143.stderr
index a2c77f86ea..5ca8a9a503 100644
--- a/testsuite/tests/simplCore/should_compile/T13143.stderr
+++ b/testsuite/tests/simplCore/should_compile/T13143.stderr
@@ -98,7 +98,7 @@ end Rec }
g [InlPrag=[2]] :: Bool -> Bool -> Int -> Int
[GblId,
Arity=3,
- Str=<1L><1L><1!L>,
+ Str=<1L><1L><1!P(L)>,
Cpr=1,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
diff --git a/testsuite/tests/simplCore/should_compile/T13543.stderr b/testsuite/tests/simplCore/should_compile/T13543.stderr
index 485f6fea41..94c0b76bfc 100644
--- a/testsuite/tests/simplCore/should_compile/T13543.stderr
+++ b/testsuite/tests/simplCore/should_compile/T13543.stderr
@@ -1,8 +1,8 @@
==================== Strictness signatures ====================
Foo.$trModule:
-Foo.f: <1!P(1L)><1!L><1!L>
-Foo.g: <1!P(1!L,1!L)>
+Foo.f: <1!P(1L)><1!P(L)><1!P(L)>
+Foo.g: <1!P(1!P(L),1!P(L))>
@@ -15,7 +15,7 @@ Foo.g: 1
==================== Strictness signatures ====================
Foo.$trModule:
-Foo.f: <1!P(1L)><1!L><1!L>
-Foo.g: <1!P(1!L,1!L)>
+Foo.f: <1!P(1L)><1!P(L)><1!P(L)>
+Foo.g: <1!P(1!P(L),1!P(L))>
diff --git a/testsuite/tests/simplCore/should_compile/T15056.stderr b/testsuite/tests/simplCore/should_compile/T15056.stderr
index 1ca9102d70..126bc10057 100644
--- a/testsuite/tests/simplCore/should_compile/T15056.stderr
+++ b/testsuite/tests/simplCore/should_compile/T15056.stderr
@@ -2,9 +2,7 @@ Rule fired: Class op - (BUILTIN)
Rule fired: Class op + (BUILTIN)
Rule fired: Class op + (BUILTIN)
Rule fired: Class op + (BUILTIN)
-Rule fired: Class op enumFromTo (BUILTIN)
-Rule fired: Class op foldr (BUILTIN)
-Rule fired: Class op foldr (BUILTIN)
Rule fired: +# (BUILTIN)
Rule fired: Class op foldr (BUILTIN)
+Rule fired: Class op enumFromTo (BUILTIN)
Rule fired: fold/build (GHC.Base)
diff --git a/testsuite/tests/simplCore/should_compile/T20103.stderr b/testsuite/tests/simplCore/should_compile/T20103.stderr
index f89fe3a8f0..7eea0f5fde 100644
--- a/testsuite/tests/simplCore/should_compile/T20103.stderr
+++ b/testsuite/tests/simplCore/should_compile/T20103.stderr
@@ -11,7 +11,7 @@ lvl = GHC.Types.I# 28#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
lvl1 :: Int
[GblId, Unf=OtherCon []]
-lvl1 = GHC.Types.I# 8#
+lvl1 = GHC.Types.I# 7#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
lvl2 :: Int
@@ -75,7 +75,7 @@ lvl10 = GHC.Types.I# 12#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
lvl11 :: Int
[GblId, Unf=OtherCon []]
-lvl11 = GHC.Types.I# 7#
+lvl11 = GHC.Types.I# 8#
-- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
lvl12 :: Int
@@ -100,7 +100,7 @@ lvl15 = GHC.CString.unpackCString# lvl14
-- RHS size: {terms: 6, types: 5, coercions: 4, joins: 0/0}
lvl16 :: CallStack -> ([Char], SrcLoc)
-[GblId, Arity=1, Str=<S>b, Cpr=b, Unf=OtherCon []]
+[GblId, Arity=1, Str=<S!S>b, Cpr=b, Unf=OtherCon []]
lvl16
= \ (wild1 :: CallStack) ->
GHC.List.head1
@@ -115,7 +115,7 @@ T20103.$wfoo [InlPrag=[2], Occ=LoopBreaker]
:: HasCallStack => GHC.Prim.Int# -> GHC.Prim.Int#
[GblId[StrictWorker([!, ~])],
Arity=2,
- Str=<1L><1L>,
+ Str=<SL><1L>,
Unf=OtherCon []]
T20103.$wfoo
= \ ($dIP
diff --git a/testsuite/tests/simplCore/should_compile/T3772.stdout b/testsuite/tests/simplCore/should_compile/T3772.stdout
index c63beeca95..dde2503f31 100644
--- a/testsuite/tests/simplCore/should_compile/T3772.stdout
+++ b/testsuite/tests/simplCore/should_compile/T3772.stdout
@@ -65,7 +65,7 @@ T3772.$wfoo
foo [InlPrag=[final]] :: Int -> ()
[GblId,
Arity=1,
- Str=<1!L>,
+ Str=<1!P(L)>,
Cpr=1,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
diff --git a/testsuite/tests/simplCore/should_compile/T4930.stderr b/testsuite/tests/simplCore/should_compile/T4930.stderr
index b8d14764ce..413f892942 100644
--- a/testsuite/tests/simplCore/should_compile/T4930.stderr
+++ b/testsuite/tests/simplCore/should_compile/T4930.stderr
@@ -56,7 +56,7 @@ end Rec }
foo [InlPrag=[2]] :: Int -> Int
[GblId,
Arity=1,
- Str=<1!L>,
+ Str=<1!P(L)>,
Cpr=1,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
diff --git a/testsuite/tests/simplCore/should_compile/spec-inline.stderr b/testsuite/tests/simplCore/should_compile/spec-inline.stderr
index 6ecc7340a2..7b99cc01ff 100644
--- a/testsuite/tests/simplCore/should_compile/spec-inline.stderr
+++ b/testsuite/tests/simplCore/should_compile/spec-inline.stderr
@@ -147,7 +147,7 @@ Roman.foo1 = GHC.Maybe.Just @Int Roman.foo2
foo :: Int -> Int
[GblId,
Arity=1,
- Str=<1!L>,
+ Str=<1!P(L)>,
Cpr=1,
Unf=Unf{Src=InlineStable, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True,
diff --git a/testsuite/tests/stranal/should_compile/T18894.stderr b/testsuite/tests/stranal/should_compile/T18894.stderr
index 55fbd59939..ba4a213e4c 100644
--- a/testsuite/tests/stranal/should_compile/T18894.stderr
+++ b/testsuite/tests/stranal/should_compile/T18894.stderr
@@ -46,7 +46,7 @@ lvl :: Int
lvl = GHC.Types.I# 0#
-- RHS size: {terms: 42, types: 15, coercions: 0, joins: 0/1}
-g2 [InlPrag=NOINLINE, Dmd=LCL(C1(!P(M!L,1!L)))]
+g2 [InlPrag=NOINLINE, Dmd=LCL(C1(!P(M!P(L),1!P(L))))]
:: Int -> Int -> (Int, Int)
[LclId,
Arity=2,
@@ -56,7 +56,7 @@ g2 [InlPrag=NOINLINE, Dmd=LCL(C1(!P(M!L,1!L)))]
g2
= \ (m :: Int) (ds [Dmd=1!P(1L)] :: Int) ->
case ds of { GHC.Types.I# ds [Dmd=1L] ->
- case ds of ds [Dmd=M!L] {
+ case ds of ds [Dmd=ML] {
__DEFAULT ->
(case m of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.*# 2# y) },
case ds of wild {
@@ -102,19 +102,19 @@ lvl = GHC.Types.I# 0#
h2 :: Int -> Int
[LclIdX,
Arity=1,
- Str=<1!P(SL)>,
+ Str=<1P(SL)>,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 162 10}]
h2
- = \ (ds [Dmd=1!P(SL)] :: Int) ->
- case ds of wild [Dmd=L!L] { GHC.Types.I# ds [Dmd=SL] ->
- case ds of ds [Dmd=L!L] {
+ = \ (ds [Dmd=1P(SL)] :: Int) ->
+ case ds of wild { GHC.Types.I# ds [Dmd=SL] ->
+ case ds of ds {
__DEFAULT ->
case GHC.Prim.remInt# ds 2# of {
__DEFAULT ->
- case g2 wild lvl of { (ds1 [Dmd=A], y [Dmd=1!L]) -> y };
+ case g2 wild lvl of { (ds1 [Dmd=A], y [Dmd=1!P(L)]) -> y };
0# ->
- case g2 lvl wild of { (x [Dmd=1!L], ds [Dmd=1!L]) ->
+ case g2 lvl wild of { (x [Dmd=1!P(L)], ds [Dmd=1!P(L)]) ->
case x of { GHC.Types.I# x ->
case ds of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) }
}
@@ -146,7 +146,7 @@ lvl :: (Int, Int)
lvl = (lvl, lvl)
-- RHS size: {terms: 36, types: 10, coercions: 0, joins: 0/1}
-g1 [InlPrag=NOINLINE, Dmd=LCL(!P(L!L,L!L))] :: Int -> (Int, Int)
+g1 [InlPrag=NOINLINE, Dmd=LCL(!P(L,L))] :: Int -> (Int, Int)
[LclId,
Arity=1,
Str=<1!P(1L)>,
@@ -155,7 +155,7 @@ g1 [InlPrag=NOINLINE, Dmd=LCL(!P(L!L,L!L))] :: Int -> (Int, Int)
g1
= \ (ds [Dmd=1!P(1L)] :: Int) ->
case ds of { GHC.Types.I# ds [Dmd=1L] ->
- case ds of ds [Dmd=L!L] {
+ case ds of ds {
__DEFAULT ->
(GHC.Types.I# (GHC.Prim.*# 2# ds),
case ds of wild {
@@ -199,16 +199,16 @@ h1 :: Int -> Int
WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 111 10}]
h1
= \ (ds [Dmd=1!P(SL)] :: Int) ->
- case ds of wild [Dmd=M!P(M!L)] { GHC.Types.I# ds [Dmd=SL] ->
+ case ds of wild [Dmd=M!P(ML)] { GHC.Types.I# ds [Dmd=SL] ->
case ds of {
__DEFAULT ->
- case g1 wild of { (x [Dmd=1!L], ds [Dmd=1!L]) ->
+ case g1 wild of { (x [Dmd=1!P(L)], ds [Dmd=1!P(L)]) ->
case x of { GHC.Types.I# x ->
case ds of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) }
}
};
1# -> lvl;
- 2# -> case lvl of { (ds1 [Dmd=A], y [Dmd=1!L]) -> y }
+ 2# -> case lvl of { (ds1 [Dmd=A], y [Dmd=1!P(L)]) -> y }
}
}
@@ -217,7 +217,7 @@ h1
==================== Demand analysis ====================
Result size of Demand analysis
- = {terms: 176, types: 114, coercions: 0, joins: 0/2}
+ = {terms: 171, types: 111, coercions: 0, joins: 0/2}
-- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
$trModule :: GHC.Prim.Addr#
@@ -262,7 +262,7 @@ lvl :: Int
lvl = GHC.Types.I# 0#
-- RHS size: {terms: 39, types: 17, coercions: 0, joins: 0/1}
-$wg2 [InlPrag=NOINLINE, Dmd=LCL(C1(!P(M!L,1!L)))]
+$wg2 [InlPrag=NOINLINE, Dmd=LCL(C1(!P(M!P(L),1!P(L))))]
:: Int -> GHC.Prim.Int# -> (# Int, Int #)
[LclId,
Arity=2,
@@ -271,7 +271,7 @@ $wg2 [InlPrag=NOINLINE, Dmd=LCL(C1(!P(M!L,1!L)))]
WorkFree=True, Expandable=True, Guidance=IF_ARGS [20 30] 76 20}]
$wg2
= \ (m :: Int) (ww [Dmd=1L] :: GHC.Prim.Int#) ->
- case ww of ds [Dmd=M!L] {
+ case ww of ds [Dmd=ML] {
__DEFAULT ->
(# case m of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.*# 2# y) },
case ds of wild {
@@ -298,25 +298,23 @@ lvl :: Int
WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
lvl = GHC.Types.I# 2#
--- RHS size: {terms: 34, types: 21, coercions: 0, joins: 0/0}
-$wh2 [InlPrag=[2], Dmd=LCL(!L)] :: GHC.Prim.Int# -> Int
-[LclId,
+-- RHS size: {terms: 36, types: 23, coercions: 0, joins: 0/0}
+h2 :: Int -> Int
+[LclIdX,
Arity=1,
- Str=<1L>,
+ Str=<1P(SL)>,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
- WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 162 10}]
-$wh2
- = \ (ww [Dmd=1L] :: GHC.Prim.Int#) ->
- case ww of ds [Dmd=L!L] {
+ WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 162 10}]
+h2
+ = \ (ds [Dmd=1P(SL)] :: Int) ->
+ case ds of wild { GHC.Types.I# ds [Dmd=SL] ->
+ case ds of ds {
__DEFAULT ->
case GHC.Prim.remInt# ds 2# of {
__DEFAULT ->
- case $wg2 (GHC.Types.I# ds) 2# of
- { (# ww [Dmd=A], ww [Dmd=1!L] #) ->
- ww
- };
+ case $wg2 wild 2# of { (# ww [Dmd=A], ww [Dmd=1!P(L)] #) -> ww };
0# ->
- case $wg2 lvl ds of { (# ww [Dmd=1!L], ww [Dmd=1!L] #) ->
+ case $wg2 lvl ds of { (# ww [Dmd=1!P(L)], ww [Dmd=1!P(L)] #) ->
case ww of { GHC.Types.I# x ->
case ww of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# x y) }
}
@@ -324,23 +322,10 @@ $wh2
};
1# -> lvl
}
-
--- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0}
-h2 [InlPrag=[2]] :: Int -> Int
-[LclIdX,
- Arity=1,
- Str=<1!P(1L)>,
- 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)
- Tmpl= \ (ds [Occ=Once1!, Dmd=S!P(SL)] :: Int) ->
- case ds of { GHC.Types.I# ww [Occ=Once1, Dmd=SL] -> $wh2 ww }}]
-h2
- = \ (ds [Dmd=1!P(1L)] :: Int) ->
- case ds of { GHC.Types.I# ww [Dmd=1L] -> $wh2 ww }
+ }
-- RHS size: {terms: 34, types: 14, coercions: 0, joins: 0/1}
-$wg1 [InlPrag=NOINLINE, Dmd=LCL(!P(L,L!L))]
+$wg1 [InlPrag=NOINLINE, Dmd=LCL(!P(L,L))]
:: GHC.Prim.Int# -> (# GHC.Prim.Int#, Int #)
[LclId,
Arity=1,
@@ -349,7 +334,7 @@ $wg1 [InlPrag=NOINLINE, Dmd=LCL(!P(L,L!L))]
WorkFree=True, Expandable=True, Guidance=IF_ARGS [30] 56 20}]
$wg1
= \ (ww [Dmd=1L] :: GHC.Prim.Int#) ->
- case ww of ds [Dmd=L!L] {
+ case ww of ds {
__DEFAULT ->
(# GHC.Prim.*# 2# ds,
case ds of wild {
@@ -377,7 +362,7 @@ lvl :: (Int, Int)
lvl = case $wg1 2# of { (# ww, ww #) -> (GHC.Types.I# ww, ww) }
-- RHS size: {terms: 22, types: 16, coercions: 0, joins: 0/0}
-$wh1 [InlPrag=[2], Dmd=LCL(!L)] :: GHC.Prim.Int# -> Int
+$wh1 [InlPrag=[2], Dmd=LCL(!P(L))] :: GHC.Prim.Int# -> Int
[LclId,
Arity=1,
Str=<1L>,
@@ -385,13 +370,13 @@ $wh1 [InlPrag=[2], Dmd=LCL(!L)] :: GHC.Prim.Int# -> Int
WorkFree=True, Expandable=True, Guidance=IF_ARGS [50] 91 10}]
$wh1
= \ (ww [Dmd=1L] :: GHC.Prim.Int#) ->
- case ww of ds [Dmd=M!L] {
+ case ww of ds [Dmd=ML] {
__DEFAULT ->
- case $wg1 ds of { (# ww, ww [Dmd=1!L] #) ->
+ case $wg1 ds of { (# ww, ww [Dmd=1!P(L)] #) ->
case ww of { GHC.Types.I# y -> GHC.Types.I# (GHC.Prim.+# ww y) }
};
1# -> lvl;
- 2# -> case lvl of { (ds1 [Dmd=A], y [Dmd=1!L]) -> y }
+ 2# -> case lvl of { (ds1 [Dmd=A], y [Dmd=1!P(L)]) -> y }
}
-- RHS size: {terms: 6, types: 3, coercions: 0, joins: 0/0}
diff --git a/testsuite/tests/stranal/should_compile/T18903.stderr b/testsuite/tests/stranal/should_compile/T18903.stderr
index 8c0427b235..e44edd8507 100644
--- a/testsuite/tests/stranal/should_compile/T18903.stderr
+++ b/testsuite/tests/stranal/should_compile/T18903.stderr
@@ -50,13 +50,13 @@ T18903.h1 = GHC.Types.I# 0#
h :: Int -> Int
[GblId,
Arity=1,
- Str=<1!P(SL)>,
+ Str=<1P(SL)>,
Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
WorkFree=True, Expandable=True, Guidance=IF_ARGS [20] 217 10}]
h = \ (m :: Int) ->
case m of wild { GHC.Types.I# ds ->
let {
- $wg [InlPrag=NOINLINE, Dmd=MCM(!P(M!L,1!L))]
+ $wg [InlPrag=NOINLINE, Dmd=MCM(!P(M!P(L),1!P(L)))]
:: GHC.Prim.Int# -> (# Int, Int #)
[LclId, Arity=1, Str=<1L>, Unf=OtherCon []]
$wg
diff --git a/testsuite/tests/stranal/should_compile/T20746.stderr b/testsuite/tests/stranal/should_compile/T20746.stderr
deleted file mode 100644
index 6e7f56f625..0000000000
--- a/testsuite/tests/stranal/should_compile/T20746.stderr
+++ /dev/null
@@ -1,133 +0,0 @@
-
-==================== Tidy Core ====================
-Result size of Tidy Core
- = {terms: 70, types: 113, coercions: 18, joins: 0/2}
-
--- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
-Foo.$trModule4 :: GHC.Prim.Addr#
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
- WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}]
-Foo.$trModule4 = "main"#
-
--- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
-Foo.$trModule3 :: GHC.Types.TrName
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
- WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
-Foo.$trModule3 = GHC.Types.TrNameS Foo.$trModule4
-
--- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
-Foo.$trModule2 :: GHC.Prim.Addr#
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
- WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}]
-Foo.$trModule2 = "Foo"#
-
--- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
-Foo.$trModule1 :: GHC.Types.TrName
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
- WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
-Foo.$trModule1 = GHC.Types.TrNameS Foo.$trModule2
-
--- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
-Foo.$trModule :: GHC.Types.Module
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
- WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
-Foo.$trModule = GHC.Types.Module Foo.$trModule3 Foo.$trModule1
-
--- RHS size: {terms: 5, types: 8, coercions: 0, joins: 0/0}
-Foo.f1 [InlPrag=NOINLINE]
- :: Int
- -> GHC.Prim.State# GHC.Prim.RealWorld
- -> (# GHC.Prim.State# GHC.Prim.RealWorld, Int #)
-[GblId, Arity=2, Str=<L><L>, Cpr=1, Unf=OtherCon []]
-Foo.f1
- = \ (n :: Int)
- (s [OS=OneShot] :: GHC.Prim.State# GHC.Prim.RealWorld) ->
- (# s, n #)
-
--- RHS size: {terms: 1, types: 0, coercions: 6, joins: 0/0}
-foogle [InlPrag=[final]] :: Int -> IO Int
-[GblId,
- Arity=2,
- Str=<L><L>,
- Cpr=1,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
- WorkFree=True, Expandable=True,
- Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)}]
-foogle
- = Foo.f1
- `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))
-
--- RHS size: {terms: 35, types: 38, coercions: 12, joins: 0/2}
-Foo.$wf [InlPrag=[2]]
- :: forall {a}. Show a => a -> (# Int -> IO Int, Int -> IO Int #)
-[GblId,
- Arity=2,
- Str=<MP(A,MCM(L),A)><L>,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
- WorkFree=True, Expandable=True, Guidance=IF_ARGS [30 0] 181 10}]
-Foo.$wf
- = \ (@a) ($dShow :: Show a) (x :: a) ->
- let {
- lvl :: String
- [LclId]
- lvl = show @a $dShow x } in
- let {
- g :: Int
- -> GHC.Prim.State# GHC.Prim.RealWorld
- -> (# GHC.Prim.State# GHC.Prim.RealWorld, Int #)
- [LclId, Arity=2, Str=<1L><L>, Unf=OtherCon []]
- g = \ (y :: Int) (s :: GHC.Prim.State# GHC.Prim.RealWorld) ->
- case y of wild { GHC.Types.I# x1 ->
- case GHC.Prim.># x1 2# of {
- __DEFAULT -> Foo.f1 wild s;
- 1# ->
- case GHC.IO.Handle.Text.hPutStr2
- GHC.IO.Handle.FD.stdout lvl GHC.Types.True s
- of
- { (# ipv, ipv1 #) ->
- Foo.f1 wild ipv
- }
- }
- } } in
- (# g
- `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)),
- g
- `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)) #)
-
--- RHS size: {terms: 11, types: 26, coercions: 0, joins: 0/0}
-f [InlPrag=[2]]
- :: forall {a}. Show a => a -> (Int -> IO Int, Int -> IO Int)
-[GblId,
- Arity=2,
- Str=<MP(A,MCM(L),A)><L>,
- Cpr=1,
- 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= \ (@a) ($dShow [Occ=Once1] :: Show a) (x [Occ=Once1] :: a) ->
- case Foo.$wf @a $dShow x of
- { (# ww [Occ=Once1], ww1 [Occ=Once1] #) ->
- (ww, ww1)
- }}]
-f = \ (@a) ($dShow :: Show a) (x :: a) ->
- case Foo.$wf @a $dShow x of { (# ww, ww1 #) -> (ww, ww1) }
-
-
-
diff --git a/testsuite/tests/stranal/should_compile/T20746.stderr-mingw32 b/testsuite/tests/stranal/should_compile/T20746.stderr-mingw32
deleted file mode 100644
index 65ad712056..0000000000
--- a/testsuite/tests/stranal/should_compile/T20746.stderr-mingw32
+++ /dev/null
@@ -1,132 +0,0 @@
-==================== Tidy Core ====================
-Result size of Tidy Core
- = {terms: 70, types: 113, coercions: 18, joins: 0/2}
-
--- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
-Foo.$trModule4 :: GHC.Prim.Addr#
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
- WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}]
-Foo.$trModule4 = "main"#
-
--- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
-Foo.$trModule3 :: GHC.Types.TrName
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
- WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
-Foo.$trModule3 = GHC.Types.TrNameS Foo.$trModule4
-
--- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0}
-Foo.$trModule2 :: GHC.Prim.Addr#
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
- WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 20 0}]
-Foo.$trModule2 = "Foo"#
-
--- RHS size: {terms: 2, types: 0, coercions: 0, joins: 0/0}
-Foo.$trModule1 :: GHC.Types.TrName
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
- WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
-Foo.$trModule1 = GHC.Types.TrNameS Foo.$trModule2
-
--- RHS size: {terms: 3, types: 0, coercions: 0, joins: 0/0}
-Foo.$trModule :: GHC.Types.Module
-[GblId,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
- WorkFree=True, Expandable=True, Guidance=IF_ARGS [] 10 10}]
-Foo.$trModule = GHC.Types.Module Foo.$trModule3 Foo.$trModule1
-
--- RHS size: {terms: 5, types: 8, coercions: 0, joins: 0/0}
-Foo.f1 [InlPrag=NOINLINE]
- :: Int
- -> GHC.Prim.State# GHC.Prim.RealWorld
- -> (# GHC.Prim.State# GHC.Prim.RealWorld, Int #)
-[GblId, Arity=2, Str=<L><L>, Cpr=1, Unf=OtherCon []]
-Foo.f1
- = \ (n :: Int)
- (s [OS=OneShot] :: GHC.Prim.State# GHC.Prim.RealWorld) ->
- (# s, n #)
-
--- RHS size: {terms: 1, types: 0, coercions: 6, joins: 0/0}
-foogle [InlPrag=[final]] :: Int -> IO Int
-[GblId,
- Arity=2,
- Str=<L><L>,
- Cpr=1,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
- WorkFree=True, Expandable=True,
- Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)}]
-foogle
- = Foo.f1
- `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))
-
--- RHS size: {terms: 35, types: 38, coercions: 12, joins: 0/2}
-Foo.$wf [InlPrag=[2]]
- :: forall {a}. Show a => a -> (# Int -> IO Int, Int -> IO Int #)
-[GblId,
- Arity=2,
- Str=<MP(A,MCM(L),A)><L>,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
- WorkFree=True, Expandable=True, Guidance=IF_ARGS [30 0] 181 10}]
-Foo.$wf
- = \ (@a) ($dShow :: Show a) (x :: a) ->
- let {
- lvl :: String
- [LclId]
- lvl = show @a $dShow x } in
- let {
- g :: Int
- -> GHC.Prim.State# GHC.Prim.RealWorld
- -> (# GHC.Prim.State# GHC.Prim.RealWorld, Int #)
- [LclId, Arity=2, Str=<1L><L>, Unf=OtherCon []]
- g = \ (y :: Int) (s :: GHC.Prim.State# GHC.Prim.RealWorld) ->
- case y of wild { GHC.Types.I# x1 ->
- case GHC.Prim.># x1 2# of {
- __DEFAULT -> Foo.f1 wild s;
- 1# ->
- case GHC.IO.Handle.Text.hPutStr2
- GHC.IO.StdHandles.stdout lvl GHC.Types.True s
- of
- { (# ipv, ipv1 #) ->
- Foo.f1 wild ipv
- }
- }
- } } in
- (# g
- `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)),
- g
- `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)) #)
-
--- RHS size: {terms: 11, types: 26, coercions: 0, joins: 0/0}
-f [InlPrag=[2]]
- :: forall {a}. Show a => a -> (Int -> IO Int, Int -> IO Int)
-[GblId,
- Arity=2,
- Str=<MP(A,MCM(L),A)><L>,
- Cpr=1,
- 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= \ (@a) ($dShow [Occ=Once1] :: Show a) (x [Occ=Once1] :: a) ->
- case Foo.$wf @a $dShow x of
- { (# ww [Occ=Once1], ww1 [Occ=Once1] #) ->
- (ww, ww1)
- }}]
-f = \ (@a) ($dShow :: Show a) (x :: a) ->
- case Foo.$wf @a $dShow x of { (# ww, ww1 #) -> (ww, ww1) }
-
-
-
diff --git a/testsuite/tests/stranal/should_compile/T20746b.stderr b/testsuite/tests/stranal/should_compile/T20746b.stderr
deleted file mode 100644
index 97f8496c4b..0000000000
--- a/testsuite/tests/stranal/should_compile/T20746b.stderr
+++ /dev/null
@@ -1,77 +0,0 @@
-
-==================== Tidy Core ====================
-Result size of Tidy Core
- = {terms: 33, types: 78, coercions: 21, joins: 0/0}
-
--- RHS size: {terms: 5, types: 8, coercions: 0, joins: 0/0}
-T20746b.mightThrow1 [InlPrag=NOINLINE]
- :: Int
- -> GHC.Prim.State# GHC.Prim.RealWorld
- -> (# GHC.Prim.State# GHC.Prim.RealWorld, Int #)
-[GblId, Arity=2, Str=<L><L>, Cpr=1, Unf=OtherCon []]
-T20746b.mightThrow1
- = \ (n :: Int)
- (s [OS=OneShot] :: GHC.Prim.State# GHC.Prim.RealWorld) ->
- (# s, n #)
-
--- RHS size: {terms: 1, types: 0, coercions: 6, joins: 0/0}
-mightThrow [InlPrag=[final]] :: Int -> IO Int
-[GblId,
- Arity=2,
- Str=<L><L>,
- Cpr=1,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
- WorkFree=True, Expandable=True,
- Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)}]
-mightThrow
- = T20746b.mightThrow1
- `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))
-
-Rec {
--- RHS size: {terms: 22, types: 32, coercions: 0, joins: 0/0}
-T20746b.f1 [Occ=LoopBreaker]
- :: Bool
- -> (Int, Int, Int)
- -> GHC.Prim.State# GHC.Prim.RealWorld
- -> (# GHC.Prim.State# GHC.Prim.RealWorld, (Int, Int, Int) #)
-[GblId, Arity=3, Str=<1L><1L><L>, Cpr=1, Unf=OtherCon []]
-T20746b.f1
- = \ (ds :: Bool)
- (trp :: (Int, Int, Int))
- (eta [OS=OneShot] :: GHC.Prim.State# GHC.Prim.RealWorld) ->
- case ds of {
- False -> T20746b.f1 GHC.Types.True trp eta;
- True ->
- case trp of wild1 { (a, b, c) ->
- case T20746b.mightThrow1 a eta of { (# ipv, ipv1 #) ->
- (# ipv, wild1 #)
- }
- }
- }
-end Rec }
-
--- RHS size: {terms: 1, types: 0, coercions: 15, joins: 0/0}
-f :: Bool -> (Int, Int, Int) -> IO (Int, Int, Int)
-[GblId,
- Arity=3,
- Str=<1L><1L><L>,
- Cpr=1,
- Unf=Unf{Src=<vanilla>, TopLvl=True, Value=True, ConLike=True,
- WorkFree=True, Expandable=True,
- Guidance=ALWAYS_IF(arity=0,unsat_ok=True,boring_ok=True)}]
-f = T20746b.f1
- `cast` (<Bool>_R
- %<'Many>_N ->_R <(Int, Int, Int)>_R
- %<'Many>_N ->_R Sym (GHC.Types.N:IO[0] <(Int, Int, Int)>_R)
- :: (Bool
- -> (Int, Int, Int)
- -> GHC.Prim.State# GHC.Prim.RealWorld
- -> (# GHC.Prim.State# GHC.Prim.RealWorld, (Int, Int, Int) #))
- ~R# (Bool -> (Int, Int, Int) -> IO (Int, Int, Int)))
-
-
-
diff --git a/testsuite/tests/stranal/should_compile/T21128.hs b/testsuite/tests/stranal/should_compile/T21128.hs
new file mode 100644
index 0000000000..899adac49c
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/T21128.hs
@@ -0,0 +1,11 @@
+module T21128 where
+
+import T21128a
+
+theresCrud :: Int -> Int -> Int
+theresCrud x y = go x
+ where
+ go 0 = index 0 y 0
+ go 1 = index x y 1
+ go n = go (n-1)
+{-# NOINLINE theresCrud #-}
diff --git a/testsuite/tests/stranal/should_compile/T21128.stderr b/testsuite/tests/stranal/should_compile/T21128.stderr
new file mode 100644
index 0000000000..a64c1f1d5a
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/T21128.stderr
@@ -0,0 +1,133 @@
+
+==================== Tidy Core ====================
+Result size of Tidy Core
+ = {terms: 137, types: 92, coercions: 4, joins: 0/0}
+
+lvl = "error"#
+
+lvl1 = unpackCString# lvl
+
+$trModule4 = "main"#
+
+lvl2 = unpackCString# $trModule4
+
+$trModule2 = "T21128a"#
+
+lvl3 = unpackCString# $trModule2
+
+lvl4 = "./T21128a.hs"#
+
+lvl5 = unpackCString# lvl4
+
+lvl6 = I# 4#
+
+lvl7 = I# 20#
+
+lvl8 = I# 25#
+
+lvl9 = SrcLoc lvl2 lvl3 lvl5 lvl6 lvl7 lvl6 lvl8
+
+lvl10 = PushCallStack lvl1 lvl9 EmptyCallStack
+
+$windexError
+ = \ @a @b ww eta eta1 eta2 ->
+ error
+ (lvl10 `cast` <Co:4> :: CallStack ~R# (?callStack::CallStack))
+ (++ (ww eta) (++ (ww eta1) (ww eta2)))
+
+indexError
+ = \ @a @b $dShow eta eta1 eta2 ->
+ case $dShow of { C:Show ww ww1 ww2 ->
+ $windexError ww1 eta eta1 eta2
+ }
+
+$trModule3 = TrNameS $trModule4
+
+$trModule1 = TrNameS $trModule2
+
+$trModule = Module $trModule3 $trModule1
+
+$wlvl
+ = \ ww ww1 ww2 ->
+ $windexError $fShowInt_$cshow (I# ww2) (I# ww1) (I# ww)
+
+index
+ = \ l u i ->
+ case l of { I# x ->
+ case i of { I# y ->
+ case <=# x y of {
+ __DEFAULT -> case u of { I# ww -> $wlvl y ww x };
+ 1# ->
+ case u of { I# y1 ->
+ case <# y y1 of {
+ __DEFAULT -> $wlvl y y1 x;
+ 1# -> I# (-# y x)
+ }
+ }
+ }
+ }
+ }
+
+
+
+
+==================== Tidy Core ====================
+Result size of Tidy Core
+ = {terms: 108, types: 47, coercions: 0, joins: 3/4}
+
+$trModule4 = "main"#
+
+$trModule3 = TrNameS $trModule4
+
+$trModule2 = "T21128"#
+
+$trModule1 = TrNameS $trModule2
+
+$trModule = Module $trModule3 $trModule1
+
+i = I# 1#
+
+l = I# 0#
+
+lvl = \ y -> $windexError $fShowInt_$cshow l y l
+
+lvl1 = \ ww y -> $windexError $fShowInt_$cshow (I# ww) y i
+
+$wtheresCrud
+ = \ ww ww1 ->
+ let { y = I# ww1 } in
+ join {
+ lvl2
+ = case <=# ww 1# of {
+ __DEFAULT -> case lvl1 ww y of wild { };
+ 1# ->
+ case <# 1# ww1 of {
+ __DEFAULT -> case lvl1 ww y of wild { };
+ 1# -> -# 1# ww
+ }
+ } } in
+ join {
+ lvl3
+ = case <# 0# ww1 of {
+ __DEFAULT -> case lvl y of wild { };
+ 1# -> 0#
+ } } in
+ joinrec {
+ $wgo ww2
+ = case ww2 of wild {
+ __DEFAULT -> jump $wgo (-# wild 1#);
+ 0# -> jump lvl3;
+ 1# -> jump lvl2
+ }; } in
+ jump $wgo ww
+
+theresCrud
+ = \ x y ->
+ case x of { I# ww ->
+ case y of { I# ww1 ->
+ case $wtheresCrud ww ww1 of ww2 { __DEFAULT -> I# ww2 }
+ }
+ }
+
+
+
diff --git a/testsuite/tests/stranal/should_compile/T21128a.hs b/testsuite/tests/stranal/should_compile/T21128a.hs
new file mode 100644
index 0000000000..89d4cd9699
--- /dev/null
+++ b/testsuite/tests/stranal/should_compile/T21128a.hs
@@ -0,0 +1,11 @@
+module T21128a where
+
+indexError :: Show a => a -> a -> a -> b
+indexError a b c = error (show a ++ show b ++ show c)
+{-# NOINLINE indexError #-}
+
+index :: Int -> Int -> Int -> Int
+index l u i
+ | l <= i && i < u = i-l
+ | otherwise = indexError l u i
+{-# INLINE index #-}
diff --git a/testsuite/tests/stranal/should_compile/all.T b/testsuite/tests/stranal/should_compile/all.T
index 042ee9dd44..2698a3a851 100644
--- a/testsuite/tests/stranal/should_compile/all.T
+++ b/testsuite/tests/stranal/should_compile/all.T
@@ -1,5 +1,6 @@
# Only compile with optimisation
-setTestOpts( only_ways(['optasm']) )
+setTestOpts( only_ways(['optasm']))
+setTestOpts( extra_hc_opts('-dno-debug-output') )
test('default', normal, compile, [''])
test('fact', normal, compile, [''])
@@ -77,8 +78,8 @@ test('T19882b', normal, compile, [''])
# We want that the 'go' joinrec in the unfolding has been worker/wrappered.
# So we simply grep for 'jump $wgo' and hope we find more than 2 call sites:
test('T20510', [ grep_errmsg(r'jump \$wgo') ], compile, ['-dsuppress-uniques -ddump-exitify'])
-test('T20746', normal, compile, ['-dsuppress-uniques -ddump-simpl'])
-test('T20746b', normal, compile, ['-dsuppress-uniques -ddump-simpl -dno-typeable-binds'])
test('T20817', [ grep_errmsg(r'Str') ], compile, ['-dsuppress-uniques -ddump-stranal'])
# T21150: Check that t{,1,2} haven't been inlined.
test('T21150', [ grep_errmsg(r'( t\d? :: Int)') ], compile, ['-dsuppress-uniques -ddump-exitify'])
+# T21128: Check that y is not reboxed in $wtheresCrud
+test('T21128', [ grep_errmsg(r'let { y = I\#') ], multimod_compile, ['T21128', '-v0 -dsuppress-uniques -dsuppress-all -ddump-simpl'])
diff --git a/testsuite/tests/stranal/sigs/DmdAnalGADTs.stderr b/testsuite/tests/stranal/sigs/DmdAnalGADTs.stderr
index ea089c36be..2ed48eed70 100644
--- a/testsuite/tests/stranal/sigs/DmdAnalGADTs.stderr
+++ b/testsuite/tests/stranal/sigs/DmdAnalGADTs.stderr
@@ -9,7 +9,7 @@ DmdAnalGADTs.f: <1L>
DmdAnalGADTs.f': <1L>
DmdAnalGADTs.g: <1L>
DmdAnalGADTs.hasCPR:
-DmdAnalGADTs.hasStrSig: <1!L>
+DmdAnalGADTs.hasStrSig: <1!P(L)>
@@ -37,6 +37,6 @@ DmdAnalGADTs.f: <1L>
DmdAnalGADTs.f': <1L>
DmdAnalGADTs.g: <1L>
DmdAnalGADTs.hasCPR:
-DmdAnalGADTs.hasStrSig: <1!L>
+DmdAnalGADTs.hasStrSig: <1!P(L)>
diff --git a/testsuite/tests/stranal/sigs/HyperStrUse.stderr b/testsuite/tests/stranal/sigs/HyperStrUse.stderr
index 3e791439a1..08caf32af4 100644
--- a/testsuite/tests/stranal/sigs/HyperStrUse.stderr
+++ b/testsuite/tests/stranal/sigs/HyperStrUse.stderr
@@ -1,7 +1,7 @@
==================== Strictness signatures ====================
HyperStrUse.$trModule:
-HyperStrUse.f: <1!P(1!L,A)><1L>
+HyperStrUse.f: <1!P(1!P(L),A)><1L>
@@ -13,6 +13,6 @@ HyperStrUse.f: 1
==================== Strictness signatures ====================
HyperStrUse.$trModule:
-HyperStrUse.f: <1!P(1!L,A)><1L>
+HyperStrUse.f: <1!P(1!P(L),A)><1L>
diff --git a/testsuite/tests/stranal/sigs/NewtypeArity.stderr b/testsuite/tests/stranal/sigs/NewtypeArity.stderr
index 8e6de7eb90..45bc691802 100644
--- a/testsuite/tests/stranal/sigs/NewtypeArity.stderr
+++ b/testsuite/tests/stranal/sigs/NewtypeArity.stderr
@@ -3,8 +3,8 @@
Test.$tc'MkT:
Test.$tcT:
Test.$trModule:
-Test.t: <1!L><1!L>
-Test.t2: <1!L><1!L>
+Test.t: <1!P(L)><1!P(L)>
+Test.t2: <1!P(L)><1!P(L)>
@@ -21,7 +21,7 @@ Test.t2: 1
Test.$tc'MkT:
Test.$tcT:
Test.$trModule:
-Test.t: <1!L><1!L>
-Test.t2: <1!L><1!L>
+Test.t: <1!P(L)><1!P(L)>
+Test.t2: <1!P(L)><1!P(L)>
diff --git a/testsuite/tests/stranal/sigs/T12370.stderr b/testsuite/tests/stranal/sigs/T12370.stderr
index a8bbcd0e4c..dc7dbdd2e5 100644
--- a/testsuite/tests/stranal/sigs/T12370.stderr
+++ b/testsuite/tests/stranal/sigs/T12370.stderr
@@ -1,8 +1,8 @@
==================== Strictness signatures ====================
T12370.$trModule:
-T12370.bar: <1!L><1!L>
-T12370.foo: <1!P(1!L,1!L)>
+T12370.bar: <1!P(L)><1!P(L)>
+T12370.foo: <1!P(1!P(L),1!P(L))>
@@ -15,7 +15,7 @@ T12370.foo: 1
==================== Strictness signatures ====================
T12370.$trModule:
-T12370.bar: <1!L><1!L>
-T12370.foo: <1!P(1!L,1!L)>
+T12370.bar: <1!P(L)><1!P(L)>
+T12370.foo: <1!P(1!P(L),1!P(L))>
diff --git a/testsuite/tests/stranal/sigs/T13380f.stderr b/testsuite/tests/stranal/sigs/T13380f.stderr
index ad68f821d8..4b17ceae85 100644
--- a/testsuite/tests/stranal/sigs/T13380f.stderr
+++ b/testsuite/tests/stranal/sigs/T13380f.stderr
@@ -1,9 +1,9 @@
==================== Strictness signatures ====================
T13380f.$trModule:
-T13380f.f: <1!L><1!L><L>
-T13380f.g: <1!L><ML><L>
-T13380f.h: <1!L><ML><L>
+T13380f.f: <1!P(L)><1!P(L)><L>
+T13380f.g: <1!P(L)><ML><L>
+T13380f.h: <1!P(L)><ML><L>
T13380f.interruptibleCall: <L>
T13380f.safeCall: <L>
T13380f.unsafeCall: <L>
@@ -23,9 +23,9 @@ T13380f.unsafeCall: 1(, 1)
==================== Strictness signatures ====================
T13380f.$trModule:
-T13380f.f: <1!L><1!L><L>
-T13380f.g: <1!L><ML><L>
-T13380f.h: <1!L><ML><L>
+T13380f.f: <1!P(L)><1!P(L)><L>
+T13380f.g: <1!P(L)><ML><L>
+T13380f.h: <1!P(L)><ML><L>
T13380f.interruptibleCall: <L>
T13380f.safeCall: <L>
T13380f.unsafeCall: <L>
diff --git a/testsuite/tests/stranal/sigs/T16197b.stderr b/testsuite/tests/stranal/sigs/T16197b.stderr
index 96481ec378..ec45df4202 100644
--- a/testsuite/tests/stranal/sigs/T16197b.stderr
+++ b/testsuite/tests/stranal/sigs/T16197b.stderr
@@ -5,7 +5,7 @@ T16197b.$tc'T:
T16197b.$tcBox:
T16197b.$tcT:
T16197b.$trModule:
-T16197b.f: <1!L>
+T16197b.f: <1!P(L)>
@@ -25,6 +25,6 @@ T16197b.$tc'T:
T16197b.$tcBox:
T16197b.$tcT:
T16197b.$trModule:
-T16197b.f: <1!L>
+T16197b.f: <1!P(L)>
diff --git a/testsuite/tests/stranal/sigs/T16859.stderr b/testsuite/tests/stranal/sigs/T16859.stderr
index 4e32752e35..37718134a2 100644
--- a/testsuite/tests/stranal/sigs/T16859.stderr
+++ b/testsuite/tests/stranal/sigs/T16859.stderr
@@ -7,12 +7,12 @@ T16859.$tcName:
T16859.$tcNameSort:
T16859.$trModule:
T16859.bar: <1!A><L>
-T16859.baz: <1L><1!L><1C1(L)>
-T16859.buz: <1!L>
+T16859.baz: <1L><1!P(L)><1C1(L)>
+T16859.buz: <1!P(L,L)>
T16859.foo: <1L><L>
-T16859.mkInternalName: <1!L><1L><1L>
+T16859.mkInternalName: <1!P(L)><1L><1L>
T16859.n_loc: <1!P(A,A,A,1L)>
-T16859.n_occ: <1!P(A,1!L,A,A)>
+T16859.n_occ: <1!P(A,1!P(L,L),A,A)>
T16859.n_sort: <1!P(1L,A,A,A)>
T16859.n_uniq: <1!P(A,A,L,A)>
@@ -45,12 +45,12 @@ T16859.$tcName:
T16859.$tcNameSort:
T16859.$trModule:
T16859.bar: <1!A><L>
-T16859.baz: <L><1!L><1C1(L)>
-T16859.buz: <1!L>
+T16859.baz: <L><1!P(L)><1C1(L)>
+T16859.buz: <1!P(L,L)>
T16859.foo: <L><L>
-T16859.mkInternalName: <1!L><L><L>
+T16859.mkInternalName: <1!P(L)><L><L>
T16859.n_loc: <1!P(A,A,A,1L)>
-T16859.n_occ: <1!P(A,1!L,A,A)>
+T16859.n_occ: <1!P(A,1!P(L,L),A,A)>
T16859.n_sort: <1!P(1L,A,A,A)>
T16859.n_uniq: <1!P(A,A,L,A)>
diff --git a/testsuite/tests/stranal/sigs/T18907.stderr b/testsuite/tests/stranal/sigs/T18907.stderr
index 2a1c84d3d5..9d9aff99c8 100644
--- a/testsuite/tests/stranal/sigs/T18907.stderr
+++ b/testsuite/tests/stranal/sigs/T18907.stderr
@@ -3,7 +3,7 @@
T18907.$tc'H:
T18907.$tcHuge:
T18907.$trModule:
-T18907.f: <1!L>
+T18907.f: <1L>
T18907.g: <1P(SL,L,L,L,L)>
T18907.h: <1!A><1L>
T18907.m: <1!B>b
@@ -14,7 +14,7 @@ T18907.m: <1!B>b
T18907.$tc'H:
T18907.$tcHuge:
T18907.$trModule:
-T18907.f: 1
+T18907.f:
T18907.g:
T18907.h:
T18907.m: b
@@ -25,7 +25,7 @@ T18907.m: b
T18907.$tc'H:
T18907.$tcHuge:
T18907.$trModule:
-T18907.f: <1!L>
+T18907.f: <1L>
T18907.g: <1P(SL,L,L,L,L)>
T18907.h: <1!A><1L>
T18907.m: <1!B>b
diff --git a/testsuite/tests/stranal/sigs/T18957.stderr b/testsuite/tests/stranal/sigs/T18957.stderr
index c1c09c6b4a..3d730ce9fc 100644
--- a/testsuite/tests/stranal/sigs/T18957.stderr
+++ b/testsuite/tests/stranal/sigs/T18957.stderr
@@ -1,10 +1,10 @@
==================== Strictness signatures ====================
T18957.$trModule:
-T18957.g: <MCM(L)><1!L>
-T18957.h1: <SCM(L)><1!L>
-T18957.h2: <1CM(L)><1!L>
-T18957.h3: <L><1!L>
+T18957.g: <MCM(L)><1L>
+T18957.h1: <SCM(L)><1L>
+T18957.h2: <1CM(L)><1L>
+T18957.h3: <L><1L>
T18957.seq': <1A><1L>
@@ -21,10 +21,10 @@ T18957.seq':
==================== Strictness signatures ====================
T18957.$trModule:
-T18957.g: <MCM(L)><1!L>
-T18957.h1: <SCM(L)><1!L>
-T18957.h2: <1CM(L)><1!L>
-T18957.h3: <L><1!L>
+T18957.g: <MCM(L)><1L>
+T18957.h1: <SCM(L)><1L>
+T18957.h2: <1CM(L)><1L>
+T18957.h3: <L><1L>
T18957.seq': <1A><1L>
diff --git a/testsuite/tests/stranal/sigs/T19407.stderr b/testsuite/tests/stranal/sigs/T19407.stderr
index c0cec03a4d..8d4045700a 100644
--- a/testsuite/tests/stranal/sigs/T19407.stderr
+++ b/testsuite/tests/stranal/sigs/T19407.stderr
@@ -8,7 +8,7 @@ T19407.$trModule:
T19407.f: <SP(1P(1L,A,A,A,A,A,A,A,A,A,A,A,A,A,A,A,A,A,A,A,A,A),ML)>
T19407.g: <1!P(1L,A,A,A,A,A,A,A,A,A,A,A,A,A,A,A,A,A,A,A,A,A)><MP(A,ML)>
T19407.h: <1!P(1L,A)>
-T19407.n: <1!P(A,1!L)>
+T19407.n: <1!P(A,1!P(L))>
@@ -34,6 +34,6 @@ T19407.$trModule:
T19407.f: <1P(1P(1L,A,A,A,A,A,A,A,A,A,A,A,A,A,A,A,A,A,A,A,A,A),ML)>
T19407.g: <1!P(1L,A,A,A,A,A,A,A,A,A,A,A,A,A,A,A,A,A,A,A,A,A)><MP(A,ML)>
T19407.h: <1!P(1L,A)>
-T19407.n: <1!P(A,1!L)>
+T19407.n: <1!P(A,1!P(L))>
diff --git a/testsuite/tests/stranal/sigs/T19871.stderr b/testsuite/tests/stranal/sigs/T19871.stderr
index 1afea4e841..f8f465fd82 100644
--- a/testsuite/tests/stranal/sigs/T19871.stderr
+++ b/testsuite/tests/stranal/sigs/T19871.stderr
@@ -3,7 +3,7 @@
T19871.$tc'Huge:
T19871.$tcHuge:
T19871.$trModule:
-T19871.absent: <1!P(1L,ML,A,A,A,A,A,A,A,A,A,A)>
+T19871.absent: <1P(1L,ML,A,A,A,A,A,A,A,A,A,A)>
T19871.ann: <1P(SL,L,L,L,L,L,L,L,L,L,L,L)>
T19871.f1: <1!P(1L,A,A,A,A,A,A,A,A,A,A,A)>
T19871.f10: <1!P(A,A,A,A,A,A,A,A,A,1L,A,A)>
@@ -18,7 +18,7 @@ T19871.f7: <1!P(A,A,A,A,A,A,1L,A,A,A,A,A)>
T19871.f8: <1!P(A,A,A,A,A,A,A,1L,A,A,A,A)>
T19871.f9: <1!P(A,A,A,A,A,A,A,A,1L,A,A,A)>
T19871.guarded: <MCM(L)><1P(SL,L,L,L,L,L,L,L,L,L,L,L)>
-T19871.sumIO: <1!P(1L)><1!L><L>
+T19871.sumIO: <1!P(1L)><1!P(L)><L>
T19871.update: <1P(SL,L,L,L,L,L,L,L,L,L,L,L)>
@@ -51,7 +51,7 @@ T19871.update: 1
T19871.$tc'Huge:
T19871.$tcHuge:
T19871.$trModule:
-T19871.absent: <1!P(1L,ML,A,A,A,A,A,A,A,A,A,A)>
+T19871.absent: <1P(1L,ML,A,A,A,A,A,A,A,A,A,A)>
T19871.ann: <1P(SL,L,L,L,L,L,L,L,L,L,L,L)>
T19871.f1: <1!P(1L,A,A,A,A,A,A,A,A,A,A,A)>
T19871.f10: <1!P(A,A,A,A,A,A,A,A,A,1L,A,A)>
@@ -66,7 +66,7 @@ T19871.f7: <1!P(A,A,A,A,A,A,1L,A,A,A,A,A)>
T19871.f8: <1!P(A,A,A,A,A,A,A,1L,A,A,A,A)>
T19871.f9: <1!P(A,A,A,A,A,A,A,A,1L,A,A,A)>
T19871.guarded: <MCM(L)><1P(SL,L,L,L,L,L,L,L,L,L,L,L)>
-T19871.sumIO: <1!P(1L)><1!L><L>
+T19871.sumIO: <1!P(1L)><1!P(L)><L>
T19871.update: <1P(SL,L,L,L,L,L,L,L,L,L,L,L)>
diff --git a/testsuite/tests/stranal/should_compile/T20746.hs b/testsuite/tests/stranal/sigs/T20746.hs
index 93496acd65..93496acd65 100644
--- a/testsuite/tests/stranal/should_compile/T20746.hs
+++ b/testsuite/tests/stranal/sigs/T20746.hs
diff --git a/testsuite/tests/stranal/sigs/T20746.stderr b/testsuite/tests/stranal/sigs/T20746.stderr
new file mode 100644
index 0000000000..b0656cd13d
--- /dev/null
+++ b/testsuite/tests/stranal/sigs/T20746.stderr
@@ -0,0 +1,21 @@
+
+==================== Strictness signatures ====================
+Foo.$trModule:
+Foo.f: <MP(A,MCM(L),A)><L>
+Foo.foogle: <L><L>
+
+
+
+==================== Cpr signatures ====================
+Foo.$trModule:
+Foo.f: 1
+Foo.foogle: 1
+
+
+
+==================== Strictness signatures ====================
+Foo.$trModule:
+Foo.f: <MP(A,MCM(L),A)><L>
+Foo.foogle: <L><L>
+
+
diff --git a/testsuite/tests/stranal/should_compile/T20746b.hs b/testsuite/tests/stranal/sigs/T20746b.hs
index 6804fb4449..9ab7cc7d4b 100644
--- a/testsuite/tests/stranal/should_compile/T20746b.hs
+++ b/testsuite/tests/stranal/sigs/T20746b.hs
@@ -9,6 +9,6 @@ mightThrow n = return n
-- we don't do worker/wrapper at all
f :: Bool -> (Int, Int, Int) -> IO (Int, Int, Int)
f False trp = f True trp
-f True trp@(a,b,c) = do
+f True trp@(~(a,b,c)) = do
_ <- mightThrow a -- this potentially throwing IO action should not force unboxing of trp
- return trp
+ return $! trp
diff --git a/testsuite/tests/stranal/sigs/T20746b.stderr b/testsuite/tests/stranal/sigs/T20746b.stderr
new file mode 100644
index 0000000000..bd23944c61
--- /dev/null
+++ b/testsuite/tests/stranal/sigs/T20746b.stderr
@@ -0,0 +1,21 @@
+
+==================== Strictness signatures ====================
+T20746b.$trModule:
+T20746b.f: <1L><L><L>
+T20746b.mightThrow: <L><L>
+
+
+
+==================== Cpr signatures ====================
+T20746b.$trModule:
+T20746b.f: 1
+T20746b.mightThrow: 1
+
+
+
+==================== Strictness signatures ====================
+T20746b.$trModule:
+T20746b.f: <1L><L><L>
+T20746b.mightThrow: <L><L>
+
+
diff --git a/testsuite/tests/stranal/sigs/T21119.hs b/testsuite/tests/stranal/sigs/T21119.hs
new file mode 100644
index 0000000000..7be2cf1788
--- /dev/null
+++ b/testsuite/tests/stranal/sigs/T21119.hs
@@ -0,0 +1,30 @@
+-- {-# OPTIONS_GHC -Wincomplete-patterns -fforce-recomp #-}
+-- {-# OPTIONS_GHC -O2 -fforce-recomp #-}
+-- {-# LANGUAGE PatternSynonyms #-}
+-- {-# LANGUAGE BangPatterns #-}
+-- {-# LANGUAGE MagicHash, UnboxedTuples #-}
+module T21119 where
+
+import Control.Exception
+
+indexError :: Show a => (a, a) -> a -> String -> b
+indexError rng i s = error (show rng ++ show i ++ show s)
+
+get :: (Int, Int) -> Int -> [a] -> a
+get p@(l,u) i xs
+ | l <= i, i < u = xs !! (i-u)
+ | otherwise = indexError p i "get"
+
+-- Now the same with precise exceptions:
+
+throwIndexError :: Show a => (a, a) -> a -> String -> IO b
+throwIndexError rng i s = throwIO (userError (show rng ++ show i ++ show s))
+
+-- It's important that we don't unbox 'u' here.
+-- We may or may not unbox 'p' and 'l'.
+-- Last time I checked, we didn't unbox 'p' and 'l', because 'throwIndexError'
+-- isn't strict in them. That's fine.
+getIO :: (Int, Int) -> Int -> [a] -> IO a
+getIO p@(l,u) i xs
+ | l <= i, i < u = return $! xs !! (i-u)
+ | otherwise = throwIndexError p i "get"
diff --git a/testsuite/tests/stranal/sigs/T21119.stderr b/testsuite/tests/stranal/sigs/T21119.stderr
new file mode 100644
index 0000000000..dfefcdea03
--- /dev/null
+++ b/testsuite/tests/stranal/sigs/T21119.stderr
@@ -0,0 +1,27 @@
+
+==================== Strictness signatures ====================
+T21119.$trModule:
+T21119.get: <1!P(S!P(L),S!P(L))><1!P(L)><1L>
+T21119.getIO: <1P(SL,L)><1L><ML><L>
+T21119.indexError: <S!P(SCS(C1(L)),1C1(L),B)><1!S><S!S><1!S>b
+T21119.throwIndexError: <LP(LCL(C1(L)),MCM(L),A)><ML><L><ML><L>x
+
+
+
+==================== Cpr signatures ====================
+T21119.$trModule:
+T21119.get:
+T21119.getIO: 1
+T21119.indexError: b
+T21119.throwIndexError: b
+
+
+
+==================== Strictness signatures ====================
+T21119.$trModule:
+T21119.get: <1!P(1!P(L),1!P(L))><1!P(L)><1L>
+T21119.getIO: <1P(SL,L)><1L><ML><L>
+T21119.indexError: <1P(SCS(C1(L)),1C1(L),B)><1!S><S!S><1!S>b
+T21119.throwIndexError: <LP(LCL(C1(L)),MCM(L),A)><ML><L><ML><L>x
+
+
diff --git a/testsuite/tests/stranal/sigs/T5075.stderr b/testsuite/tests/stranal/sigs/T5075.stderr
index 7652a16f0a..e367385d52 100644
--- a/testsuite/tests/stranal/sigs/T5075.stderr
+++ b/testsuite/tests/stranal/sigs/T5075.stderr
@@ -2,15 +2,15 @@
==================== Strictness signatures ====================
T5075.$trModule:
T5075.f: <S!P(A,A,SCS(C1(L)),A,A,A,A,A)><LP(A,A,LCL(C1(L)),A,A,A,L)><L>
-T5075.g: <1!L><S!L>
-T5075.h: <S!L>
+T5075.g: <1L><S!P(L)>
+T5075.h: <S!P(L)>
==================== Cpr signatures ====================
T5075.$trModule:
T5075.f: 1
-T5075.g: 2(1)
+T5075.g: 2
T5075.h:
@@ -18,7 +18,7 @@ T5075.h:
==================== Strictness signatures ====================
T5075.$trModule:
T5075.f: <1P(A,A,SCS(C1(L)),A,A,A,A,A)><LP(A,A,LCL(C1(L)),A,A,A,L)><L>
-T5075.g: <1!L><S!L>
-T5075.h: <1!L>
+T5075.g: <1L><S!P(L)>
+T5075.h: <1!P(L)>
diff --git a/testsuite/tests/stranal/sigs/T8598.stderr b/testsuite/tests/stranal/sigs/T8598.stderr
index e8813a0fc8..747c6a096b 100644
--- a/testsuite/tests/stranal/sigs/T8598.stderr
+++ b/testsuite/tests/stranal/sigs/T8598.stderr
@@ -1,7 +1,7 @@
==================== Strictness signatures ====================
T8598.$trModule:
-T8598.fun: <1!L>
+T8598.fun: <1!P(L)>
@@ -13,6 +13,6 @@ T8598.fun: 1
==================== Strictness signatures ====================
T8598.$trModule:
-T8598.fun: <1!L>
+T8598.fun: <1!P(L)>
diff --git a/testsuite/tests/stranal/sigs/all.T b/testsuite/tests/stranal/sigs/all.T
index 95065c2d23..59a4891f6d 100644
--- a/testsuite/tests/stranal/sigs/all.T
+++ b/testsuite/tests/stranal/sigs/all.T
@@ -29,3 +29,6 @@ test('T19871', normal, compile, [''])
test('T16859', normal, compile, ['-package ghc'])
test('T18907', normal, compile, [''])
test('T13331', normal, compile, [''])
+test('T20746', normal, compile, [''])
+test('T20746b', normal, compile, [''])
+test('T21119', normal, compile, [''])