diff options
author | Ryan Scott <ryan.gl.scott@gmail.com> | 2018-03-05 08:57:04 -0500 |
---|---|---|
committer | Ryan Scott <ryan.gl.scott@gmail.com> | 2018-03-05 08:57:04 -0500 |
commit | 6ee831f279c91888ee5815f8eee473bcd6fd25c6 (patch) | |
tree | 3489ba2f34132d85b6e43046f7db7ce2854fa404 /testsuite | |
parent | 3d252037234ce48f9bdada7d5c9b1d8eba470829 (diff) | |
download | haskell-6ee831f279c91888ee5815f8eee473bcd6fd25c6.tar.gz |
Fix #14888 by adding more special cases for ArrowT
Summary:
There were previously some situations where `(->)` would
not be desugared or reified as `ArrowT`, leading to various oddities
such as those observed in #14888. We now uniformly treat `(->)` as
`ArrowT` in Template Haskell–world by checking for any tycon that
has the same name as `(->)`, and converting that to `ArrowT`.
Test Plan: make test TEST=T14888
Reviewers: goldfire, bgamari, simonpj
Reviewed By: goldfire, simonpj
Subscribers: simonpj, rwbarton, thomie, carter
GHC Trac Issues: #14888
Differential Revision: https://phabricator.haskell.org/D4466
Diffstat (limited to 'testsuite')
-rw-r--r-- | testsuite/tests/th/T14888.hs | 18 | ||||
-rw-r--r-- | testsuite/tests/th/T14888.stderr | 11 | ||||
-rw-r--r-- | testsuite/tests/th/all.T | 2 |
3 files changed, 31 insertions, 0 deletions
diff --git a/testsuite/tests/th/T14888.hs b/testsuite/tests/th/T14888.hs new file mode 100644 index 0000000000..e2bcec64ea --- /dev/null +++ b/testsuite/tests/th/T14888.hs @@ -0,0 +1,18 @@ +{-# LANGUAGE TemplateHaskell #-} +module T14888 where + +import Language.Haskell.TH + +foo :: $([t| (->) Bool Bool |]) +foo x = x + +class Functor' f where + fmap' :: (a -> b) -> f a -> f b + +instance Functor' ((->) r) where + fmap' = (.) + +$(return []) + +functor'Instances :: String +functor'Instances = $(reify ''Functor' >>= stringE . pprint) diff --git a/testsuite/tests/th/T14888.stderr b/testsuite/tests/th/T14888.stderr new file mode 100644 index 0000000000..963937f9f6 --- /dev/null +++ b/testsuite/tests/th/T14888.stderr @@ -0,0 +1,11 @@ +T14888.hs:6:10-30: Splicing type + [t| (->) Bool Bool |] ======> Bool -> Bool +T14888.hs:15:3-11: Splicing declarations return [] ======> +T14888.hs:18:23-59: Splicing expression + reify ''Functor' >>= stringE . pprint + ======> + "class T14888.Functor' (f_0 :: * -> *) + where T14888.fmap' :: forall (f_0 :: * -> + *) . T14888.Functor' f_0 => + forall (a_1 :: *) (b_2 :: *) . (a_1 -> b_2) -> f_0 a_1 -> f_0 b_2 +instance T14888.Functor' ((->) r_3 :: * -> *)" diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index 47e8a9c03c..e9f2838492 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -403,3 +403,5 @@ test('T14838', [], multimod_compile, ['T14838.hs', '-v0 -Wincomplete-patterns ' + config.ghc_th_way_flags]) test('T14817', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques']) test('T14843', normal, compile, ['-v0']) +test('T14888', normal, compile, + ['-v0 -ddump-splices -dsuppress-uniques ' + config.ghc_th_way_flags]) |