[Git][ghc/ghc][wip/T24031] Deprecate PrimTyConI
Teo Camarasu (@teo)
gitlab at gitlab.haskell.org
Wed Mar 6 15:14:04 UTC 2024
Teo Camarasu pushed to branch wip/T24031 at Glasgow Haskell Compiler / GHC
Commits:
a7072520 by Teo Camarasu at 2024-03-06T15:13:55+00: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/template-haskell/Language/Haskell/TH/Ppr.hs
- libraries/template-haskell/Language/Haskell/TH/Syntax.hs
- libraries/template-haskell/changelog.md
- testsuite/tests/th/T16293b.hs
- + testsuite/tests/th/T24031.hs
- + testsuite/tests/th/T24031.stderr
- 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
@@ -2120,15 +2120,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/template-haskell/Language/Haskell/TH/Ppr.hs
=====================================
@@ -1,5 +1,6 @@
{-# LANGUAGE Safe #-}
{-# LANGUAGE LambdaCase #-}
+{-# OPTIONS_GHC -Wno-deprecations #-}
-- | contains a prettyprinter for the
-- Template Haskell datatypes
=====================================
libraries/template-haskell/Language/Haskell/TH/Syntax.hs
=====================================
@@ -2068,6 +2068,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
=====================================
@@ -1,5 +1,8 @@
# Changelog for [`template-haskell` package](http://hackage.haskell.org/package/template-haskell)
+## 2.23.0.0
+ * `PrimTyConI` has been deprecated. `TyConI` will now be used to represent primitive types.
+
## 2.22.0.0
* The kind of `Code` was changed from `forall r. (Type -> Type) -> TYPE r -> Type`
=====================================
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.
+module T24031 where
+
+import Control.Monad
+import Data.Char
+import GHC.Exts
+import Language.Haskell.TH
+import GHC.Builtin.Types.Prim
+import GHC.Tc.Gen.Splice
+
+f :: ()
+f = $(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 [] = []
+ mapM_ (runIO . putStrLn . stripUniques . show) reified
+ [| () |])
=====================================
testsuite/tests/th/T24031.stderr
=====================================
@@ -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
=====================================
@@ -604,3 +604,4 @@ test('T24308', normal, compile_and_run, [''])
test('T14032a', normal, compile, [''])
test('T14032e', normal, compile_fail, ['-dsuppress-uniques'])
test('ListTuplePunsTH', [only_ways(['ghci']), extra_files(['ListTuplePunsTH.hs', 'T15843a.hs'])], ghci_script, ['ListTuplePunsTH.script'])
+test('T24031', normal, compile, ['-package ghc'])
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a707252053e03bcf89a5ca4a82d2766d2d22b89a
--
View it on GitLab: https://gitlab.haskell.org/ghc/ghc/-/commit/a707252053e03bcf89a5ca4a82d2766d2d22b89a
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/20240306/bfca4356/attachment-0001.html>
More information about the ghc-commits
mailing list