diff options
| -rw-r--r-- | libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs | 19 | ||||
| -rw-r--r-- | libraries/template-haskell/Language/Haskell/TH/Syntax.hs | 2 | ||||
| -rw-r--r-- | libraries/template-haskell/changelog.md | 2 | ||||
| -rw-r--r-- | testsuite/tests/quotes/T18521.hs | 15 | ||||
| -rw-r--r-- | testsuite/tests/quotes/all.T | 1 |
5 files changed, 36 insertions, 3 deletions
diff --git a/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs b/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs index cb19882a97..fa38e6a933 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Lib/Internal.hs @@ -1,4 +1,5 @@ -{-# LANGUAGE Safe #-} +{-# LANGUAGE PolyKinds #-} +{-# LANGUAGE Trustworthy #-} -- | -- Language.Haskell.TH.Lib.Internal exposes some additional functionality that @@ -19,19 +20,31 @@ module Language.Haskell.TH.Lib.Internal where import Language.Haskell.TH.Syntax hiding (Role, InjectivityAnn) import qualified Language.Haskell.TH.Syntax as TH import Control.Applicative(liftA, liftA2) +import qualified Data.Kind as Kind (Type) import Data.Word( Word8 ) +import GHC.Exts (TYPE) import Prelude ---------------------------------------------------------- -- * Type synonyms ---------------------------------------------------------- +-- Since GHC 8.8 is currently the minimum boot compiler version that we must +-- support, we must use inline kind signatures to make TExpQ and CodeQ +-- levity polymorphic. When we drop support for GHC 8.8, we can instead use +-- standalone kind signatures, which are provided as comments. + +-- | Levity-polymorphic since /template-haskell-2.17.0.0/. +-- type TExpQ :: TYPE r -> Kind.Type +type TExpQ (a :: TYPE r) = Q (TExp a) + +-- type CodeQ :: TYPE r -> Kind.Type +type CodeQ = Code Q :: (TYPE r -> Kind.Type) + type InfoQ = Q Info type PatQ = Q Pat type FieldPatQ = Q FieldPat type ExpQ = Q Exp -type TExpQ a = Q (TExp a) -type CodeQ = Code Q type DecQ = Q Dec type DecsQ = Q [Dec] type Decs = [Dec] -- Defined as it is more convenient to wire-in diff --git a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs index dac97c641f..9c47b6cfdd 100644 --- a/libraries/template-haskell/Language/Haskell/TH/Syntax.hs +++ b/libraries/template-haskell/Language/Haskell/TH/Syntax.hs @@ -341,6 +341,8 @@ newtype TExp (a :: TYPE (r :: RuntimeRep)) = TExp -- • In the Template Haskell quotation [|| "foo" ||] -- In the expression: [|| "foo" ||] -- In the Template Haskell splice $$([|| "foo" ||]) +-- +-- Levity-polymorphic since /template-haskell-2.16.0.0/. -- | Discard the type annotation and produce a plain Template Haskell -- expression diff --git a/libraries/template-haskell/changelog.md b/libraries/template-haskell/changelog.md index eb72b11858..8cd88b5ccc 100644 --- a/libraries/template-haskell/changelog.md +++ b/libraries/template-haskell/changelog.md @@ -32,6 +32,8 @@ * Add support for QualifiedDo. The data constructors `DoE` and `MDoE` got a new `Maybe ModName` argument to describe the qualifier of do blocks. + * The argument to `TExpQ` can now be levity polymorphic. + ## 2.16.0.0 *TBA* * Add support for tuple sections. (#15843) The type signatures of `TupE` and diff --git a/testsuite/tests/quotes/T18521.hs b/testsuite/tests/quotes/T18521.hs new file mode 100644 index 0000000000..9b5965ae3b --- /dev/null +++ b/testsuite/tests/quotes/T18521.hs @@ -0,0 +1,15 @@ +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE TemplateHaskellQuotes #-} +module T18521 where + +import GHC.Exts (Int#) +import Language.Haskell.TH + +a :: Code Q Int# +a = [|| 42# ||] + +b :: CodeQ Int# +b = a + +c :: TExpQ Int# +c = examineCode a diff --git a/testsuite/tests/quotes/all.T b/testsuite/tests/quotes/all.T index 3f20d2982c..b0e5274761 100644 --- a/testsuite/tests/quotes/all.T +++ b/testsuite/tests/quotes/all.T @@ -19,6 +19,7 @@ test('T16384', req_th, compile, ['']) test('T17857', normal, compile, ['']) test('T18103', normal, compile, ['']) test('T18263', normal, compile_fail, ['']) +test('T18521', normal, compile, ['']) test('TH_tf2', normal, compile, ['-v0']) test('TH_ppr1', normal, compile_and_run, ['']) |