diff options
Diffstat (limited to 'testsuite/tests/stranal/sigs')
25 files changed, 518 insertions, 48 deletions
diff --git a/testsuite/tests/stranal/sigs/BottomFromInnerLambda.stderr b/testsuite/tests/stranal/sigs/BottomFromInnerLambda.stderr index c1fa7f22e6..075a819db8 100644 --- a/testsuite/tests/stranal/sigs/BottomFromInnerLambda.stderr +++ b/testsuite/tests/stranal/sigs/BottomFromInnerLambda.stderr @@ -1,8 +1,8 @@ ==================== Strictness signatures ==================== BottomFromInnerLambda.$trModule: -BottomFromInnerLambda.expensive: <1P(SL)> -BottomFromInnerLambda.f: <1P(SL)> +BottomFromInnerLambda.expensive: <1!P(SL)> +BottomFromInnerLambda.f: <1!P(SL)> @@ -15,7 +15,7 @@ BottomFromInnerLambda.f: ==================== Strictness signatures ==================== BottomFromInnerLambda.$trModule: -BottomFromInnerLambda.expensive: <1P(1L)> -BottomFromInnerLambda.f: <1P(1L)> +BottomFromInnerLambda.expensive: <1!P(1L)> +BottomFromInnerLambda.f: <1!P(1L)> diff --git a/testsuite/tests/stranal/sigs/DmdAnalGADTs.stderr b/testsuite/tests/stranal/sigs/DmdAnalGADTs.stderr index 4cbc565ee2..ea089c36be 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: <1P(L)> +DmdAnalGADTs.hasStrSig: <1!L> @@ -37,6 +37,6 @@ DmdAnalGADTs.f: <1L> DmdAnalGADTs.f': <1L> DmdAnalGADTs.g: <1L> DmdAnalGADTs.hasCPR: -DmdAnalGADTs.hasStrSig: <1P(L)> +DmdAnalGADTs.hasStrSig: <1!L> diff --git a/testsuite/tests/stranal/sigs/HyperStrUse.stderr b/testsuite/tests/stranal/sigs/HyperStrUse.stderr index 09829ae4fa..3e791439a1 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: <1P(1P(L),A)><1L> +HyperStrUse.f: <1!P(1!L,A)><1L> @@ -13,6 +13,6 @@ HyperStrUse.f: 1 ==================== Strictness signatures ==================== HyperStrUse.$trModule: -HyperStrUse.f: <1P(1P(L),A)><1L> +HyperStrUse.f: <1!P(1!L,A)><1L> diff --git a/testsuite/tests/stranal/sigs/NewtypeArity.stderr b/testsuite/tests/stranal/sigs/NewtypeArity.stderr index 66a810f5a5..8e6de7eb90 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: <1P(L)><1P(L)> -Test.t2: <1P(L)><1P(L)> +Test.t: <1!L><1!L> +Test.t2: <1!L><1!L> @@ -21,7 +21,7 @@ Test.t2: 1 Test.$tc'MkT: Test.$tcT: Test.$trModule: -Test.t: <1P(L)><1P(L)> -Test.t2: <1P(L)><1P(L)> +Test.t: <1!L><1!L> +Test.t2: <1!L><1!L> diff --git a/testsuite/tests/stranal/sigs/T12370.stderr b/testsuite/tests/stranal/sigs/T12370.stderr index ac5eb53888..a8bbcd0e4c 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: <1P(L)><1P(L)> -T12370.foo: <1P(1P(L),1P(L))> +T12370.bar: <1!L><1!L> +T12370.foo: <1!P(1!L,1!L)> @@ -15,7 +15,7 @@ T12370.foo: 1 ==================== Strictness signatures ==================== T12370.$trModule: -T12370.bar: <1P(L)><1P(L)> -T12370.foo: <1P(1P(L),1P(L))> +T12370.bar: <1!L><1!L> +T12370.foo: <1!P(1!L,1!L)> diff --git a/testsuite/tests/stranal/sigs/T13331.hs b/testsuite/tests/stranal/sigs/T13331.hs new file mode 100644 index 0000000000..5f4a4a1631 --- /dev/null +++ b/testsuite/tests/stranal/sigs/T13331.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE MagicHash, BangPatterns #-} + +module T13331 (naiveInsertInt) where + +data Map k a = Bin !Int !k a (Map k a) (Map k a) + | Tip + +singleton :: k -> a -> Map k a +singleton k a = Bin 1 k a Tip Tip + +balanceL :: k -> a -> Map k a -> Map k a -> Map k a +balanceL !_ _ !_ !_ = undefined +{-# NOINLINE balanceL #-} + +balanceR :: k -> a -> Map k a -> Map k a -> Map k a +balanceR !_ _ !_ !_ = undefined +{-# NOINLINE balanceR #-} + +-- | Should not unbox `kx`. +naiveInsertInt :: Int -> a -> Map Int a -> Map Int a +naiveInsertInt !kx x Tip = singleton kx x +naiveInsertInt !kx x t@(Bin sz ky y l r) = + case compare kx ky of + LT -> balanceL ky y l' r + where !l' = naiveInsertInt kx x l + GT -> balanceR ky y l r' + where !r' = naiveInsertInt kx x r + EQ -> Bin sz kx x l r + diff --git a/testsuite/tests/stranal/sigs/T13331.stderr b/testsuite/tests/stranal/sigs/T13331.stderr new file mode 100644 index 0000000000..78cccb7fe4 --- /dev/null +++ b/testsuite/tests/stranal/sigs/T13331.stderr @@ -0,0 +1,27 @@ + +==================== Strictness signatures ==================== +T13331.$tc'Bin: +T13331.$tc'Tip: +T13331.$tcMap: +T13331.$trModule: +T13331.naiveInsertInt: <1L><L><1L> + + + +==================== Cpr signatures ==================== +T13331.$tc'Bin: +T13331.$tc'Tip: +T13331.$tcMap: +T13331.$trModule: +T13331.naiveInsertInt: + + + +==================== Strictness signatures ==================== +T13331.$tc'Bin: +T13331.$tc'Tip: +T13331.$tcMap: +T13331.$trModule: +T13331.naiveInsertInt: <1L><L><1L> + + diff --git a/testsuite/tests/stranal/sigs/T13380f.stderr b/testsuite/tests/stranal/sigs/T13380f.stderr index f4caa18a11..ad68f821d8 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: <1P(L)><1P(L)><L> -T13380f.g: <1P(L)><MP(L)><L> -T13380f.h: <1P(L)><MP(L)><L> +T13380f.f: <1!L><1!L><L> +T13380f.g: <1!L><ML><L> +T13380f.h: <1!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: <1P(L)><1P(L)><L> -T13380f.g: <1P(L)><MP(L)><L> -T13380f.h: <1P(L)><MP(L)><L> +T13380f.f: <1!L><1!L><L> +T13380f.g: <1!L><ML><L> +T13380f.h: <1!L><ML><L> T13380f.interruptibleCall: <L> T13380f.safeCall: <L> T13380f.unsafeCall: <L> diff --git a/testsuite/tests/stranal/sigs/T16197b.hs b/testsuite/tests/stranal/sigs/T16197b.hs new file mode 100644 index 0000000000..4ce440d3bf --- /dev/null +++ b/testsuite/tests/stranal/sigs/T16197b.hs @@ -0,0 +1,12 @@ +-- | The same as T16197, but a bit more distilled. +-- Important takeaway: The signature of `f` may not say "strict in the Bool +-- field of T", otherwise the Simplifier will drop the `seq` on the `Bool` at +-- call sites after unboxing the `T`. +module T16197b where + +data T = T !Bool +data Box a = Box a + +f :: T -> Box Bool +f (T b) = Box b +{-# NOINLINE f #-} -- I like NOINLINE better than artificial recursion, YMMV diff --git a/testsuite/tests/stranal/sigs/T16197b.stderr b/testsuite/tests/stranal/sigs/T16197b.stderr new file mode 100644 index 0000000000..96481ec378 --- /dev/null +++ b/testsuite/tests/stranal/sigs/T16197b.stderr @@ -0,0 +1,30 @@ + +==================== Strictness signatures ==================== +T16197b.$tc'Box: +T16197b.$tc'T: +T16197b.$tcBox: +T16197b.$tcT: +T16197b.$trModule: +T16197b.f: <1!L> + + + +==================== Cpr signatures ==================== +T16197b.$tc'Box: +T16197b.$tc'T: +T16197b.$tcBox: +T16197b.$tcT: +T16197b.$trModule: +T16197b.f: 1 + + + +==================== Strictness signatures ==================== +T16197b.$tc'Box: +T16197b.$tc'T: +T16197b.$tcBox: +T16197b.$tcT: +T16197b.$trModule: +T16197b.f: <1!L> + + diff --git a/testsuite/tests/stranal/sigs/T16859.hs b/testsuite/tests/stranal/sigs/T16859.hs new file mode 100644 index 0000000000..59af81785e --- /dev/null +++ b/testsuite/tests/stranal/sigs/T16859.hs @@ -0,0 +1,41 @@ +module T16859 where + +import GHC.Types.Name (OccName) +import GHC.Types.SrcLoc +import GHC.Types.Unique + +data NameSort = Internal | External + +data Name = Name { + n_sort :: NameSort, -- What sort of name it is + n_occ :: !OccName, -- Its occurrence name + n_uniq :: {-# UNPACK #-} !Unique, + n_loc :: !SrcSpan -- Definition site + } + +{-# NOINLINE mkInternalName #-} +mkInternalName :: Unique -> OccName -> SrcSpan -> Name +mkInternalName uniq occ loc = Name { n_uniq = uniq + , n_sort = Internal + , n_occ = occ + , n_loc = loc } + +-- | Should not unbox `x`. +foo :: Int -> Int -> (Int, Int) +foo x y = x `seq` (x, y) +{-# NOINLINE foo #-} + +-- | Should unbox `x`. +bar :: Int -> Int -> (Int, Int) +bar x y = x `seq` (y, y) +{-# NOINLINE bar #-} + +-- | Should not unbox `x`. +baz :: Int -> Int -> (Int -> Int) -> Int +baz x y f = x `seq` (f x + y) +{-# NOINLINE baz #-} + +-- | Should unbox `p`. +buz :: (Int, Int) -> (Int, Int) +buz p@(x,y) = (y,x) +{-# NOINLINE buz #-} diff --git a/testsuite/tests/stranal/sigs/T16859.stderr b/testsuite/tests/stranal/sigs/T16859.stderr new file mode 100644 index 0000000000..56c711f807 --- /dev/null +++ b/testsuite/tests/stranal/sigs/T16859.stderr @@ -0,0 +1,57 @@ + +==================== Strictness signatures ==================== +T16859.$tc'External: +T16859.$tc'Internal: +T16859.$tc'Name: +T16859.$tcName: +T16859.$tcNameSort: +T16859.$trModule: +T16859.bar: <1!A><L> +T16859.baz: <1L><1!L><1C1(L)> +T16859.buz: <1!L> +T16859.foo: <1L><L> +T16859.mkInternalName: <1!L><1L><1L> +T16859.n_loc: <1!P(A,A,A,1L)> +T16859.n_occ: <1!P(A,1!L,A,A)> +T16859.n_sort: <1!P(1L,A,A,A)> +T16859.n_uniq: <1!P(A,A,L,A)> + + + +==================== Cpr signatures ==================== +T16859.$tc'External: +T16859.$tc'Internal: +T16859.$tc'Name: +T16859.$tcName: +T16859.$tcNameSort: +T16859.$trModule: +T16859.bar: 1 +T16859.baz: 1 +T16859.buz: 1 +T16859.foo: 1 +T16859.mkInternalName: 1(1, , ,) +T16859.n_loc: +T16859.n_occ: 1 +T16859.n_sort: +T16859.n_uniq: 1 + + + +==================== Strictness signatures ==================== +T16859.$tc'External: +T16859.$tc'Internal: +T16859.$tc'Name: +T16859.$tcName: +T16859.$tcNameSort: +T16859.$trModule: +T16859.bar: <1!A><L> +T16859.baz: <1L><1!L><1C1(L)> +T16859.buz: <1!L> +T16859.foo: <1L><L> +T16859.mkInternalName: <1!L><1L><1L> +T16859.n_loc: <1!P(A,A,A,1L)> +T16859.n_occ: <1!P(A,1!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/T17932.stderr b/testsuite/tests/stranal/sigs/T17932.stderr index 0875f5844e..dadd60b491 100644 --- a/testsuite/tests/stranal/sigs/T17932.stderr +++ b/testsuite/tests/stranal/sigs/T17932.stderr @@ -5,7 +5,7 @@ T17932.$tc'X: T17932.$tcOptions: T17932.$tcX: T17932.$trModule: -T17932.flags: <1P(1L,1L)> +T17932.flags: <1!P(1L,1L)> @@ -25,6 +25,6 @@ T17932.$tc'X: T17932.$tcOptions: T17932.$tcX: T17932.$trModule: -T17932.flags: <1P(1L,1L)> +T17932.flags: <1!P(1L,1L)> diff --git a/testsuite/tests/stranal/sigs/T18907.hs b/testsuite/tests/stranal/sigs/T18907.hs new file mode 100644 index 0000000000..0a5c0fb50b --- /dev/null +++ b/testsuite/tests/stranal/sigs/T18907.hs @@ -0,0 +1,32 @@ +module T18907 (m, f, g, h) where + +import Control.Monad (forever) +import Control.Monad.Trans.State.Strict + +inc :: State Int () +inc = modify' (+1) + +m :: State Int () +m = forever inc + +data Huge = H Int Int Int Int Int + +-- | Should not unbox `x`. +f :: Huge -> Huge +f !x + | sum [0..24::Int] == 1 = x + | otherwise = H 0 0 0 0 0 +{-# NOINLINE f #-} + +-- | Should not unbox `x`. +g :: Huge -> Huge +g x@(H a b c d e) = a `seq` x +{-# NOINLINE g #-} + +seq' a b = seq a b +{-# NOINLINE seq' #-} + +-- | Should not unbox `y`. Unboxing `x` is OK. +h :: Int -> Int -> Int +h x y = (x+1) `seq'` y +{-# NOINLINE h #-} diff --git a/testsuite/tests/stranal/sigs/T18907.stderr b/testsuite/tests/stranal/sigs/T18907.stderr new file mode 100644 index 0000000000..2a1c84d3d5 --- /dev/null +++ b/testsuite/tests/stranal/sigs/T18907.stderr @@ -0,0 +1,33 @@ + +==================== Strictness signatures ==================== +T18907.$tc'H: +T18907.$tcHuge: +T18907.$trModule: +T18907.f: <1!L> +T18907.g: <1P(SL,L,L,L,L)> +T18907.h: <1!A><1L> +T18907.m: <1!B>b + + + +==================== Cpr signatures ==================== +T18907.$tc'H: +T18907.$tcHuge: +T18907.$trModule: +T18907.f: 1 +T18907.g: +T18907.h: +T18907.m: b + + + +==================== Strictness signatures ==================== +T18907.$tc'H: +T18907.$tcHuge: +T18907.$trModule: +T18907.f: <1!L> +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.hs b/testsuite/tests/stranal/sigs/T18957.hs index 9781b7cd58..8f4550696d 100644 --- a/testsuite/tests/stranal/sigs/T18957.hs +++ b/testsuite/tests/stranal/sigs/T18957.hs @@ -1,11 +1,13 @@ {-# OPTIONS_GHC -O2 -fforce-recomp #-} {-# LANGUAGE BangPatterns #-} --- | This ticket is about demand `seq` puts its first argument under and --- how that affects call demands. +-- | This ticket is about the demand `seq` puts its first argument under and how +-- that affects call demands. module T18957 where -- | Should put its first argument under head demand +-- Note that seq' is like seq, but NOINLINE, so the calling code will not have +-- access to the case binder. That is the difference between 'h1' and 'h2'. seq' :: a -> b -> b seq' a b = seq a b {-# NOINLINE seq' #-} @@ -18,7 +20,6 @@ g f x = if x < 100 then f x else 200 -- | The first argument is evaluated multiple times, but called at most once -- every time it's evaluated h1 :: (Int -> Int) -> Int -> Int --- Note that seq' is like seq, but NOINLINE. See h2 below why h1 f x = f `seq'` if x < 100 then f x else 200 -- | Like h1, but using `seq` directly, which will rewrite the call site diff --git a/testsuite/tests/stranal/sigs/T18957.stderr b/testsuite/tests/stranal/sigs/T18957.stderr index 6795bf0dab..c1c09c6b4a 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)><1P(L)> -T18957.h1: <SCM(L)><1P(L)> -T18957.h2: <1CM(L)><1P(L)> -T18957.h3: <LCL(P(L))><1P(L)> +T18957.g: <MCM(L)><1!L> +T18957.h1: <SCM(L)><1!L> +T18957.h2: <1CM(L)><1!L> +T18957.h3: <L><1!L> T18957.seq': <1A><1L> @@ -21,10 +21,10 @@ T18957.seq': ==================== Strictness signatures ==================== T18957.$trModule: -T18957.g: <MCM(L)><1P(L)> -T18957.h1: <SCM(L)><1P(L)> -T18957.h2: <1CM(L)><1P(L)> -T18957.h3: <LCL(P(L))><1P(L)> +T18957.g: <MCM(L)><1!L> +T18957.h1: <SCM(L)><1!L> +T18957.h2: <1CM(L)><1!L> +T18957.h3: <L><1!L> T18957.seq': <1A><1L> diff --git a/testsuite/tests/stranal/sigs/T19407.hs b/testsuite/tests/stranal/sigs/T19407.hs new file mode 100644 index 0000000000..f404d48de0 --- /dev/null +++ b/testsuite/tests/stranal/sigs/T19407.hs @@ -0,0 +1,21 @@ +{-# OPTIONS_GHC -O2 -fforce-recomp #-} + +-- | The gist here: `f` is strict in `t::T` and its field `h::Huge`, but mustn't unbox it. +-- Otherwise, `$wf` has to rebox it for the call to `$wg` (which is lazy in `t`) and that +-- also means reconstructing `h`, although most fields are absent anyway. +-- +-- Solution: `g` is lazy in `t` and we can't unbox it. Thus, its signature +-- shouldn't say `Unboxed` for `t`! +module T19407 where + +data Huge = Huge Bool () () () () () () () () () () () () () () () () () () () () () +data T = T { h :: Huge, n :: Int } + +f :: T -> Int -- like warnAboutOverflowedLit +f t = g (h t) t +{-# NOINLINE f #-} + +g :: Huge -> T -> Int -- like warnAboutOverflowedLiterals +g (Huge b _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _ _) t = + if b then 0 else n t +{-# NOINLINE g #-} diff --git a/testsuite/tests/stranal/sigs/T19407.stderr b/testsuite/tests/stranal/sigs/T19407.stderr new file mode 100644 index 0000000000..c0cec03a4d --- /dev/null +++ b/testsuite/tests/stranal/sigs/T19407.stderr @@ -0,0 +1,39 @@ + +==================== Strictness signatures ==================== +T19407.$tc'Huge: +T19407.$tc'T: +T19407.$tcHuge: +T19407.$tcT: +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)> + + + +==================== Cpr signatures ==================== +T19407.$tc'Huge: +T19407.$tc'T: +T19407.$tcHuge: +T19407.$tcT: +T19407.$trModule: +T19407.f: +T19407.g: +T19407.h: +T19407.n: 1 + + + +==================== Strictness signatures ==================== +T19407.$tc'Huge: +T19407.$tc'T: +T19407.$tcHuge: +T19407.$tcT: +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)> + + diff --git a/testsuite/tests/stranal/sigs/T19871.hs b/testsuite/tests/stranal/sigs/T19871.hs new file mode 100644 index 0000000000..564a055df4 --- /dev/null +++ b/testsuite/tests/stranal/sigs/T19871.hs @@ -0,0 +1,70 @@ +{-# OPTIONS_GHC -O2 -fforce-recomp #-} + +-- | From Note [Boxity Analysis] and related Notes +module T19871 where + +data Huge + = Huge + { f1 :: Bool + , f2 :: Bool + , f3 :: Bool + , f4 :: Bool + , f5 :: Bool + , f6 :: Bool + , f7 :: Bool + , f8 :: Bool + , f9 :: Bool + , f10 :: Bool + , f11 :: Bool + , f12 :: Bool } + +-- | Should not unbox Huge +ann :: Huge -> (Bool, Huge) +ann h@(Huge{f1=True}) = (False, h) +ann h = (True, h) +{-# NOINLINE ann #-} + +-- A few examples demonstrating the lubBoxity = unboxedWins tradeoff + +-- | Should unbox 'z'. +-- We won't with `lubBoxity = boxedWins`. +-- We will with `lubBoxity = unboxedWins`. +sumIO :: Int -> Int -> IO Int +sumIO 0 !z = return z +sumIO n !z = sumIO (n-1) (z+n) +{-# NOINLINE sumIO #-} + +-- | Should /not/ unbox 'h'. +-- We won't with `lubBoxity = boxedWins`. +-- We will with `lubBoxity = unboxedWins`. +update :: Huge -> (Bool, Huge) +update h@(Huge{f1=True}) = (False, h{f1=False}) +update h = (True, h) +{-# NOINLINE update #-} + +-- | Should /not/ unbox 'h'. +-- We won't with `lubBoxity = boxedWins`. +-- We will with `lubBoxity = unboxedWins`. +guarded :: (Huge -> Bool) -> Huge -> Bool +guarded g h | f1 h = True + | otherwise = g h +{-# NOINLINE guarded #-} + +-- | Should /not/ unbox 'h'. +-- We won't with `lubBoxity = boxedWins`. +-- We will with `lubBoxity = unboxedWins`. +-- +-- This example also demonstrates the usefulness of carrying a Boxity in Poly. +-- Most absent sub-demands here should be considered Boxed (and of course we +-- also need Unboxed absent Poly). See Note [Boxity in Poly]. +absent :: Huge -> Int +absent h = if f1 h || f2 h then g h else 2 + where + g :: a -> Int + g a = a `seq` f a True + {-# NOINLINE g #-} + f :: a -> Bool -> Int + f _ True = 1 + f a False = a `seq` 2 + {-# NOINLINE f #-} +{-# NOINLINE absent #-} diff --git a/testsuite/tests/stranal/sigs/T19871.stderr b/testsuite/tests/stranal/sigs/T19871.stderr new file mode 100644 index 0000000000..14619b5891 --- /dev/null +++ b/testsuite/tests/stranal/sigs/T19871.stderr @@ -0,0 +1,72 @@ + +==================== Strictness signatures ==================== +T19871.$tc'Huge: +T19871.$tcHuge: +T19871.$trModule: +T19871.absent: <1!P(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)> +T19871.f11: <1!P(A,A,A,A,A,A,A,A,A,A,1L,A)> +T19871.f12: <1!P(A,A,A,A,A,A,A,A,A,A,A,1L)> +T19871.f2: <1!P(A,1L,A,A,A,A,A,A,A,A,A,A)> +T19871.f3: <1!P(A,A,1L,A,A,A,A,A,A,A,A,A)> +T19871.f4: <1!P(A,A,A,1L,A,A,A,A,A,A,A,A)> +T19871.f5: <1!P(A,A,A,A,1L,A,A,A,A,A,A,A)> +T19871.f6: <1!P(A,A,A,A,A,1L,A,A,A,A,A,A)> +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)><1!P(SL,L,L,L,L,L,L,L,L,L,L,L)> +T19871.sumIO: <1!P(1L)><1!L><L> +T19871.update: <1!P(SL,L,L,L,L,L,L,L,L,L,L,L)> + + + +==================== Cpr signatures ==================== +T19871.$tc'Huge: +T19871.$tcHuge: +T19871.$trModule: +T19871.absent: 1 +T19871.ann: 1 +T19871.f1: +T19871.f10: +T19871.f11: +T19871.f12: +T19871.f2: +T19871.f3: +T19871.f4: +T19871.f5: +T19871.f6: +T19871.f7: +T19871.f8: +T19871.f9: +T19871.guarded: +T19871.sumIO: 1(, 1) +T19871.update: 1 + + + +==================== Strictness signatures ==================== +T19871.$tc'Huge: +T19871.$tcHuge: +T19871.$trModule: +T19871.absent: <1!P(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)> +T19871.f11: <1!P(A,A,A,A,A,A,A,A,A,A,1L,A)> +T19871.f12: <1!P(A,A,A,A,A,A,A,A,A,A,A,1L)> +T19871.f2: <1!P(A,1L,A,A,A,A,A,A,A,A,A,A)> +T19871.f3: <1!P(A,A,1L,A,A,A,A,A,A,A,A,A)> +T19871.f4: <1!P(A,A,A,1L,A,A,A,A,A,A,A,A)> +T19871.f5: <1!P(A,A,A,A,1L,A,A,A,A,A,A,A)> +T19871.f6: <1!P(A,A,A,A,A,1L,A,A,A,A,A,A)> +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)><1!P(SL,L,L,L,L,L,L,L,L,L,L,L)> +T19871.sumIO: <1!P(1L)><1!L><L> +T19871.update: <1!P(SL,L,L,L,L,L,L,L,L,L,L,L)> + + diff --git a/testsuite/tests/stranal/sigs/T5075.stderr b/testsuite/tests/stranal/sigs/T5075.stderr index c9625db721..7652a16f0a 100644 --- a/testsuite/tests/stranal/sigs/T5075.stderr +++ b/testsuite/tests/stranal/sigs/T5075.stderr @@ -1,9 +1,9 @@ ==================== Strictness signatures ==================== T5075.$trModule: -T5075.f: <SP(A,A,SCS(C1(L)),A,A,A,A,A)><LP(A,A,LCL(C1(L)),A,A,A,L)><L> -T5075.g: <1P(L)><SP(L)> -T5075.h: <SP(L)> +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> @@ -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: <1P(L)><SP(L)> -T5075.h: <1P(L)> +T5075.g: <1!L><S!L> +T5075.h: <1!L> diff --git a/testsuite/tests/stranal/sigs/T8598.stderr b/testsuite/tests/stranal/sigs/T8598.stderr index db7c97f807..e8813a0fc8 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: <1P(L)> +T8598.fun: <1!L> @@ -13,6 +13,6 @@ T8598.fun: 1 ==================== Strictness signatures ==================== T8598.$trModule: -T8598.fun: <1P(L)> +T8598.fun: <1!L> diff --git a/testsuite/tests/stranal/sigs/UnsatFun.stderr b/testsuite/tests/stranal/sigs/UnsatFun.stderr index b3ccac6f6e..a9c3ca340a 100644 --- a/testsuite/tests/stranal/sigs/UnsatFun.stderr +++ b/testsuite/tests/stranal/sigs/UnsatFun.stderr @@ -1,9 +1,9 @@ ==================== Strictness signatures ==================== UnsatFun.$trModule: -UnsatFun.f: <1P(S)><B>b -UnsatFun.g: <1P(S)>b -UnsatFun.g': <MP(L)> +UnsatFun.f: <1!S><B>b +UnsatFun.g: <1!S>b +UnsatFun.g': <ML> UnsatFun.g3: <A> UnsatFun.h: <1C1(L)> UnsatFun.h2: <1L><MCM(L)> @@ -25,9 +25,9 @@ UnsatFun.h3: 1 ==================== Strictness signatures ==================== UnsatFun.$trModule: -UnsatFun.f: <1P(S)><B>b -UnsatFun.g: <1P(S)>b -UnsatFun.g': <MP(L)> +UnsatFun.f: <1!S><B>b +UnsatFun.g: <1!S>b +UnsatFun.g': <ML> UnsatFun.g3: <A> UnsatFun.h: <1C1(L)> UnsatFun.h2: <1L><MCM(L)> diff --git a/testsuite/tests/stranal/sigs/all.T b/testsuite/tests/stranal/sigs/all.T index 5d562a6a8c..95065c2d23 100644 --- a/testsuite/tests/stranal/sigs/all.T +++ b/testsuite/tests/stranal/sigs/all.T @@ -23,3 +23,9 @@ test('T13380c', expect_broken('!3014'), compile, ['']) test('T13380f', normal, compile, ['']) test('T18086', normal, compile, ['-package ghc']) test('T18957', normal, compile, ['']) +test('T16197b', normal, compile, ['']) +test('T19407', normal, compile, ['']) +test('T19871', normal, compile, ['']) +test('T16859', normal, compile, ['-package ghc']) +test('T18907', normal, compile, ['']) +test('T13331', normal, compile, ['']) |