summaryrefslogtreecommitdiff
path: root/testsuite/tests
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>2021-04-13 18:43:15 -0400
commitef0135934fe32da5b5bb730dbce74262e23e72e8 (patch)
tree2d868dd97be5d9a5afc88002d33083ad64cab2bc /testsuite/tests
parent6124d172e1aef7a2c84106c93834b6e188e4a287 (diff)
downloadhaskell-ef0135934fe32da5b5bb730dbce74262e23e72e8.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 T13056, because we generate more specialised code. This seems OK. Metric Increase: T13056
Diffstat (limited to 'testsuite/tests')
-rw-r--r--testsuite/tests/simplCore/should_compile/T13873.hs24
-rw-r--r--testsuite/tests/simplCore/should_compile/T13873.stderr8
-rw-r--r--testsuite/tests/simplCore/should_compile/T8331.stderr97
-rw-r--r--testsuite/tests/simplCore/should_compile/all.T1
4 files changed, 130 insertions, 0 deletions
diff --git a/testsuite/tests/simplCore/should_compile/T13873.hs b/testsuite/tests/simplCore/should_compile/T13873.hs
new file mode 100644
index 0000000000..1736252e23
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T13873.hs
@@ -0,0 +1,24 @@
+module T13873 where
+
+data ST s = MkST
+
+class M a where
+ foo :: a -> Int
+
+instance M (ST s) where
+ foo x = 3
+
+wimwam :: M a => Bool -> a -> Int
+wimwam True x = wimwam False x
+wimwam False x = foo x
+
+f :: ST s -> Int
+f x = wimwam True x + 1
+
+-- The question is: do we get an auto-generate
+-- specialisation for
+-- RULE forall s (d:M (ST s)). wimwam @(ST s) d
+-- = $swimwam @s
+--
+-- The hand-written pragma would be:
+-- SPECIALISE wimwam :: Bool -> ST s -> Int
diff --git a/testsuite/tests/simplCore/should_compile/T13873.stderr b/testsuite/tests/simplCore/should_compile/T13873.stderr
new file mode 100644
index 0000000000..202f39eeb9
--- /dev/null
+++ b/testsuite/tests/simplCore/should_compile/T13873.stderr
@@ -0,0 +1,8 @@
+
+==================== Tidy Core rules ====================
+"SPEC wimwam @(ST s)"
+ forall (@k) (@(s :: k)) ($dM :: M (ST s)).
+ wimwam @(ST s) $dM
+ = f_$swimwam @k @s
+
+
diff --git a/testsuite/tests/simplCore/should_compile/T8331.stderr b/testsuite/tests/simplCore/should_compile/T8331.stderr
index 0fbd7a577c..76c8d90817 100644
--- a/testsuite/tests/simplCore/should_compile/T8331.stderr
+++ b/testsuite/tests/simplCore/should_compile/T8331.stderr
@@ -1,5 +1,102 @@
==================== Tidy Core rules ====================
+"SPEC $c*> @(ST s) _"
+ forall (@s) (@r) ($dApplicative :: Applicative (ST s)).
+ $fApplicativeReaderT_$c*> @(ST s) @r $dApplicative
+ = ($fApplicativeReaderT3 @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) ($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 <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)).
+ $fApplicativeReaderT5 @(ST s) @r $dApplicative
+ = ($fApplicativeReaderT6 @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)).
+ $fMonadReaderT_$c>> @(ST s) @r $dMonad
+ = $fMonadAbstractIOSTReaderT_$s$c>> @s @r
+"SPEC $c>>= @(ST s) _"
+ forall (@s) (@r) ($dMonad :: Monad (ST s)).
+ $fMonadReaderT1 @(ST s) @r $dMonad
+ = ($fMonadReaderT2 @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 $cliftA2 @(ST s) _"
+ forall (@s) (@r) ($dApplicative :: Applicative (ST s)).
+ $fApplicativeReaderT_$cliftA2 @(ST s) @r $dApplicative
+ = ($fApplicativeReaderT1 @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 $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
"SPEC useAbstractMonad"
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 04cab4234f..623da259ef 100644
--- a/testsuite/tests/simplCore/should_compile/all.T
+++ b/testsuite/tests/simplCore/should_compile/all.T
@@ -354,3 +354,4 @@ test('T19581', [ grep_errmsg(r'case') ], compile, ['-O -ddump-simpl -dsuppress-u
test('T19599', normal, compile, ['-O -ddump-rules'])
test('T19599a', normal, compile, ['-O -ddump-rules'])
+test('T13873', [ grep_errmsg(r'SPEC') ], compile, ['-O -ddump-rules'])