summaryrefslogtreecommitdiff
path: root/compiler/prelude
diff options
context:
space:
mode:
authorSimon Peyton Jones <simonpj@microsoft.com>2012-12-19 17:35:51 +0000
committerSimon Peyton Jones <simonpj@microsoft.com>2012-12-19 17:35:51 +0000
commitaad93f5c9eb9d53cddf85019192ba0da6004d17e (patch)
tree257cd475eb97501cf121eda180a1459477fa8e88 /compiler/prelude
parent8c1aab0d75ce7499408c5493cf4aacdb196fa915 (diff)
downloadhaskell-aad93f5c9eb9d53cddf85019192ba0da6004d17e.tar.gz
Move the kind Nat and Symbol out of TysPrim and into TysWiredIn
They properly belong in TysWiredIn, since they are defined in Haskell in GHC.TypeLits. Moveover, make them WiredIn (again as they should be) and use checkWiredInTyCon when encountering them in TcHsType.tc_hs_type, so that the interface file is loaded. This fixes Trac #7502.
Diffstat (limited to 'compiler/prelude')
-rw-r--r--compiler/prelude/PrelNames.lhs8
-rw-r--r--compiler/prelude/TysPrim.lhs7
-rw-r--r--compiler/prelude/TysWiredIn.lhs29
-rw-r--r--compiler/prelude/TysWiredIn.lhs-boot1
4 files changed, 31 insertions, 14 deletions
diff --git a/compiler/prelude/PrelNames.lhs b/compiler/prelude/PrelNames.lhs
index 439430959e..c763b70385 100644
--- a/compiler/prelude/PrelNames.lhs
+++ b/compiler/prelude/PrelNames.lhs
@@ -281,8 +281,6 @@ basicKnownKeyNames
randomClassName, randomGenClassName, monadPlusClassName,
-- Type-level naturals
- typeNatKindConName,
- typeStringKindConName,
singIClassName,
typeNatLeqClassName,
typeNatAddTyFamName,
@@ -1089,12 +1087,8 @@ randomGenClassName = clsQual rANDOM (fsLit "RandomGen") randomGenClassKey
isStringClassName = clsQual dATA_STRING (fsLit "IsString") isStringClassKey
-- Type-level naturals
-typeNatKindConName, typeStringKindConName,
- singIClassName, typeNatLeqClassName,
+singIClassName, typeNatLeqClassName,
typeNatAddTyFamName, typeNatMulTyFamName, typeNatExpTyFamName :: Name
-typeNatKindConName = tcQual gHC_TYPELITS (fsLit "Nat") typeNatKindConNameKey
-typeStringKindConName = tcQual gHC_TYPELITS (fsLit "Symbol")
- typeStringKindConNameKey
singIClassName = clsQual gHC_TYPELITS (fsLit "SingI") singIClassNameKey
typeNatLeqClassName = clsQual gHC_TYPELITS (fsLit "<=") typeNatLeqClassNameKey
typeNatAddTyFamName = tcQual gHC_TYPELITS (fsLit "+") typeNatAddTyFamNameKey
diff --git a/compiler/prelude/TysPrim.lhs b/compiler/prelude/TysPrim.lhs
index 8c8b4b7bf3..8b9cbf9ac2 100644
--- a/compiler/prelude/TysPrim.lhs
+++ b/compiler/prelude/TysPrim.lhs
@@ -34,7 +34,6 @@ module TysPrim(
-- Kinds
anyKind, liftedTypeKind, unliftedTypeKind, openTypeKind, constraintKind,
mkArrowKind, mkArrowKinds,
- typeNatKind, typeStringKind,
funTyCon, funTyConName,
primTyCons,
@@ -344,12 +343,6 @@ unliftedTypeKind = kindTyConType unliftedTypeKindTyCon
openTypeKind = kindTyConType openTypeKindTyCon
constraintKind = kindTyConType constraintKindTyCon
-typeNatKind :: Kind
-typeNatKind = kindTyConType (mkKindTyCon typeNatKindConName superKind)
-
-typeStringKind :: Kind
-typeStringKind = kindTyConType (mkKindTyCon typeStringKindConName superKind)
-
-- | Given two kinds @k1@ and @k2@, creates the 'Kind' @k1 -> k2@
mkArrowKind :: Kind -> Kind -> Kind
mkArrowKind k1 k2 = FunTy k1 k2
diff --git a/compiler/prelude/TysWiredIn.lhs b/compiler/prelude/TysWiredIn.lhs
index 4b05e0efb0..942f102bc7 100644
--- a/compiler/prelude/TysWiredIn.lhs
+++ b/compiler/prelude/TysWiredIn.lhs
@@ -64,6 +64,9 @@ module TysWiredIn (
-- * Unit
unitTy,
+ -- * Kinds
+ typeNatKindCon, typeNatKind, typeStringKindCon, typeStringKind,
+
-- * Parallel arrays
mkPArrTy,
parrTyCon, parrFakeCon, isPArrTyCon, isPArrFakeCon,
@@ -148,6 +151,8 @@ wiredInTyCons = [ unitTyCon -- Not treated like other tuples, because
, listTyCon
, parrTyCon
, eqTyCon
+ , typeNatKindCon
+ , typeStringKindCon
]
++ (case cIntegerLibraryType of
IntegerGMP -> [integerTyCon]
@@ -193,6 +198,11 @@ floatDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "F#") floa
doubleTyConName = mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Double") doubleTyConKey doubleTyCon
doubleDataConName = mkWiredInDataConName UserSyntax gHC_TYPES (fsLit "D#") doubleDataConKey doubleDataCon
+-- Kinds
+typeNatKindConName, typeStringKindConName :: Name
+typeNatKindConName = mkWiredInTyConName UserSyntax gHC_TYPELITS (fsLit "Nat") typeNatKindConNameKey typeNatKindCon
+typeStringKindConName = mkWiredInTyConName UserSyntax gHC_TYPELITS (fsLit "Symbol") typeStringKindConNameKey typeStringKindCon
+
-- For integer-gmp only:
integerRealTyConName :: Name
integerRealTyConName = case cIntegerLibraryType of
@@ -290,6 +300,25 @@ pcDataConWithFixity' declared_infix dc_name wrk_key tyvars arg_tys tycon
%************************************************************************
%* *
+ Kinds
+%* *
+%************************************************************************
+
+\begin{code}
+typeNatKindCon, typeStringKindCon :: TyCon
+-- data Nat
+-- data Symbol
+typeNatKindCon = pcNonRecDataTyCon typeNatKindConName Nothing [] []
+typeStringKindCon = pcNonRecDataTyCon typeStringKindConName Nothing [] []
+
+typeNatKind, typeStringKind :: Kind
+typeNatKind = TyConApp (promoteTyCon typeNatKindCon) []
+typeStringKind = TyConApp (promoteTyCon typeStringKindCon) []
+\end{code}
+
+
+%************************************************************************
+%* *
\subsection[TysWiredIn-tuples]{The tuple types}
%* *
%************************************************************************
diff --git a/compiler/prelude/TysWiredIn.lhs-boot b/compiler/prelude/TysWiredIn.lhs-boot
index 9740c0ae38..65c03c8e17 100644
--- a/compiler/prelude/TysWiredIn.lhs-boot
+++ b/compiler/prelude/TysWiredIn.lhs-boot
@@ -6,5 +6,6 @@ import {-# SOURCE #-} TypeRep (Type)
eqTyCon :: TyCon
+typeNatKind, typeStringKind :: Type
mkBoxedTupleTy :: [Type] -> Type
\end{code}