[Git][ghc/ghc][wip/T24031] Deprecate PrimTyConI
Teo Camarasu (@teo)
gitlab at gitlab.haskell.org
Wed Jul 3 11:24:26 UTC 2024
Teo Camarasu pushed to branch wip/T24031 at Glasgow Haskell Compiler / GHC
Commits:
cd609eee by Teo Camarasu at 2024-07-03T12:24:15+01:00
Deprecate PrimTyConI
- We produce `TyConI` for types where we used to use `PrimTyConI`.
- We add a deprecation warning to `PrimTyConI`
- We add a test case to ensure we can actually reify primitive types.
Resolves #24031
- - - - -
8 changed files:
- compiler/GHC/Tc/Gen/Splice.hs
- libraries/ghc-boot-th/GHC/Internal/TH/Ppr.hs
- libraries/ghc-internal/src/GHC/Internal/TH/Syntax.hs
- libraries/template-haskell/changelog.md
- testsuite/tests/th/T16293b.hs
- + testsuite/tests/th/T24031.hs
- + testsuite/tests/th/T24031.stdout
- testsuite/tests/th/all.T
Changes:
=====================================
compiler/GHC/Tc/Gen/Splice.hs
=====================================
@@ -26,7 +26,7 @@ module GHC.Tc.Gen.Splice(
runMetaE, runMetaP, runMetaT, runMetaD, runQuasi,
tcTopSpliceExpr, lookupThName_maybe,
defaultRunMeta, runMeta', runRemoteModFinalizers,
- finishTH, runTopSplice
+ finishTH, runTopSplice, reifyName
) where
import GHC.Prelude
@@ -2135,15 +2135,6 @@ reifyTyCon tc
| Just cls <- tyConClass_maybe tc
= reifyClass cls
-{- Seems to be just a short cut for the next equation -- omit
- | tc `hasKey` fUNTyConKey -- I'm not quite sure what is happening here
- = return (TH.PrimTyConI (reifyName tc) 2 False)
--}
-
- | isPrimTyCon tc
- = return (TH.PrimTyConI (reifyName tc) (length (tyConVisibleTyVars tc))
- (isUnliftedTypeKind (tyConResKind tc)))
-
| isTypeFamilyTyCon tc
= do { let tvs = tyConTyVars tc
res_kind = tyConResKind tc
=====================================
libraries/ghc-boot-th/GHC/Internal/TH/Ppr.hs
=====================================
@@ -1,5 +1,6 @@
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE LambdaCase #-}
+{-# OPTIONS_GHC -Wno-deprecations #-}
-- | contains a prettyprinter for the
-- Template Haskell datatypes
=====================================
libraries/ghc-internal/src/GHC/Internal/TH/Syntax.hs
=====================================
@@ -1554,6 +1554,7 @@ data Info
Name
Type -- What it is bound to
deriving( Show, Eq, Ord, Data, Generic )
+{-# DEPRECATED PrimTyConI "TyConI is now produced instead." #-}
-- | Obtained from 'reifyModule' in the 'Q' Monad.
data ModuleInfo =
=====================================
libraries/template-haskell/changelog.md
=====================================
@@ -3,6 +3,7 @@
## 2.22.1.0
* `Lift` instances were added for the `template-haskell` AST.
+ * `PrimTyConI` has been deprecated. `TyConI` will now be used to represent primitive types.
## 2.22.0.0
=====================================
testsuite/tests/th/T16293b.hs
=====================================
@@ -7,7 +7,8 @@ import GHC.Exts
import Language.Haskell.TH
f :: ()
-f = $(do PrimTyConI _ arity _ <- reify ''Proxy#
+f = $(do TyConI (DataD _ _ targs _ _ _) <- reify ''Proxy#
+ let arity = length targs
unless (arity == 1) $
fail $ "Unexpected arity for Proxy#: " ++ show arity
[| () |])
=====================================
testsuite/tests/th/T24031.hs
=====================================
@@ -0,0 +1,28 @@
+{-# LANGUAGE MagicHash #-}
+{-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE LinearTypes #-}
+-- | This test shows that we can reify a bunch of primitive types.
+-- Additionally it acts as a golden test to ensure that we don't
+-- accidentally change our output for these types.
+
+import Control.Monad
+import Data.Char
+import GHC.Exts
+import Language.Haskell.TH
+import Language.Haskell.TH.Syntax
+import GHC.Builtin.Types.Prim (primTyCons)
+import GHC.Tc.Gen.Splice (reifyName)
+
+main :: IO ()
+main = $(do let types = map reifyName primTyCons
+ reified <- mapM reify types
+ let stripInt [] = []
+ stripInt (x:xs)
+ | isDigit x = stripInt xs
+ | otherwise = x:xs
+ -- remove _[0-9]* sequences
+ let stripUniques ('_':xs) = stripUniques $ stripInt xs
+ stripUniques (x:xs)= x:stripUniques xs
+ stripUniques [] = []
+ let output = lift $ map (stripUniques . show) reified
+ [| mapM_ putStrLn $output |])
=====================================
testsuite/tests/th/T24031.stdout
=====================================
@@ -0,0 +1,74 @@
+TyConI (DataD [] GHC.Prim.~# [KindedTV a BndrReq (VarT k0),KindedTV b BndrReq (VarT k1)] Nothing [] [])
+TyConI (DataD [] GHC.Prim.~R# [KindedTV a BndrReq (VarT k0),KindedTV b BndrReq (VarT k1)] Nothing [] [])
+TyConI (DataD [] GHC.Prim.~P# [KindedTV a BndrReq (VarT k0),KindedTV b BndrReq (VarT k1)] Nothing [] [])
+TyConI (DataD [] GHC.Prim.=> [KindedTV a BndrReq (AppT (ConT GHC.Prim.CONSTRAINT) (VarT q)),KindedTV b BndrReq (AppT (ConT GHC.Prim.TYPE) (VarT r))] Nothing [] [])
+TyConI (DataD [] GHC.Prim.==> [KindedTV a BndrReq (AppT (ConT GHC.Prim.CONSTRAINT) (VarT q)),KindedTV b BndrReq (AppT (ConT GHC.Prim.CONSTRAINT) (VarT r))] Nothing [] [])
+TyConI (DataD [] GHC.Prim.-=> [KindedTV a BndrReq (AppT (ConT GHC.Prim.TYPE) (VarT q)),KindedTV b BndrReq (AppT (ConT GHC.Prim.CONSTRAINT) (VarT r))] Nothing [] [])
+TyConI (DataD [] GHC.Prim.Addr# [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.Array# [KindedTV a BndrReq (AppT (ConT GHC.Prim.TYPE) (AppT (PromotedT GHC.Types.BoxedRep) (VarT l)))] Nothing [] [])
+TyConI (DataD [] GHC.Prim.ByteArray# [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.SmallArray# [KindedTV a BndrReq (AppT (ConT GHC.Prim.TYPE) (AppT (PromotedT GHC.Types.BoxedRep) (VarT l)))] Nothing [] [])
+TyConI (DataD [] GHC.Prim.Char# [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.Double# [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.Float# [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.Int# [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.Int8# [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.Int16# [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.Int32# [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.Int64# [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.BCO [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.Weak# [KindedTV a BndrReq (AppT (ConT GHC.Prim.TYPE) (AppT (PromotedT GHC.Types.BoxedRep) (VarT l)))] Nothing [] [])
+TyConI (DataD [] GHC.Prim.MutableArray# [KindedTV a BndrReq StarT,KindedTV b BndrReq (AppT (ConT GHC.Prim.TYPE) (AppT (PromotedT GHC.Types.BoxedRep) (VarT l)))] Nothing [] [])
+TyConI (DataD [] GHC.Prim.MutableByteArray# [KindedTV a BndrReq StarT] Nothing [] [])
+TyConI (DataD [] GHC.Prim.SmallMutableArray# [KindedTV a BndrReq StarT,KindedTV b BndrReq (AppT (ConT GHC.Prim.TYPE) (AppT (PromotedT GHC.Types.BoxedRep) (VarT l)))] Nothing [] [])
+TyConI (DataD [] GHC.Prim.MVar# [KindedTV a BndrReq StarT,KindedTV b BndrReq (AppT (ConT GHC.Prim.TYPE) (AppT (PromotedT GHC.Types.BoxedRep) (VarT l)))] Nothing [] [])
+TyConI (DataD [] GHC.Prim.IOPort# [KindedTV a BndrReq StarT,KindedTV b BndrReq (AppT (ConT GHC.Prim.TYPE) (AppT (PromotedT GHC.Types.BoxedRep) (VarT l)))] Nothing [] [])
+TyConI (DataD [] GHC.Prim.TVar# [KindedTV a BndrReq StarT,KindedTV b BndrReq (AppT (ConT GHC.Prim.TYPE) (AppT (PromotedT GHC.Types.BoxedRep) (VarT l)))] Nothing [] [])
+TyConI (DataD [] GHC.Prim.MutVar# [KindedTV a BndrReq StarT,KindedTV b BndrReq (AppT (ConT GHC.Prim.TYPE) (AppT (PromotedT GHC.Types.BoxedRep) (VarT l)))] Nothing [] [])
+TyConI (DataD [] GHC.Prim.RealWorld [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.StablePtr# [KindedTV a BndrReq (AppT (ConT GHC.Prim.TYPE) (AppT (PromotedT GHC.Types.BoxedRep) (VarT l)))] Nothing [] [])
+TyConI (DataD [] GHC.Prim.StableName# [KindedTV a BndrReq (AppT (ConT GHC.Prim.TYPE) (AppT (PromotedT GHC.Types.BoxedRep) (VarT l)))] Nothing [] [])
+TyConI (DataD [] GHC.Prim.Compact# [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.State# [KindedTV a BndrReq StarT] Nothing [] [])
+TyConI (DataD [] GHC.Prim.Proxy# [KindedTV a BndrReq (VarT k)] Nothing [] [])
+TyConI (DataD [] GHC.Prim.ThreadId# [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.Word# [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.Word8# [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.Word16# [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.Word32# [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.Word64# [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.StackSnapshot# [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.PromptTag# [KindedTV a BndrReq StarT] Nothing [] [])
+TyConI (DataD [] GHC.Prim.FUN [KindedTV n BndrReq (ConT GHC.Types.Multiplicity),KindedTV a BndrReq (AppT (ConT GHC.Prim.TYPE) (VarT q)),KindedTV b BndrReq (AppT (ConT GHC.Prim.TYPE) (VarT r))] Nothing [] [])
+TyConI (DataD [] GHC.Prim.TYPE [KindedTV a BndrReq (ConT GHC.Types.RuntimeRep)] Nothing [] [])
+TyConI (DataD [] GHC.Prim.CONSTRAINT [KindedTV a BndrReq (ConT GHC.Types.RuntimeRep)] Nothing [] [])
+TyConI (DataD [] GHC.Prim.Int8X16# [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.Int16X8# [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.Int32X4# [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.Int64X2# [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.Int8X32# [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.Int16X16# [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.Int32X8# [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.Int64X4# [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.Int8X64# [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.Int16X32# [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.Int32X16# [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.Int64X8# [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.Word8X16# [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.Word16X8# [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.Word32X4# [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.Word64X2# [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.Word8X32# [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.Word16X16# [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.Word32X8# [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.Word64X4# [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.Word8X64# [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.Word16X32# [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.Word32X16# [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.Word64X8# [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.FloatX4# [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.DoubleX2# [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.FloatX8# [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.DoubleX4# [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.FloatX16# [] Nothing [] [])
+TyConI (DataD [] GHC.Prim.DoubleX8# [] Nothing [] [])
=====================================
testsuite/tests/th/all.T
=====================================
@@ -617,3 +617,4 @@ test('T24702b', normal, compile, [''])
test('T24837', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
test('T24911', normal, compile, ['-v0 -ddump-splices -dsuppress-uniques'])
test('T24997', normal, compile_and_run, [''])
+test('T24031', normal, compile_and_run, ['-package ghc'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cd609eeece220e69bb211b470b71f720aa0e35ed
--
This project does not include diff previews in email notifications.
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/cd609eeece220e69bb211b470b71f720aa0e35ed
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/20240703/3fd29ce7/attachment-0001.html>
More information about the ghc-commits
mailing list