diff options
Diffstat (limited to 'testsuite')
15 files changed, 175 insertions, 38 deletions
diff --git a/testsuite/tests/cpranal/should_compile/T18109.hs b/testsuite/tests/cpranal/should_compile/T18109.hs new file mode 100644 index 0000000000..5c52a187c9 --- /dev/null +++ b/testsuite/tests/cpranal/should_compile/T18109.hs @@ -0,0 +1,25 @@ +{-# OPTIONS_GHC -O2 -fforce-recomp -dno-typeable-binds #-} + +-- | These are all examples where the CPR worker should not return an unboxed +-- singleton tuple of the field, but rather the single field directly. +-- This is OK if the field indeed terminates quickly; +-- see Note [No unboxed tuple for single, unlifted transit var] +module T18109 where + +data F = F (Int -> Int) + +f :: Int -> F +f n = F (+n) +{-# NOINLINE f #-} + +data T = T (Int, Int) + +g :: T -> T +g t@(T p) = p `seq` t +{-# NOINLINE g #-} + +data U = U ![Int] + +h :: Int -> U +h n = U [0..n] +{-# NOINLINE h #-} diff --git a/testsuite/tests/cpranal/should_compile/T18109.stderr b/testsuite/tests/cpranal/should_compile/T18109.stderr new file mode 100644 index 0000000000..ad92bdda17 --- /dev/null +++ b/testsuite/tests/cpranal/should_compile/T18109.stderr @@ -0,0 +1,51 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core = {terms: 78, types: 81, coercions: 0, joins: 0/1} + +-- RHS size: {terms: 6, types: 4, coercions: 0, joins: 0/0} +T18109.$WU :: [Int] %1 -> U +T18109.$WU = \ (dt_aDr :: [Int]) -> case dt_aDr of dt_X0 { __DEFAULT -> T18109.U dt_X0 } + +-- RHS size: {terms: 6, types: 12, coercions: 0, joins: 0/0} +T18109.$wg :: (Int, Int) -> (# (Int, Int) #) +T18109.$wg = \ (ww_sKr :: (Int, Int)) -> case ww_sKr of p_X2 { (ipv_sIU, ipv1_sIV) -> (# p_X2 #) } + +-- RHS size: {terms: 10, types: 13, coercions: 0, joins: 0/0} +g :: T -> T +g = \ (w_sKp :: T) -> case w_sKp of { T ww_sKr -> case T18109.$wg ww_sKr of { (# ww1_sKJ #) -> T18109.T ww1_sKJ } } + +-- RHS size: {terms: 6, types: 5, coercions: 0, joins: 0/0} +T18109.$wf :: Int -> (# Int -> Int #) +T18109.$wf = \ (w_sKw :: Int) -> (# \ (v_B2 :: Int) -> GHC.Num.$fNumInt_$c+ v_B2 w_sKw #) + +-- RHS size: {terms: 7, types: 7, coercions: 0, joins: 0/0} +f :: Int -> F +f = \ (w_sKw :: Int) -> case T18109.$wf w_sKw of { (# ww_sKL #) -> T18109.F ww_sKL } + +-- RHS size: {terms: 26, types: 10, coercions: 0, joins: 0/1} +T18109.$wh :: GHC.Prim.Int# -> [Int] +T18109.$wh + = \ (ww_sKE :: GHC.Prim.Int#) -> + case GHC.Prim.># 0# ww_sKE of { + __DEFAULT -> + letrec { + go3_aKm :: GHC.Prim.Int# -> [Int] + go3_aKm + = \ (x_aKn :: GHC.Prim.Int#) -> + GHC.Types.: + @Int + (GHC.Types.I# x_aKn) + (case GHC.Prim.==# x_aKn ww_sKE of { + __DEFAULT -> go3_aKm (GHC.Prim.+# x_aKn 1#); + 1# -> GHC.Types.[] @Int + }); } in + go3_aKm 0#; + 1# -> GHC.Types.[] @Int + } + +-- RHS size: {terms: 10, types: 5, coercions: 0, joins: 0/0} +h :: Int -> U +h = \ (w_sKC :: Int) -> case w_sKC of { GHC.Types.I# ww_sKE -> case T18109.$wh ww_sKE of ww1_sKN { __DEFAULT -> T18109.U ww1_sKN } } + + + diff --git a/testsuite/tests/cpranal/should_compile/T18401.hs b/testsuite/tests/cpranal/should_compile/T18401.hs new file mode 100644 index 0000000000..c850d9a7e0 --- /dev/null +++ b/testsuite/tests/cpranal/should_compile/T18401.hs @@ -0,0 +1,20 @@ +{-# OPTIONS_GHC -O2 -fforce-recomp -dno-typeable-binds #-} + +module T18401 where + +-- | A safe version of `init`. +-- @safeInit [] = Nothing@ +-- @safeInit xs = Just $ init xs@ +safeInit :: [a] -> Maybe [a] +safeInit xs = case si xs of + (False, _) -> Nothing + (_, ys) -> Just ys + +si :: [a] -> (Bool, [a]) +si xs0 = foldr go stop xs0 Nothing + where + stop Nothing = (False, []) + stop _ = (True, []) + go x r Nothing = (True, snd (r (Just x))) + go x r (Just p) = (True, p : snd (r (Just x))) + diff --git a/testsuite/tests/cpranal/should_compile/T18401.stderr b/testsuite/tests/cpranal/should_compile/T18401.stderr new file mode 100644 index 0000000000..e299ba4dc7 --- /dev/null +++ b/testsuite/tests/cpranal/should_compile/T18401.stderr @@ -0,0 +1,35 @@ + +==================== Tidy Core ==================== +Result size of Tidy Core = {terms: 54, types: 101, coercions: 0, joins: 0/0} + +Rec { +-- RHS size: {terms: 20, types: 31, coercions: 0, joins: 0/0} +T18401.safeInit_$spoly_$wgo1 :: forall {a}. a -> [a] -> (# Bool, [a] #) +T18401.safeInit_$spoly_$wgo1 + = \ (@a_aO1) (sc_s17W :: a_aO1) (sc1_s17V :: [a_aO1]) -> + case sc1_s17V of { + [] -> (# GHC.Types.True, GHC.Types.[] @a_aO1 #); + : y_a158 ys_a159 -> (# GHC.Types.True, GHC.Types.: @a_aO1 sc_s17W (case T18401.safeInit_$spoly_$wgo1 @a_aO1 y_a158 ys_a159 of { (# ww_s17y, ww1_s17z #) -> ww1_s17z }) #) + } +end Rec } + +-- RHS size: {terms: 17, types: 25, coercions: 0, joins: 0/0} +si :: forall a. [a] -> (Bool, [a]) +si + = \ (@a_s17i) (w_s17j :: [a_s17i]) -> + case w_s17j of { + [] -> (GHC.Types.False, GHC.Types.[] @a_s17i); + : y_a158 ys_a159 -> (GHC.Types.True, case T18401.safeInit_$spoly_$wgo1 @a_s17i y_a158 ys_a159 of { (# ww_X3, ww1_X4 #) -> ww1_X4 }) + } + +-- RHS size: {terms: 14, types: 22, coercions: 0, joins: 0/0} +safeInit :: forall a. [a] -> Maybe [a] +safeInit + = \ (@a_aO1) (xs_aus :: [a_aO1]) -> + case xs_aus of { + [] -> GHC.Maybe.Nothing @[a_aO1]; + : y_a158 ys_a159 -> GHC.Maybe.Just @[a_aO1] (case T18401.safeInit_$spoly_$wgo1 @a_aO1 y_a158 ys_a159 of { (# ww_X3, ww1_X4 #) -> ww1_X4 }) + } + + + diff --git a/testsuite/tests/cpranal/should_compile/all.T b/testsuite/tests/cpranal/should_compile/all.T index 5a37f42376..d70d978be6 100644 --- a/testsuite/tests/cpranal/should_compile/all.T +++ b/testsuite/tests/cpranal/should_compile/all.T @@ -5,3 +5,9 @@ def f( name, opts ): setTestOpts(f) test('Cpr001', [], multimod_compile, ['Cpr001', '-v0']) +# The following tests grep for type signatures of worker functions. +test('T18109', [ grep_errmsg(r'^T18109\.\$w\S+ ::') ], compile, ['-ddump-simpl -dsuppress-idinfo -dppr-cols=9999']) +# T18401 probably needs -flate-dmd-anal so that it runs after SpecConstr. +# It is currently broken, but not marked expect_broken. We can't know the exact +# name of the function before it is fixed, so expect_broken doesn't make sense. +test('T18401', [ grep_errmsg(r'^T18401\.\S+ ::') ], compile, ['-ddump-simpl -dsuppress-idinfo -dppr-cols=9999 -flate-dmd-anal']) diff --git a/testsuite/tests/simplCore/should_compile/T13143.stderr b/testsuite/tests/simplCore/should_compile/T13143.stderr index 86094fe7d9..87fbdd6213 100644 --- a/testsuite/tests/simplCore/should_compile/T13143.stderr +++ b/testsuite/tests/simplCore/should_compile/T13143.stderr @@ -97,14 +97,14 @@ g [InlPrag=[2]] :: Bool -> Bool -> Int -> Int 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 + case w2 of { GHC.Types.I# ww [Occ=Once1] -> + case T13143.$wg w w1 ww of ww1 [Occ=Once1] { __DEFAULT -> + GHC.Types.I# ww1 } }}] 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 w2 of { GHC.Types.I# ww -> + case T13143.$wg w w1 ww of ww1 { __DEFAULT -> GHC.Types.I# ww1 } } diff --git a/testsuite/tests/simplCore/should_compile/T15631.stdout b/testsuite/tests/simplCore/should_compile/T15631.stdout index cce6777d74..e9e6a2bcab 100644 --- a/testsuite/tests/simplCore/should_compile/T15631.stdout +++ b/testsuite/tests/simplCore/should_compile/T15631.stdout @@ -1,7 +1,7 @@ case GHC.List.$wlenAcc - case GHC.List.$wlenAcc @a w 0# of ww2 { __DEFAULT -> + case GHC.List.$wlenAcc @a w 0# of ww1 { __DEFAULT -> case GHC.List.reverse1 @a w (GHC.Types.[] @a) of { - [] -> case Foo.f1 @a of { GHC.Types.I# v1 -> GHC.Prim.+# ww2 v1 }; + [] -> case Foo.f1 @a of { GHC.Types.I# v1 -> GHC.Prim.+# ww1 v1 }; case GHC.List.$wlenAcc case Foo.$wf @a w of ww [Occ=Once1] { __DEFAULT -> case Foo.$wf @a w of ww { __DEFAULT -> GHC.Types.I# ww } diff --git a/testsuite/tests/simplCore/should_compile/T18013.stderr b/testsuite/tests/simplCore/should_compile/T18013.stderr index abcf710083..70998aecf8 100644 --- a/testsuite/tests/simplCore/should_compile/T18013.stderr +++ b/testsuite/tests/simplCore/should_compile/T18013.stderr @@ -141,21 +141,21 @@ mapMaybeRule [InlPrag=[2]] WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) Tmpl= \ (@a) (@b) (w [Occ=Once1!] :: Rule IO a b) -> - case w of { Rule @s ww1 ww2 [Occ=OnceL1!] -> + case w of { Rule @s ww ww1 [Occ=OnceL1!] -> T18013a.Rule @IO @(Maybe a) @(Maybe b) @s - ww1 + ww ((\ (s2 [Occ=Once1] :: s) (a1 [Occ=Once1!] :: Maybe a) (s1 [Occ=Once2] :: GHC.Prim.State# GHC.Prim.RealWorld) -> case a1 of { Nothing -> - (# s1, T18013a.Result @s @(Maybe b) ww1 (GHC.Maybe.Nothing @b) #); + (# s1, T18013a.Result @s @(Maybe b) ww (GHC.Maybe.Nothing @b) #); Just x [Occ=Once1] -> - case ((ww2 s2 x) `cast` <Co:4>) s1 of + case ((ww1 s2 x) `cast` <Co:4>) s1 of { (# ipv [Occ=Once1], ipv1 [Occ=Once1!] #) -> case ipv1 of { Result t2 [Occ=Once1] c1 [Occ=Once1] -> (# ipv, T18013a.Result @s @(Maybe b) t2 (GHC.Maybe.Just @b c1) #) @@ -166,24 +166,24 @@ mapMaybeRule [InlPrag=[2]] }}] mapMaybeRule = \ (@a) (@b) (w :: Rule IO a b) -> - case w of { Rule @s ww1 ww2 -> + case w of { Rule @s ww ww1 -> let { lvl :: Result s (Maybe b) [LclId, Unf=OtherCon []] - lvl = T18013a.Result @s @(Maybe b) ww1 (GHC.Maybe.Nothing @b) } in + lvl = T18013a.Result @s @(Maybe b) ww (GHC.Maybe.Nothing @b) } in T18013a.Rule @IO @(Maybe a) @(Maybe b) @s - ww1 + ww ((\ (s2 :: s) (a1 :: Maybe a) (s1 :: GHC.Prim.State# GHC.Prim.RealWorld) -> case a1 of { Nothing -> (# s1, lvl #); Just x -> - case ((ww2 s2 x) `cast` <Co:4>) s1 of { (# ipv, ipv1 #) -> + case ((ww1 s2 x) `cast` <Co:4>) s1 of { (# ipv, ipv1 #) -> case ipv1 of { Result t2 c1 -> (# ipv, T18013a.Result @s @(Maybe b) t2 (GHC.Maybe.Just @b c1) #) } diff --git a/testsuite/tests/simplCore/should_compile/T3717.stderr b/testsuite/tests/simplCore/should_compile/T3717.stderr index f33b8ec401..6e8fe19294 100644 --- a/testsuite/tests/simplCore/should_compile/T3717.stderr +++ b/testsuite/tests/simplCore/should_compile/T3717.stderr @@ -62,15 +62,15 @@ foo [InlPrag=[2]] :: Int -> Int WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) Tmpl= \ (w [Occ=Once1!] :: Int) -> - case w of { GHC.Types.I# ww1 [Occ=Once1] -> - case T3717.$wfoo ww1 of ww2 [Occ=Once1] { __DEFAULT -> - GHC.Types.I# ww2 + case w of { GHC.Types.I# ww [Occ=Once1] -> + case T3717.$wfoo ww of ww1 [Occ=Once1] { __DEFAULT -> + GHC.Types.I# ww1 } }}] foo = \ (w :: Int) -> - case w of { GHC.Types.I# ww1 -> - case T3717.$wfoo ww1 of ww2 { __DEFAULT -> GHC.Types.I# ww2 } + case w of { GHC.Types.I# ww -> + case T3717.$wfoo ww of ww1 { __DEFAULT -> GHC.Types.I# ww1 } } diff --git a/testsuite/tests/simplCore/should_compile/T3772.stdout b/testsuite/tests/simplCore/should_compile/T3772.stdout index b37882484c..5ead45f9c3 100644 --- a/testsuite/tests/simplCore/should_compile/T3772.stdout +++ b/testsuite/tests/simplCore/should_compile/T3772.stdout @@ -70,9 +70,9 @@ foo [InlPrag=[final]] :: Int -> () WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) Tmpl= \ (w [Occ=Once1!] :: Int) -> - case w of { GHC.Types.I# ww1 [Occ=Once1] -> T3772.$wfoo ww1 }}] + case w of { GHC.Types.I# ww [Occ=Once1] -> T3772.$wfoo ww }}] foo - = \ (w :: Int) -> case w of { GHC.Types.I# ww1 -> T3772.$wfoo ww1 } + = \ (w :: Int) -> case w of { GHC.Types.I# ww -> T3772.$wfoo ww } diff --git a/testsuite/tests/simplCore/should_compile/T4908.stderr b/testsuite/tests/simplCore/should_compile/T4908.stderr index f005d660c8..f8f9107485 100644 --- a/testsuite/tests/simplCore/should_compile/T4908.stderr +++ b/testsuite/tests/simplCore/should_compile/T4908.stderr @@ -86,9 +86,9 @@ f [InlPrag=[2]] :: Int -> (Int, Int) -> Bool WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=2,unsat_ok=True,boring_ok=False) Tmpl= \ (w [Occ=Once1!] :: Int) (w1 [Occ=Once1] :: (Int, Int)) -> - case w of { I# ww1 [Occ=Once1] -> T4908.$wf ww1 w1 }}] + case w of { I# ww [Occ=Once1] -> T4908.$wf ww w1 }}] f = \ (w :: Int) (w1 :: (Int, Int)) -> - case w of { I# ww1 -> T4908.$wf ww1 w1 } + case w of { I# ww -> T4908.$wf ww w1 } ------ Local rules for imported ids -------- diff --git a/testsuite/tests/simplCore/should_compile/T4930.stderr b/testsuite/tests/simplCore/should_compile/T4930.stderr index 66d257897e..3321809415 100644 --- a/testsuite/tests/simplCore/should_compile/T4930.stderr +++ b/testsuite/tests/simplCore/should_compile/T4930.stderr @@ -62,15 +62,15 @@ foo [InlPrag=[2]] :: Int -> Int WorkFree=True, Expandable=True, Guidance=ALWAYS_IF(arity=1,unsat_ok=True,boring_ok=False) Tmpl= \ (w [Occ=Once1!] :: Int) -> - case w of { GHC.Types.I# ww1 [Occ=Once1] -> - case T4930.$wfoo ww1 of ww2 [Occ=Once1] { __DEFAULT -> - GHC.Types.I# ww2 + case w of { GHC.Types.I# ww [Occ=Once1] -> + case T4930.$wfoo ww of ww1 [Occ=Once1] { __DEFAULT -> + GHC.Types.I# ww1 } }}] foo = \ (w :: Int) -> - case w of { GHC.Types.I# ww1 -> - case T4930.$wfoo ww1 of ww2 { __DEFAULT -> GHC.Types.I# ww2 } + case w of { GHC.Types.I# ww -> + case T4930.$wfoo ww of ww1 { __DEFAULT -> GHC.Types.I# ww1 } } diff --git a/testsuite/tests/simplCore/should_compile/T5298.stdout b/testsuite/tests/simplCore/should_compile/T5298.stdout index 370f9776e2..67b106c3be 100644 --- a/testsuite/tests/simplCore/should_compile/T5298.stdout +++ b/testsuite/tests/simplCore/should_compile/T5298.stdout @@ -7,7 +7,7 @@ $wg } -- g = \ w -> - case w of { I# ww1 -> case $wg ww1 of ww2 { __DEFAULT -> I# ww2 } } + case w of { I# ww -> case $wg ww of ww1 { __DEFAULT -> I# ww1 } } ------ Local rules for imported ids -------- diff --git a/testsuite/tests/simplCore/should_compile/T7360.stderr b/testsuite/tests/simplCore/should_compile/T7360.stderr index fe869c7c40..070d7ef7fe 100644 --- a/testsuite/tests/simplCore/should_compile/T7360.stderr +++ b/testsuite/tests/simplCore/should_compile/T7360.stderr @@ -43,15 +43,15 @@ fun2 :: forall {a}. [a] -> ((), Int) Tmpl= \ (@a) (x [Occ=Once1] :: [a]) -> (T7360.fun4, case x of wild [Occ=Once1] { __DEFAULT -> - case GHC.List.$wlenAcc @a wild 0# of ww2 [Occ=Once1] { __DEFAULT -> - GHC.Types.I# ww2 + case GHC.List.$wlenAcc @a wild 0# of ww1 [Occ=Once1] { __DEFAULT -> + GHC.Types.I# ww1 } })}] fun2 = \ (@a) (x :: [a]) -> (T7360.fun4, - case GHC.List.$wlenAcc @a x 0# of ww2 { __DEFAULT -> - GHC.Types.I# ww2 + case GHC.List.$wlenAcc @a x 0# of ww1 { __DEFAULT -> + GHC.Types.I# ww1 }) -- RHS size: {terms: 1, types: 0, coercions: 0, joins: 0/0} diff --git a/testsuite/tests/simplCore/should_compile/T7865.stdout b/testsuite/tests/simplCore/should_compile/T7865.stdout index 37bc4157cc..1dd2c25893 100644 --- a/testsuite/tests/simplCore/should_compile/T7865.stdout +++ b/testsuite/tests/simplCore/should_compile/T7865.stdout @@ -1,8 +1,8 @@ T7865.$wexpensive [InlPrag=NOINLINE] T7865.$wexpensive expensive [InlPrag=[final]] :: Int -> Int - case T7865.$wexpensive ww1 of ww2 [Occ=Once1] { __DEFAULT -> + case T7865.$wexpensive ww of ww1 [Occ=Once1] { __DEFAULT -> expensive - case T7865.$wexpensive ww1 of ww2 { __DEFAULT -> GHC.Types.I# ww2 } - case T7865.$wexpensive ww1 of ww2 { __DEFAULT -> - case T7865.$wexpensive ww1 of ww2 { __DEFAULT -> + case T7865.$wexpensive ww of ww1 { __DEFAULT -> GHC.Types.I# ww1 } + case T7865.$wexpensive ww of ww1 { __DEFAULT -> + case T7865.$wexpensive ww of ww1 { __DEFAULT -> |