Commit ac3cf68c authored by Ben Gamari's avatar Ben Gamari Committed by Ben Gamari
Browse files

Add missing type representations

Previously we were missing `Typeable` representations for several
wired-in types (and their promoted constructors). These include,

 * `Nat`
 * `Symbol`
 * `':`
 * `'[]`

Moreover, some constructors were incorrectly identified as being defined
in `GHC.Types` whereas they were in fact defined in `GHC.Prim`.

Ultimately this is just a temporary band-aid as there is general
agreement that we should eliminate the manual definition of these
representations entirely.

Test Plan: Validate

Reviewers: austin, hvr

Subscribers: thomie

Differential Revision: https://phabricator.haskell.org/D1769

GHC Trac Issues: #11120
parent d44bc5c0
...@@ -18,8 +18,7 @@ module BuildTyCl ( ...@@ -18,8 +18,7 @@ module BuildTyCl (
import IfaceEnv import IfaceEnv
import FamInstEnv( FamInstEnvs, mkNewTypeCoAxiom ) import FamInstEnv( FamInstEnvs, mkNewTypeCoAxiom )
import TysWiredIn( isCTupleTyConName ) import TysWiredIn( isCTupleTyConName, tyConRepModOcc )
import PrelNames( tyConRepModOcc )
import DataCon import DataCon
import PatSyn import PatSyn
import Var import Var
......
...@@ -823,29 +823,6 @@ mkSpecialTyConRepName fs tc_name ...@@ -823,29 +823,6 @@ mkSpecialTyConRepName fs tc_name
(mkVarOccFS fs) (mkVarOccFS fs)
wiredInSrcSpan wiredInSrcSpan
-- | Make a 'Name' for the 'Typeable' representation of the given wired-in type
mkPrelTyConRepName :: Name -> Name
-- See Note [Grand plan for Typeable] in 'TcTypeable' in TcTypeable.
mkPrelTyConRepName tc_name -- Prelude tc_name is always External,
-- so nameModule will work
= mkExternalName rep_uniq rep_mod rep_occ (nameSrcSpan tc_name)
where
name_occ = nameOccName tc_name
name_mod = nameModule tc_name
name_uniq = nameUnique tc_name
rep_uniq | isTcOcc name_occ = tyConRepNameUnique name_uniq
| otherwise = dataConRepNameUnique name_uniq
(rep_mod, rep_occ) = tyConRepModOcc name_mod name_occ
-- | TODO
-- See Note [Grand plan for Typeable] in 'TcTypeable' in TcTypeable.
tyConRepModOcc :: Module -> OccName -> (Module, OccName)
tyConRepModOcc tc_module tc_occ
| tc_module == gHC_TYPES
= (tYPEABLE_INTERNAL, mkTyConRepUserOcc tc_occ)
| otherwise
= (tc_module, mkTyConRepSysOcc tc_occ)
wildCardName :: Name wildCardName :: Name
wildCardName = mkSystemVarName wildCardKey (fsLit "wild") wildCardName = mkSystemVarName wildCardKey (fsLit "wild")
......
...@@ -49,6 +49,7 @@ module TysWiredIn ( ...@@ -49,6 +49,7 @@ module TysWiredIn (
listTyCon, listTyCon_RDR, listTyConName, listTyConKey, listTyCon, listTyCon_RDR, listTyConName, listTyConKey,
nilDataCon, nilDataConName, nilDataConKey, nilDataCon, nilDataConName, nilDataConKey,
consDataCon_RDR, consDataCon, consDataConName, consDataCon_RDR, consDataCon, consDataConName,
promotedNilDataCon, promotedConsDataCon,
mkListTy, mkListTy,
...@@ -96,7 +97,10 @@ module TysWiredIn ( ...@@ -96,7 +97,10 @@ module TysWiredIn (
levityTy, levityTyCon, liftedDataCon, unliftedDataCon, levityTy, levityTyCon, liftedDataCon, unliftedDataCon,
liftedPromDataCon, unliftedPromDataCon, liftedPromDataCon, unliftedPromDataCon,
liftedDataConTy, unliftedDataConTy, liftedDataConTy, unliftedDataConTy,
liftedDataConName, unliftedDataConName liftedDataConName, unliftedDataConName,
-- * Helpers for building type representations
tyConRepModOcc
) where ) where
#include "HsVersions.h" #include "HsVersions.h"
...@@ -138,6 +142,48 @@ alpha_tyvar = [alphaTyVar] ...@@ -138,6 +142,48 @@ alpha_tyvar = [alphaTyVar]
alpha_ty :: [Type] alpha_ty :: [Type]
alpha_ty = [alphaTy] alpha_ty = [alphaTy]
-- * Some helpers for generating type representations
-- | Make a 'Name' for the 'Typeable' representation of the given wired-in type
mkPrelTyConRepName :: Name -> Name
-- See Note [Grand plan for Typeable] in 'TcTypeable' in TcTypeable.
-- This doesn't really belong here but a refactoring of this code eliminating
-- these manually-defined representations is imminent
mkPrelTyConRepName tc_name -- Prelude tc_name is always External,
-- so nameModule will work
= mkExternalName rep_uniq rep_mod rep_occ (nameSrcSpan tc_name)
where
name_occ = nameOccName tc_name
name_mod = nameModule tc_name
name_uniq = nameUnique tc_name
rep_uniq | isTcOcc name_occ = tyConRepNameUnique name_uniq
| otherwise = dataConRepNameUnique name_uniq
(rep_mod, rep_occ) = tyConRepModOcc name_mod name_occ
-- | The name (and defining module) for the Typeable representation (TyCon) of a
-- type constructor.
--
-- See Note [Grand plan for Typeable] in 'TcTypeable' in TcTypeable.
tyConRepModOcc :: Module -> OccName -> (Module, OccName)
tyConRepModOcc tc_module tc_occ
-- The list type is defined in GHC.Types and therefore must have its
-- representations defined manually in Data.Typeable.Internal.
-- However, $tc': isn't a valid Haskell identifier, so we override the derived
-- name here.
| is_wired_in promotedConsDataCon
= (tYPEABLE_INTERNAL, mkOccName varName "tc'Cons")
| is_wired_in promotedNilDataCon
= (tYPEABLE_INTERNAL, mkOccName varName "tc'Nil")
| tc_module == gHC_TYPES
= (tYPEABLE_INTERNAL, mkTyConRepUserOcc tc_occ)
| otherwise
= (tc_module, mkTyConRepSysOcc tc_occ)
where
is_wired_in :: TyCon -> Bool
is_wired_in tc =
tc_module == gHC_TYPES && tc_occ == nameOccName (tyConName tc)
{- {-
************************************************************************ ************************************************************************
* * * *
...@@ -1063,6 +1109,11 @@ promotedLTDataCon = promoteDataCon ltDataCon ...@@ -1063,6 +1109,11 @@ promotedLTDataCon = promoteDataCon ltDataCon
promotedEQDataCon = promoteDataCon eqDataCon promotedEQDataCon = promoteDataCon eqDataCon
promotedGTDataCon = promoteDataCon gtDataCon promotedGTDataCon = promoteDataCon gtDataCon
-- Promoted List
promotedConsDataCon, promotedNilDataCon :: TyCon
promotedConsDataCon = promoteDataCon consDataCon
promotedNilDataCon = promoteDataCon nilDataCon
{- {-
Note [The Implicit Parameter class] Note [The Implicit Parameter class]
......
...@@ -41,11 +41,13 @@ module Data.Typeable.Internal ( ...@@ -41,11 +41,13 @@ module Data.Typeable.Internal (
mkTyCon3, mkTyCon3#, mkTyCon3, mkTyCon3#,
rnfTyCon, rnfTyCon,
-- ** Representations for wired-in types
tcBool, tc'True, tc'False, tcBool, tc'True, tc'False,
tcOrdering, tc'LT, tc'EQ, tc'GT, tcOrdering, tc'LT, tc'EQ, tc'GT,
tcChar, tcInt, tcWord, tcFloat, tcDouble, tcFun, tcChar, tcInt, tcWord, tcFloat, tcDouble, tcFun,
tcIO, tcSPEC, tcTyCon, tcModule, tcTrName, tcIO, tcSPEC, tcTyCon, tcModule, tcTrName,
tcCoercible, tcList, tcHEq, tcCoercible, tcHEq, tcSymbol, tcNat,
tcList, tc'Nil, tc'Cons,
tcConstraint, tcConstraint,
tcTYPE, tcLevity, tc'Lifted, tc'Unlifted, tcTYPE, tcLevity, tc'Lifted, tc'Unlifted,
...@@ -401,11 +403,15 @@ mkGhcTypesTyCon :: Addr# -> TyCon ...@@ -401,11 +403,15 @@ mkGhcTypesTyCon :: Addr# -> TyCon
{-# INLINE mkGhcTypesTyCon #-} {-# INLINE mkGhcTypesTyCon #-}
mkGhcTypesTyCon name = mkTyCon3# "ghc-prim"# "GHC.Types"# name mkGhcTypesTyCon name = mkTyCon3# "ghc-prim"# "GHC.Types"# name
mkGhcPrimTyCon :: Addr# -> TyCon
{-# INLINE mkGhcPrimTyCon #-}
mkGhcPrimTyCon name = mkTyCon3# "ghc-prim"# "GHC.Prim"# name
tcBool, tc'True, tc'False, tcBool, tc'True, tc'False,
tcOrdering, tc'GT, tc'EQ, tc'LT, tcOrdering, tc'GT, tc'EQ, tc'LT,
tcChar, tcInt, tcWord, tcFloat, tcDouble, tcFun, tcChar, tcInt, tcWord, tcFloat, tcDouble, tcFun,
tcIO, tcSPEC, tcTyCon, tcModule, tcTrName, tcIO, tcSPEC, tcTyCon, tcModule, tcTrName,
tcCoercible, tcHEq, tcList :: TyCon tcCoercible, tcHEq, tcNat, tcSymbol :: TyCon
tcBool = mkGhcTypesTyCon "Bool"# -- Bool is promotable tcBool = mkGhcTypesTyCon "Bool"# -- Bool is promotable
tc'True = mkGhcTypesTyCon "'True"# tc'True = mkGhcTypesTyCon "'True"#
...@@ -415,26 +421,34 @@ tc'GT = mkGhcTypesTyCon "'GT"# ...@@ -415,26 +421,34 @@ tc'GT = mkGhcTypesTyCon "'GT"#
tc'EQ = mkGhcTypesTyCon "'EQ"# tc'EQ = mkGhcTypesTyCon "'EQ"#
tc'LT = mkGhcTypesTyCon "'LT"# tc'LT = mkGhcTypesTyCon "'LT"#
-- None of the rest are promotable (see TysWiredIn) -- Most of the rest are promotable (see TysWiredIn)
tcChar = mkGhcTypesTyCon "Char"# tcChar = mkGhcTypesTyCon "Char"#
tcInt = mkGhcTypesTyCon "Int"# tcInt = mkGhcTypesTyCon "Int"#
tcWord = mkGhcTypesTyCon "Word"# tcWord = mkGhcTypesTyCon "Word"#
tcFloat = mkGhcTypesTyCon "Float"# tcFloat = mkGhcTypesTyCon "Float"#
tcDouble = mkGhcTypesTyCon "Double"# tcDouble = mkGhcTypesTyCon "Double"#
tcNat = mkGhcTypesTyCon "Nat"#
tcSymbol = mkGhcTypesTyCon "Symbol"#
tcSPEC = mkGhcTypesTyCon "SPEC"# tcSPEC = mkGhcTypesTyCon "SPEC"#
tcIO = mkGhcTypesTyCon "IO"# tcIO = mkGhcTypesTyCon "IO"#
tcCoercible = mkGhcTypesTyCon "Coercible"#
tcTyCon = mkGhcTypesTyCon "TyCon"# tcTyCon = mkGhcTypesTyCon "TyCon"#
tcModule = mkGhcTypesTyCon "Module"# tcModule = mkGhcTypesTyCon "Module"#
tcTrName = mkGhcTypesTyCon "TrName"# tcTrName = mkGhcTypesTyCon "TrName"#
tcCoercible = mkGhcTypesTyCon "Coercible"#
tcFun = mkGhcTypesTyCon "->"# tcFun = mkGhcPrimTyCon "->"#
tcList = mkGhcTypesTyCon "[]"# -- Type rep for the list type constructor
tcHEq = mkGhcTypesTyCon "~~"# -- Type rep for the (~~) type constructor tcHEq = mkGhcTypesTyCon "~~"# -- Type rep for the (~~) type constructor
tcList, tc'Nil, tc'Cons :: TyCon
tcList = mkGhcTypesTyCon "[]"# -- Type rep for the list type constructor
-- note that, because tc': isn't a valid identifier, we override the names of
-- these representations in TysWiredIn.tyConRepModOcc.
tc'Nil = mkGhcTypesTyCon "'[]"#
tc'Cons = mkGhcTypesTyCon "':"#
tcConstraint, tcTYPE, tcLevity, tc'Lifted, tc'Unlifted :: TyCon tcConstraint, tcTYPE, tcLevity, tc'Lifted, tc'Unlifted :: TyCon
tcConstraint = mkGhcTypesTyCon "Constraint"# tcConstraint = mkGhcTypesTyCon "Constraint"#
tcTYPE = mkGhcTypesTyCon "TYPE"# tcTYPE = mkGhcPrimTyCon "TYPE"#
tcLevity = mkGhcTypesTyCon "Levity"# tcLevity = mkGhcTypesTyCon "Levity"#
tc'Lifted = mkGhcTypesTyCon "'Lifted"# tc'Lifted = mkGhcTypesTyCon "'Lifted"#
tc'Unlifted = mkGhcTypesTyCon "'Unlifted"# tc'Unlifted = mkGhcTypesTyCon "'Unlifted"#
......
...@@ -43,6 +43,10 @@ import GHC.Prim ...@@ -43,6 +43,10 @@ import GHC.Prim
infixr 5 : infixr 5 :
-- Take note: All types defined here must have associated type representations
-- defined in Data.Typeable.Internal.
-- See Note [Representation of types defined in GHC.Types] below.
{- ********************************************************************* {- *********************************************************************
* * * *
Kinds Kinds
...@@ -367,6 +371,10 @@ Note [Representations of types defined in GHC.Types] ...@@ -367,6 +371,10 @@ Note [Representations of types defined in GHC.Types]
The representations for the types defined in GHC.Types are The representations for the types defined in GHC.Types are
defined in GHC.Typeable.Internal. defined in GHC.Typeable.Internal.
Any types defined here must also have a corresponding TyCon representation
defined in Data.Typeable.Internal. Also, if the type is promotable it must also
have a TyCon for each promoted data constructor.
-} -}
#include "MachDeps.h" #include "MachDeps.h"
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment