diff options
author | Krzysztof Gogolewski <krzysztof.gogolewski@tweag.io> | 2022-11-16 16:23:59 +0100 |
---|---|---|
committer | Krzysztof Gogolewski <krzysztof.gogolewski@tweag.io> | 2022-11-22 21:32:29 +0100 |
commit | af959b4e94804aa53687c4394a708e9bde66fff0 (patch) | |
tree | b031b9d0bedac0007f19c516268d3c018809a3f2 | |
parent | de5fb3489f2a9bd6dc75d0cb8925a27fe9b9084b (diff) | |
download | haskell-af959b4e94804aa53687c4394a708e9bde66fff0.tar.gz |
Fix quoting 'type data' declarationswip/quote-typedata
The quote [d|type data T|] was ignoring the type data flag and
giving the same result as [d|data T|].
Instead, we now fail, until support for 'type data' in TH is implemented.
-rw-r--r-- | compiler/GHC/HsToCore/Errors/Ppr.hs | 4 | ||||
-rw-r--r-- | compiler/GHC/HsToCore/Errors/Types.hs | 1 | ||||
-rw-r--r-- | compiler/GHC/HsToCore/Quote.hs | 11 | ||||
-rw-r--r-- | testsuite/tests/quotes/TH_abstractFamily.stderr | 2 | ||||
-rw-r--r-- | testsuite/tests/quotes/TH_typedata.hs | 8 | ||||
-rw-r--r-- | testsuite/tests/quotes/TH_typedata.stderr | 3 | ||||
-rw-r--r-- | testsuite/tests/quotes/all.T | 1 |
7 files changed, 23 insertions, 7 deletions
diff --git a/compiler/GHC/HsToCore/Errors/Ppr.hs b/compiler/GHC/HsToCore/Errors/Ppr.hs index 745f701d8f..21be8d3d76 100644 --- a/compiler/GHC/HsToCore/Errors/Ppr.hs +++ b/compiler/GHC/HsToCore/Errors/Ppr.hs @@ -128,7 +128,7 @@ instance Diagnostic DsMessage where ThAmbiguousRecordUpdates fld -> mkMsg "Ambiguous record updates" (ppr fld) ThAbstractClosedTypeFamily decl - -> mkMsg "abstract closed type family" (ppr decl) + -> mkMsg "Abstract closed type family" (ppr decl) ThForeignLabel cls -> mkMsg "Foreign label" (doubleQuotes (ppr cls)) ThForeignExport decl @@ -168,6 +168,8 @@ instance Diagnostic DsMessage where -> mkMsg "Splices within declaration brackets" empty ThNonLinearDataCon -> mkMsg "Non-linear fields in data constructors" empty + ThTypeData + -> mkMsg "Type data" empty where mkMsg what doc = mkSimpleDecorated $ diff --git a/compiler/GHC/HsToCore/Errors/Types.hs b/compiler/GHC/HsToCore/Errors/Types.hs index 8f6586fb45..25696f2a0e 100644 --- a/compiler/GHC/HsToCore/Errors/Types.hs +++ b/compiler/GHC/HsToCore/Errors/Types.hs @@ -175,6 +175,7 @@ data ThRejectionReason | ThWarningAndDeprecationPragmas [LIdP GhcRn] | ThSplicesWithinDeclBrackets | ThNonLinearDataCon + | ThTypeData data NegLiteralExtEnabled = YesUsingNegLiterals diff --git a/compiler/GHC/HsToCore/Quote.hs b/compiler/GHC/HsToCore/Quote.hs index 00f770b6de..e057628687 100644 --- a/compiler/GHC/HsToCore/Quote.hs +++ b/compiler/GHC/HsToCore/Quote.hs @@ -528,11 +528,12 @@ repDataDefn tc opts ; ksig' <- repMaybeLTy ksig ; repNewtype cxt1 tc opts ksig' con' derivs1 } - DataTypeCons _ cons -> do { ksig' <- repMaybeLTy ksig - ; consL <- mapM repC cons - ; cons1 <- coreListM conTyConName consL - ; repData cxt1 tc opts ksig' cons1 - derivs1 } + DataTypeCons td cons -> do { ksig' <- repMaybeLTy ksig + ; when td (notHandled ThTypeData) -- see #22500 + ; consL <- mapM repC cons + ; cons1 <- coreListM conTyConName consL + ; repData cxt1 tc opts ksig' cons1 + derivs1 } } repSynDecl :: Core TH.Name -> Core [(M (TH.TyVarBndr ()))] diff --git a/testsuite/tests/quotes/TH_abstractFamily.stderr b/testsuite/tests/quotes/TH_abstractFamily.stderr index 27684e9424..5c83897009 100644 --- a/testsuite/tests/quotes/TH_abstractFamily.stderr +++ b/testsuite/tests/quotes/TH_abstractFamily.stderr @@ -1,5 +1,5 @@ TH_abstractFamily.hs:11:7: error: [GHC-65904] - abstract closed type family not (yet) handled by Template Haskell + Abstract closed type family not (yet) handled by Template Haskell type family G a where .. diff --git a/testsuite/tests/quotes/TH_typedata.hs b/testsuite/tests/quotes/TH_typedata.hs new file mode 100644 index 0000000000..14cd3ac3be --- /dev/null +++ b/testsuite/tests/quotes/TH_typedata.hs @@ -0,0 +1,8 @@ +{-# LANGUAGE TypeData #-} +module TH_typedata where + +import Language.Haskell.TH + +-- See #22500 +ds1 :: Q [Dec] +ds1 = [d| type data T |] diff --git a/testsuite/tests/quotes/TH_typedata.stderr b/testsuite/tests/quotes/TH_typedata.stderr new file mode 100644 index 0000000000..8b2a41fa25 --- /dev/null +++ b/testsuite/tests/quotes/TH_typedata.stderr @@ -0,0 +1,3 @@ + +TH_typedata.hs:8:7: error: [GHC-65904] + Type data not (yet) handled by Template Haskell diff --git a/testsuite/tests/quotes/all.T b/testsuite/tests/quotes/all.T index ba580ccaf4..2c47b06502 100644 --- a/testsuite/tests/quotes/all.T +++ b/testsuite/tests/quotes/all.T @@ -38,6 +38,7 @@ test('TH_nested_splice', normal, compile, ['']) test('TH_top_splice', normal, compile_fail, ['']) test('TTH_top_splice', normal, compile_fail, ['']) test('TH_double_splice', normal, compile_fail, ['']) +test('TH_typedata', normal, compile_fail, ['']) test('T20688', normal, compile, ['-Wimplicit-lift -Werror']) test('T20893', normal, compile_and_run, ['']) test('T21619', normal, compile, ['']) |