Internal error when applying a scoped type variable inside a typed expression quotation
{-# LANGUAGE TemplateHaskell #-}
import TestMod
f :: Int
f = $$(foo)
main :: IO ()
main = main
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeApplications #-}
module TestMod where
import Language.Haskell.TH.Syntax (Q, TExp)
get :: forall a. Int
get = 1
foo :: forall a. Q (TExp Int)
foo = [|| get @a ||]
Test.hs:6:8: error:
• The exact Name ‘a’ is not in scope
Probable cause: you used a unique Template Haskell name (NameU),
perhaps via newName, but did not bind it
If that's it, then -ddump-splices might be useful
• In the result of the splice:
$foo
To see what the splice expanded to, use -ddump-splices
In the Template Haskell splice $$(foo)
In the expression: $$(foo)
|
6 | f = $$(foo)
| ^^^
Test.hs:6:8: error:
• GHC internal error: ‘a’ is not in scope during type checking, but it passed the renamer
tcl_env of environment: [r3Kl :-> Identifier[f::Int, TopLevelLet [] True],
r3PI :-> Identifier[main::IO (), TopLevelLet [r3PI :-> main] True]]
• In the type ‘a’
In the expression: get @a
In the result of the splice:
$foo
To see what the splice expanded to, use -ddump-splices
|
6 | f = $$(foo)
|
Trac metadata
Trac field | Value |
---|---|
Version | 8.4.3 |
Type | Bug |
TypeOfFailure | OtherFailure |
Priority | normal |
Resolution | Unresolved |
Component | Compiler |
Test case | |
Differential revisions | |
BlockedBy | |
Related | |
Blocking | |
CC | |
Operating system | |
Architecture |
To upload designs, you'll need to enable LFS and have an admin enable hashed storage. More information