diff options
| author | Ryan Scott <ryan.gl.scott@gmail.com> | 2021-04-27 19:02:03 -0400 |
|---|---|---|
| committer | Ryan Scott <ryan.gl.scott@gmail.com> | 2021-04-27 19:02:04 -0400 |
| commit | d03ae1c938d35eaaf43fc070b14522ff277f8bef (patch) | |
| tree | 73b75b17126543bf48bc93cbf17c94ce73664c22 | |
| parent | dd121fa178c29a154233e95a15c755d0ca7cbdcc (diff) | |
| download | haskell-wip/T19759.tar.gz | |
Propagate free variables in extract_lctxt correctlywip/T19759
This fixes an oversight in the implementation of `extract_lctxt` which
was introduced in commit ce85cffc. Fixes #19759.
| -rw-r--r-- | compiler/GHC/Rename/HsType.hs | 2 | ||||
| -rw-r--r-- | testsuite/tests/th/T19759.hs | 25 | ||||
| -rw-r--r-- | testsuite/tests/th/all.T | 1 |
3 files changed, 27 insertions, 1 deletions
diff --git a/compiler/GHC/Rename/HsType.hs b/compiler/GHC/Rename/HsType.hs index d11c4c9634..f92100ffe2 100644 --- a/compiler/GHC/Rename/HsType.hs +++ b/compiler/GHC/Rename/HsType.hs @@ -1910,7 +1910,7 @@ extractDataDefnKindVars (HsDataDefn { dd_kindSig = ksig }) = maybe [] extractHsTyRdrTyVars ksig extract_lctxt :: Maybe (LHsContext GhcPs) -> FreeKiTyVars -> FreeKiTyVars -extract_lctxt Nothing = const [] +extract_lctxt Nothing = id extract_lctxt (Just ctxt) = extract_ltys (unLoc ctxt) extract_scaled_ltys :: [HsScaled GhcPs (LHsType GhcPs)] diff --git a/testsuite/tests/th/T19759.hs b/testsuite/tests/th/T19759.hs new file mode 100644 index 0000000000..96c1684a0b --- /dev/null +++ b/testsuite/tests/th/T19759.hs @@ -0,0 +1,25 @@ +{-# LANGUAGE PatternSynonyms #-} +{-# LANGUAGE TemplateHaskell #-} +module T19759 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 [] [VarP x, VarP y] + ]) + diff --git a/testsuite/tests/th/all.T b/testsuite/tests/th/all.T index fb3bc7fb49..0d0e997440 100644 --- a/testsuite/tests/th/all.T +++ b/testsuite/tests/th/all.T @@ -524,3 +524,4 @@ test('T19377', normal, compile, ['']) test('T17804', normal, compile, ['']) test('T19470', only_ways(['ghci']), ghci_script, ['T19470.script']) test('T19737', normal, compile, ['']) +test('T19759', normal, compile, ['']) |