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.

7 files changed, 41 insertions, 22 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}
diff --git a/compiler/typecheck/TcHsType.lhs b/compiler/typecheck/TcHsType.lhs
index c8ce732c6a..200d74eda0 100644
--- a/compiler/typecheck/TcHsType.lhs
+++ b/compiler/typecheck/TcHsType.lhs
@@ -504,12 +504,15 @@ tc_hs_type ty@(HsSpliceTy {}) _exp_kind
 tc_hs_type (HsWrapTy {}) _exp_kind 
   = panic "tc_hs_type HsWrapTy"  -- We kind checked something twice
 
-tc_hs_type hs_ty@(HsTyLit tl) exp_kind = do
-  let (ty,k) = case tl of
-                 HsNumTy n -> (mkNumLitTy n, typeNatKind)
-                 HsStrTy s -> (mkStrLitTy s,  typeStringKind)
-  checkExpectedKind hs_ty k exp_kind
-  return ty
+tc_hs_type hs_ty@(HsTyLit (HsNumTy n)) exp_kind 
+  = do { checkExpectedKind hs_ty typeNatKind exp_kind
+       ; checkWiredInTyCon typeNatKindCon
+       ; return (mkNumLitTy n) }
+
+tc_hs_type hs_ty@(HsTyLit (HsStrTy s)) exp_kind 
+  = do { checkExpectedKind hs_ty typeStringKind exp_kind
+       ; checkWiredInTyCon typeStringKindCon
+       ; return (mkStrLitTy s) }
 
 ---------------------------
 tc_tuple :: HsType Name -> HsTupleSort -> [LHsType Name] -> ExpKind -> TcM TcType
diff --git a/compiler/types/Kind.lhs b/compiler/types/Kind.lhs
index dbd131fcc6..aa99aacd29 100644
--- a/compiler/types/Kind.lhs
+++ b/compiler/types/Kind.lhs
@@ -17,7 +17,6 @@ module Kind (
 	-- Kinds
 	anyKind, liftedTypeKind, unliftedTypeKind, openTypeKind, constraintKind,
         mkArrowKind, mkArrowKinds,
-        typeNatKind, typeStringKind,
 
         -- Kind constructors...
         anyKindTyCon, liftedTypeKindTyCon, openTypeKindTyCon,
diff --git a/compiler/types/Type.lhs b/compiler/types/Type.lhs
index f741078058..3fc1cefe81 100644
--- a/compiler/types/Type.lhs
+++ b/compiler/types/Type.lhs
@@ -152,7 +152,7 @@ import VarSet
 import Class
 import TyCon
 import TysPrim
-import {-# SOURCE #-} TysWiredIn ( eqTyCon )
+import {-# SOURCE #-} TysWiredIn ( eqTyCon, typeNatKind, typeStringKind )
 import PrelNames ( eqTyConKey, ipClassNameKey, 
                    constraintKindTyConKey, liftedTypeKindTyConKey )