summaryrefslogtreecommitdiff
path: root/testsuite
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2021-04-08 22:42:31 +0100
committerMarge Bot <ben+marge-bot@smart-cactus.org>2022-10-25 18:07:03 -0400
commit5a997e16cb2079c52f980d59af3de176922fa320 (patch)
treefbbbf1834d6c94e5eca750f01bc463b19cab6a97 /testsuite
parent41406da55db1915cf1360e3275657f2b1115d530 (diff)
downloadhaskell-5a997e16cb2079c52f980d59af3de176922fa320.tar.gz
Make the specialiser handle polymorphic specialisation
Ticket #13873 unexpectedly showed that a SPECIALISE pragma made a program run (a lot) slower, because less specialisation took place overall. It turned out that the specialiser was missing opportunities because of quantified type variables. It was quite easy to fix. The story is given in Note [Specialising polymorphic dictionaries] Two other minor fixes in the specialiser * There is no benefit in specialising data constructor /wrappers/. (They can appear overloaded because they are given a dictionary to store in the constructor.) Small guard in canSpecImport. * There was a buglet in the UnspecArg case of specHeader, in the case where there is a dead binder. We need a LitRubbish filler for the specUnfolding stuff. I expanded Note [Drop dead args from specialisations] to explain. There is a 4% increase in compile time for T15164, because we generate more specialised code. This seems OK. Metric Increase: T15164
Diffstat (limited to 'testsuite')
-rw-r--r--testsuite/tests/numeric/should_compile/T19641.stderr22
-rw-r--r--testsuite/tests/simplCore/should_compile/T8331.stderr144
-rw-r--r--testsuite/tests/simplCore/should_compile/all.T3
3 files changed, 158 insertions, 11 deletions
diff --git a/testsuite/tests/numeric/should_compile/T19641.stderr b/testsuite/tests/numeric/should_compile/T19641.stderr
index 7c1cf57b06..ec7e19c946 100644
--- a/testsuite/tests/numeric/should_compile/T19641.stderr
+++ b/testsuite/tests/numeric/should_compile/T19641.stderr
@@ -3,30 +3,30 @@
Result size of Tidy Core
= {terms: 22, types: 20, coercions: 0, joins: 0/0}
-integer_to_int
+natural_to_word
= \ eta ->
case eta of {
- IS ipv -> Just (I# ipv);
- IP x1 -> Nothing;
- IN ds -> Nothing
+ NS x1 -> Just (W# x1);
+ NB ds -> Nothing
}
-natural_to_word
+integer_to_int
= \ eta ->
case eta of {
- NS x1 -> Just (W# x1);
- NB ds -> Nothing
+ IS ipv -> Just (I# ipv);
+ IP x1 -> Nothing;
+ IN ds -> Nothing
}
------ Local rules for imported ids --------
-"SPEC/Test toIntegralSized @Natural @Word"
- forall $dIntegral $dIntegral1 $dBits $dBits1.
- toIntegralSized $dIntegral $dIntegral1 $dBits $dBits1
- = natural_to_word
"SPEC/Test toIntegralSized @Integer @Int"
forall $dIntegral $dIntegral1 $dBits $dBits1.
toIntegralSized $dIntegral $dIntegral1 $dBits $dBits1
= integer_to_int
+"SPEC/Test toIntegralSized @Natural @Word"
+ forall $dIntegral $dIntegral1 $dBits $dBits1.
+ toIntegralSized $dIntegral $dIntegral1 $dBits $dBits1
+ = natural_to_word
diff --git a/testsuite/tests/simplCore/should_compile/T8331.stderr b/testsuite/tests/simplCore/should_compile/T8331.stderr
index 41bc7de5f4..c940ed26fc 100644
--- a/testsuite/tests/simplCore/should_compile/T8331.stderr
+++ b/testsuite/tests/simplCore/should_compile/T8331.stderr
@@ -1,5 +1,149 @@
==================== Tidy Core rules ====================
+"SPEC $c*> @(ST s) @_"
+ forall (@s) (@r) ($dApplicative :: Applicative (ST s)).
+ $fApplicativeReaderT_$c*> @(ST s) @r $dApplicative
+ = ($fApplicativeReaderT2 @s @r)
+ `cast` (forall (a :: <*>_N) (b :: <*>_N).
+ <ReaderT r (ST s) a>_R
+ %<'Many>_N ->_R <ReaderT r (ST s) b>_R
+ %<'Many>_N ->_R <r>_R %<'Many>_N ->_R Sym (N:ST[0] <s>_N <b>_R)
+ ; Sym (N:ReaderT[0] <*>_N <r>_R <ST s>_R <b>_N)
+ :: Coercible
+ (forall {a} {b}.
+ ReaderT r (ST s) a -> ReaderT r (ST s) b -> r -> STRep s b)
+ (forall {a} {b}.
+ ReaderT r (ST s) a -> ReaderT r (ST s) b -> ReaderT r (ST s) b))
+"SPEC $c<$ @(ST s) @_"
+ forall (@s) (@r) ($dFunctor :: Functor (ST s)).
+ $fFunctorReaderT_$c<$ @(ST s) @r $dFunctor
+ = ($fApplicativeReaderT6 @s @r)
+ `cast` (forall (a :: <*>_N) (b :: <*>_N).
+ <a>_R
+ %<'Many>_N ->_R <ReaderT r (ST s) b>_R
+ %<'Many>_N ->_R <r>_R %<'Many>_N ->_R Sym (N:ST[0] <s>_N <a>_R)
+ ; Sym (N:ReaderT[0] <*>_N <r>_R <ST s>_R <a>_N)
+ :: Coercible
+ (forall {a} {b}. a -> ReaderT r (ST s) b -> r -> STRep s a)
+ (forall {a} {b}. a -> ReaderT r (ST s) b -> ReaderT r (ST s) a))
+"SPEC $c<* @(ST s) @_"
+ forall (@s) (@r) ($dApplicative :: Applicative (ST s)).
+ $fApplicativeReaderT_$c<* @(ST s) @r $dApplicative
+ = ($fApplicativeReaderT1 @s @r)
+ `cast` (forall (a :: <*>_N) (b :: <*>_N).
+ <ReaderT r (ST s) a>_R
+ %<'Many>_N ->_R <ReaderT r (ST s) b>_R
+ %<'Many>_N ->_R <r>_R %<'Many>_N ->_R Sym (N:ST[0] <s>_N <a>_R)
+ ; Sym (N:ReaderT[0] <*>_N <r>_R <ST s>_R <a>_N)
+ :: Coercible
+ (forall {a} {b}.
+ ReaderT r (ST s) a -> ReaderT r (ST s) b -> r -> STRep s a)
+ (forall {a} {b}.
+ ReaderT r (ST s) a -> ReaderT r (ST s) b -> ReaderT r (ST s) a))
+"SPEC $c<*> @(ST s) @_"
+ forall (@s) (@r) ($dApplicative :: Applicative (ST s)).
+ $fApplicativeReaderT9 @(ST s) @r $dApplicative
+ = ($fApplicativeReaderT4 @s @r)
+ `cast` (forall (a :: <*>_N) (b :: <*>_N).
+ <ReaderT r (ST s) (a -> b)>_R
+ %<'Many>_N ->_R <ReaderT r (ST s) a>_R
+ %<'Many>_N ->_R <r>_R
+ %<'Many>_N ->_R Sym (N:ST[0] <s>_N <b>_R)
+ :: Coercible
+ (forall {a} {b}.
+ ReaderT r (ST s) (a -> b) -> ReaderT r (ST s) a -> r -> STRep s b)
+ (forall {a} {b}.
+ ReaderT r (ST s) (a -> b) -> ReaderT r (ST s) a -> r -> ST s b))
+"SPEC $c>> @(ST s) @_"
+ forall (@s) (@r) ($dMonad :: Monad (ST s)).
+ $fMonadReaderT1 @(ST s) @r $dMonad
+ = $fMonadAbstractIOSTReaderT_$s$c>> @s @r
+"SPEC $c>>= @(ST s) @_"
+ forall (@s) (@r) ($dMonad :: Monad (ST s)).
+ $fMonadReaderT2 @(ST s) @r $dMonad
+ = ($fMonadAbstractIOSTReaderT2 @s @r)
+ `cast` (forall (a :: <*>_N) (b :: <*>_N).
+ <ReaderT r (ST s) a>_R
+ %<'Many>_N ->_R <a -> ReaderT r (ST s) b>_R
+ %<'Many>_N ->_R <r>_R
+ %<'Many>_N ->_R Sym (N:ST[0] <s>_N <b>_R)
+ :: Coercible
+ (forall {a} {b}.
+ ReaderT r (ST s) a -> (a -> ReaderT r (ST s) b) -> r -> STRep s b)
+ (forall {a} {b}.
+ ReaderT r (ST s) a -> (a -> ReaderT r (ST s) b) -> r -> ST s b))
+"SPEC $cfmap @(ST s) @_"
+ forall (@s) (@r) ($dFunctor :: Functor (ST s)).
+ $fFunctorReaderT_$cfmap @(ST s) @r $dFunctor
+ = ($fApplicativeReaderT7 @s @r)
+ `cast` (forall (a :: <*>_N) (b :: <*>_N).
+ <a -> b>_R
+ %<'Many>_N ->_R <ReaderT r (ST s) a>_R
+ %<'Many>_N ->_R <r>_R %<'Many>_N ->_R Sym (N:ST[0] <s>_N <b>_R)
+ ; Sym (N:ReaderT[0] <*>_N <r>_R <ST s>_R <b>_N)
+ :: Coercible
+ (forall {a} {b}. (a -> b) -> ReaderT r (ST s) a -> r -> STRep s b)
+ (forall {a} {b}.
+ (a -> b) -> ReaderT r (ST s) a -> ReaderT r (ST s) b))
+"SPEC $cliftA2 @(ST s) @_"
+ forall (@s) (@r) ($dApplicative :: Applicative (ST s)).
+ $fApplicativeReaderT_$cliftA2 @(ST s) @r $dApplicative
+ = ($fApplicativeReaderT3 @s @r)
+ `cast` (forall (a :: <*>_N) (b :: <*>_N) (c :: <*>_N).
+ <a -> b -> c>_R
+ %<'Many>_N ->_R <ReaderT r (ST s) a>_R
+ %<'Many>_N ->_R <ReaderT r (ST s) b>_R
+ %<'Many>_N ->_R <r>_R %<'Many>_N ->_R Sym (N:ST[0] <s>_N <c>_R)
+ ; Sym (N:ReaderT[0] <*>_N <r>_R <ST s>_R <c>_N)
+ :: Coercible
+ (forall {a} {b} {c}.
+ (a -> b -> c)
+ -> ReaderT r (ST s) a -> ReaderT r (ST s) b -> r -> STRep s c)
+ (forall {a} {b} {c}.
+ (a -> b -> c)
+ -> ReaderT r (ST s) a -> ReaderT r (ST s) b -> ReaderT r (ST s) c))
+"SPEC $cp1Applicative @(ST s) @_"
+ forall (@s) (@r) ($dApplicative :: Applicative (ST s)).
+ $fApplicativeReaderT_$cp1Applicative @(ST s) @r $dApplicative
+ = $fApplicativeReaderT_$s$fFunctorReaderT @s @r
+"SPEC $cp1Monad @(ST s) @_"
+ forall (@s) (@r) ($dMonad :: Monad (ST s)).
+ $fMonadReaderT_$cp1Monad @(ST s) @r $dMonad
+ = $fApplicativeReaderT_$s$fApplicativeReaderT @s @r
+"SPEC $cpure @(ST s) @_"
+ forall (@s) (@r) ($dApplicative :: Applicative (ST s)).
+ $fApplicativeReaderT_$cpure @(ST s) @r $dApplicative
+ = ($fApplicativeReaderT5 @s @r)
+ `cast` (forall (a :: <*>_N).
+ <a>_R
+ %<'Many>_N ->_R <r>_R %<'Many>_N ->_R Sym (N:ST[0] <s>_N <a>_R)
+ ; Sym (N:ReaderT[0] <*>_N <r>_R <ST s>_R <a>_N)
+ :: Coercible
+ (forall {a}. a -> r -> STRep s a)
+ (forall {a}. a -> ReaderT r (ST s) a))
+"SPEC $creturn @(ST s) @_"
+ forall (@s) (@r) ($dMonad :: Monad (ST s)).
+ $fMonadReaderT_$creturn @(ST s) @r $dMonad
+ = ($fApplicativeReaderT5 @s @r)
+ `cast` (forall (a :: <*>_N).
+ <a>_R
+ %<'Many>_N ->_R <r>_R %<'Many>_N ->_R Sym (N:ST[0] <s>_N <a>_R)
+ ; Sym (N:ReaderT[0] <*>_N <r>_R <ST s>_R <a>_N)
+ :: Coercible
+ (forall {a}. a -> r -> STRep s a)
+ (forall {a}. a -> ReaderT r (ST s) a))
+"SPEC $fApplicativeReaderT @(ST s) @_"
+ forall (@s) (@r) ($dApplicative :: Applicative (ST s)).
+ $fApplicativeReaderT @(ST s) @r $dApplicative
+ = $fApplicativeReaderT_$s$fApplicativeReaderT @s @r
+"SPEC $fFunctorReaderT @(ST s) @_"
+ forall (@s) (@r) ($dFunctor :: Functor (ST s)).
+ $fFunctorReaderT @(ST s) @r $dFunctor
+ = $fApplicativeReaderT_$s$fFunctorReaderT @s @r
+"SPEC $fMonadReaderT @(ST s) @_"
+ forall (@s) (@r) ($dMonad :: Monad (ST s)).
+ $fMonadReaderT @(ST s) @r $dMonad
+ = $fMonadAbstractIOSTReaderT_$s$fMonadReaderT @s @r
"USPEC useAbstractMonad @(ReaderT Int (ST s))"
forall (@s)
($dMonadAbstractIOST :: MonadAbstractIOST (ReaderT Int (ST s))).
diff --git a/testsuite/tests/simplCore/should_compile/all.T b/testsuite/tests/simplCore/should_compile/all.T
index 9cbd330d0b..d4ad82e0d9 100644
--- a/testsuite/tests/simplCore/should_compile/all.T
+++ b/testsuite/tests/simplCore/should_compile/all.T
@@ -434,3 +434,6 @@ test('T21148', [grep_errmsg(r'Cpr=') ], compile, ['-O -ddump-simpl'])
test('T21851', [grep_errmsg(r'case.*w\$sf') ], multimod_compile, ['T21851', '-O -dno-typeable-binds -dsuppress-uniques'])
# One module, T22097.hs, has OPTIONS_GHC -ddump-simpl
test('T22097', [grep_errmsg(r'case.*wgoEven') ], multimod_compile, ['T22097', '-O -dno-typeable-binds -dsuppress-uniques'])
+
+test('T13873', [ grep_errmsg(r'SPEC') ], compile, ['-O -ddump-rules'])
+