Skip to content

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.

To upload designs, you'll need to enable LFS and have an admin enable hashed storage. More information