GHC 9.2.1-alpha2 fails to compile TH-generated pattern synonym that 9.0.1 can handle
GHC 9.0.1 has no problem compiling the following program:
{-# LANGUAGE CPP #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE TemplateHaskell #-}
module Bug where
import Language.Haskell.TH
data T a where
MkT :: a -> b -> T a
{-
pattern MkT' :: () => forall b. a -> b -> T a
pattern MkT' x y = MkT x y
-}
$(do let mkT' = mkName "MkT'"
a <- newName "a"
b <- newName "b"
x <- newName "x"
y <- newName "y"
pure [ PatSynSigD mkT' $ ForallT [] [] $ ForallT [PlainTV b SpecifiedSpec] []
$ ArrowT `AppT` VarT a `AppT` (ArrowT `AppT` VarT b `AppT` (ConT ''T `AppT` VarT a))
, PatSynD mkT' (PrefixPatSyn [x, y]) ImplBidir $
ConP 'MkT
-- The CPP is only used to allow testing this program with both 9.0 and 9.2
#if MIN_VERSION_template_haskell(2,18,0)
[]
#endif
[VarP x, VarP y]
])
On the other hand, GHC 9.2.1-alpha2 fails to compile it:
$ ~/Software/ghc-9.2.1-alpha2/bin/ghc Bug.hs -ddump-splices
[1 of 1] Compiling Bug ( Bug.hs, Bug.o, Bug.dyn_o )
Bug.hs:(18,2)-(32,12): Splicing declarations
do let mkT'_apk = mkName "MkT'"
a_a1Jz <- newName "a"
b_a1JA <- newName "b"
x_a1JB <- newName "x"
y_a1JC <- newName "y"
pure
[PatSynSigD mkT'_apk
$ ForallT [] []
$ ForallT [PlainTV b_a1JA SpecifiedSpec] []
$ ArrowT `AppT` VarT a_a1Jz
`AppT`
(ArrowT `AppT` VarT b_a1JA `AppT` (ConT ''T `AppT` VarT a_a1Jz)),
PatSynD mkT'_apk (PrefixPatSyn [x_a1JB, y_a1JC]) ImplBidir
$ ConP 'MkT [] [VarP x_a1JB, VarP y_a1JC]]
======>
pattern MkT' :: () => forall b_a267. a_a266 -> b_a267 -> T a_a266
pattern MkT' x_a268 y_a269 = MkT x_a268 y_a269
Bug.hs:18:2: error:
The exact Name ‘a_a266’ 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
|
18 | $(do let mkT' = mkName "MkT'"
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^...
Bug.hs:18:2: error:
The exact Name ‘a_a266’ 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
|
18 | $(do let mkT' = mkName "MkT'"
| ^^^^^^^^^^^^^^^^^^^^^^^^^^^^...
The culprit is commit ce85cffc (Wrap LHsContext in Maybe in the GHC AST
), which introduced this change:
-extract_lctxt :: LHsContext GhcPs -> FreeKiTyVars -> FreeKiTyVars
-extract_lctxt ctxt = extract_ltys (unLoc ctxt)
+extract_lctxt :: Maybe (LHsContext GhcPs) -> FreeKiTyVars -> FreeKiTyVars
+extract_lctxt Nothing = const []
+extract_lctxt (Just ctxt) = extract_ltys (unLoc ctxt)
The extract_lctxt Nothing = const []
is very suspicious, as it ignores the accumulated FreeKiTyVars
and always returns the empty list. This is the cause of the bug above, as normally the free type variable a
would be brought into scope, but because of the use of const []
, no free variables are brought into scope at all.
Patch incoming.