diff options
| -rw-r--r-- | compiler/typecheck/TcSplice.hs | 15 | ||||
| -rw-r--r-- | testsuite/tests/th/T10596.hs | 11 | ||||
| -rw-r--r-- | testsuite/tests/th/T10596.stderr | 1 | ||||
| -rw-r--r-- | testsuite/tests/th/all.T | 1 |
4 files changed, 24 insertions, 4 deletions
diff --git a/compiler/typecheck/TcSplice.hs b/compiler/typecheck/TcSplice.hs index a7363d85a1..2e368a9cca 100644 --- a/compiler/typecheck/TcSplice.hs +++ b/compiler/typecheck/TcSplice.hs @@ -6,7 +6,11 @@ TcSplice: Template Haskell splices -} -{-# LANGUAGE CPP, FlexibleInstances, MagicHash, ScopedTypeVariables #-} +{-# LANGUAGE CPP #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MagicHash #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE InstanceSigs #-} {-# OPTIONS_GHC -fno-warn-orphans #-} module TcSplice( @@ -106,7 +110,7 @@ import GHC.Desugar ( AnnotationWrapper(..) ) import qualified Data.Map as Map import Data.Dynamic ( fromDynamic, toDyn ) -import Data.Typeable ( typeOf ) +import Data.Typeable ( typeOf, Typeable ) import Data.Data (Data) import GHC.Exts ( unsafeCoerce# ) #endif @@ -833,11 +837,14 @@ instance TH.Quasi (IOEnv (Env TcGblEnv TcLclEnv)) where th_modfinalizers_var <- fmap tcg_th_modfinalizers getGblEnv updTcRef th_modfinalizers_var (\fins -> fin:fins) + qGetQ :: forall a. Typeable a => IOEnv (Env TcGblEnv TcLclEnv) (Maybe a) qGetQ = do th_state_var <- fmap tcg_th_state getGblEnv th_state <- readTcRef th_state_var - let x = Map.lookup (typeOf x) th_state >>= fromDynamic - return x + -- See #10596 for why we use a scoped type variable here. + -- ToDo: convert @undefined :: a@ to @proxy :: Proxy a@ when + -- we drop support for GHC 7.6. + return (Map.lookup (typeOf (undefined :: a)) th_state >>= fromDynamic) qPutQ x = do th_state_var <- fmap tcg_th_state getGblEnv diff --git a/testsuite/tests/th/T10596.hs b/testsuite/tests/th/T10596.hs new file mode 100644 index 0000000000..c861156734 --- /dev/null +++ b/testsuite/tests/th/T10596.hs @@ -0,0 +1,11 @@ +{-# LANGUAGE TemplateHaskell #-} +module T10596 where +import Language.Haskell.TH +import Language.Haskell.TH.Syntax +do + putQ (100 :: Int) + x <- (getQ :: Q (Maybe Int)) + + -- It should print "Just 100" + runIO $ print x + return [] diff --git a/testsuite/tests/th/T10596.stderr b/testsuite/tests/th/T10596.stderr new file mode 100644 index 0000000000..4b58162ef8 --- /dev/null +++ b/testsuite/tests/th/T10596.stderr @@ -0,0 +1 @@ +Just 100 diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index 084ace54d0..1ec99d5f02 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -345,3 +345,4 @@ test('T10047', normal, ghci_script, ['T10047.script']) test('T10019', normal, ghci_script, ['T10019.script']) test('T10279', normal, compile_fail, ['-v0']) test('T10306', normal, compile, ['-v0']) +test('T10596', normal, compile, ['-v0']) |