diff options
Diffstat (limited to 'testsuite/tests/cpranal/should_compile')
-rw-r--r-- | testsuite/tests/cpranal/should_compile/T18109.hs | 25 | ||||
-rw-r--r-- | testsuite/tests/cpranal/should_compile/T18109.stderr | 51 | ||||
-rw-r--r-- | testsuite/tests/cpranal/should_compile/T18401.hs | 20 | ||||
-rw-r--r-- | testsuite/tests/cpranal/should_compile/T18401.stderr | 35 | ||||
-rw-r--r-- | testsuite/tests/cpranal/should_compile/all.T | 6 |
5 files changed, 137 insertions, 0 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']) |