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 (
import IfaceEnv
import FamInstEnv( FamInstEnvs, mkNewTypeCoAxiom )
import TysWiredIn( isCTupleTyConName )
import PrelNames( tyConRepModOcc )
import TysWiredIn( isCTupleTyConName, tyConRepModOcc )
import DataCon
import PatSyn
import Var
......
......@@ -823,29 +823,6 @@ mkSpecialTyConRepName fs tc_name
(mkVarOccFS fs)
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 = mkSystemVarName wildCardKey (fsLit "wild")
......
......@@ -49,6 +49,7 @@ module TysWiredIn (
listTyCon, listTyCon_RDR, listTyConName, listTyConKey,
nilDataCon, nilDataConName, nilDataConKey,
consDataCon_RDR, consDataCon, consDataConName,
promotedNilDataCon, promotedConsDataCon,
mkListTy,
......@@ -96,7 +97,10 @@ module TysWiredIn (
levityTy, levityTyCon, liftedDataCon, unliftedDataCon,
liftedPromDataCon, unliftedPromDataCon,
liftedDataConTy, unliftedDataConTy,
liftedDataConName, unliftedDataConName
liftedDataConName, unliftedDataConName,
-- * Helpers for building type representations
tyConRepModOcc
) where
#include "HsVersions.h"
......@@ -138,6 +142,48 @@ alpha_tyvar = [alphaTyVar]
alpha_ty :: [Type]
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
promotedEQDataCon = promoteDataCon eqDataCon
promotedGTDataCon = promoteDataCon gtDataCon
-- Promoted List
promotedConsDataCon, promotedNilDataCon :: TyCon
promotedConsDataCon = promoteDataCon consDataCon
promotedNilDataCon = promoteDataCon nilDataCon
{-
Note [The Implicit Parameter class]
......
......@@ -41,11 +41,13 @@ module Data.Typeable.Internal (
mkTyCon3, mkTyCon3#,
rnfTyCon,
-- ** Representations for wired-in types
tcBool, tc'True, tc'False,
tcOrdering, tc'LT, tc'EQ, tc'GT,
tcChar, tcInt, tcWord, tcFloat, tcDouble, tcFun,
tcIO, tcSPEC, tcTyCon, tcModule, tcTrName,
tcCoercible, tcList, tcHEq,
tcCoercible, tcHEq, tcSymbol, tcNat,
tcList, tc'Nil, tc'Cons,
tcConstraint,
tcTYPE, tcLevity, tc'Lifted, tc'Unlifted,
......@@ -401,11 +403,15 @@ mkGhcTypesTyCon :: Addr# -> TyCon
{-# INLINE mkGhcTypesTyCon #-}
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,
tcOrdering, tc'GT, tc'EQ, tc'LT,
tcChar, tcInt, tcWord, tcFloat, tcDouble, tcFun,
tcIO, tcSPEC, tcTyCon, tcModule, tcTrName,
tcCoercible, tcHEq, tcList :: TyCon
tcCoercible, tcHEq, tcNat, tcSymbol :: TyCon
tcBool = mkGhcTypesTyCon "Bool"# -- Bool is promotable
tc'True = mkGhcTypesTyCon "'True"#
......@@ -415,26 +421,34 @@ tc'GT = mkGhcTypesTyCon "'GT"#
tc'EQ = mkGhcTypesTyCon "'EQ"#
tc'LT = mkGhcTypesTyCon "'LT"#
-- None of the rest are promotable (see TysWiredIn)
-- Most of the rest are promotable (see TysWiredIn)
tcChar = mkGhcTypesTyCon "Char"#
tcInt = mkGhcTypesTyCon "Int"#
tcWord = mkGhcTypesTyCon "Word"#
tcFloat = mkGhcTypesTyCon "Float"#
tcDouble = mkGhcTypesTyCon "Double"#
tcNat = mkGhcTypesTyCon "Nat"#
tcSymbol = mkGhcTypesTyCon "Symbol"#
tcSPEC = mkGhcTypesTyCon "SPEC"#
tcIO = mkGhcTypesTyCon "IO"#
tcCoercible = mkGhcTypesTyCon "Coercible"#
tcTyCon = mkGhcTypesTyCon "TyCon"#
tcModule = mkGhcTypesTyCon "Module"#
tcTrName = mkGhcTypesTyCon "TrName"#
tcCoercible = mkGhcTypesTyCon "Coercible"#
tcFun = mkGhcTypesTyCon "->"#
tcList = mkGhcTypesTyCon "[]"# -- Type rep for the list type constructor
tcFun = mkGhcPrimTyCon "->"#
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 = mkGhcTypesTyCon "Constraint"#
tcTYPE = mkGhcTypesTyCon "TYPE"#
tcTYPE = mkGhcPrimTyCon "TYPE"#
tcLevity = mkGhcTypesTyCon "Levity"#
tc'Lifted = mkGhcTypesTyCon "'Lifted"#
tc'Unlifted = mkGhcTypesTyCon "'Unlifted"#
......
......@@ -43,6 +43,10 @@ import GHC.Prim
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
......@@ -367,6 +371,10 @@ Note [Representations of types defined in GHC.Types]
The representations for the types defined in GHC.Types are
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"
......
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