[Git][ghc/ghc][wip/quote-typedata] Fix quoting 'type data' declarations

[Krzysztof Gogolewski (@monoidal)]

Krzysztof Gogolewski pushed to branch wip/quote-typedata at Glasgow Haskell Compiler / GHC


Commits:
af959b4e by Krzysztof Gogolewski at 2022-11-22T21:32:29+01:00
Fix quoting 'type data' declarations

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.

- - - - -


7 changed files:

- compiler/GHC/HsToCore/Errors/Ppr.hs
- compiler/GHC/HsToCore/Errors/Types.hs
- compiler/GHC/HsToCore/Quote.hs
- testsuite/tests/quotes/TH_abstractFamily.stderr
- + testsuite/tests/quotes/TH_typedata.hs
- + testsuite/tests/quotes/TH_typedata.stderr
- testsuite/tests/quotes/all.T


Changes:

=====================================
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 $


=====================================
compiler/GHC/HsToCore/Errors/Types.hs
=====================================
@@ -175,6 +175,7 @@ data ThRejectionReason
   | ThWarningAndDeprecationPragmas [LIdP GhcRn]
   | ThSplicesWithinDeclBrackets
   | ThNonLinearDataCon
+  | ThTypeData
 
 data NegLiteralExtEnabled
   = YesUsingNegLiterals


=====================================
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 ()))]


=====================================
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
         ..


=====================================
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 |]


=====================================
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


=====================================
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, [''])



View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/af959b4e94804aa53687c4394a708e9bde66fff0

-- 
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/af959b4e94804aa53687c4394a708e9bde66fff0
You're receiving this email because of your account on gitlab.haskell.org.


-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/ghc-commits/attachments/20221122/6173b3f8/attachment-0001.html>