Address #11471 by putting RuntimeRep in kinds.wip/runtime-rep

See Note [TYPE] in TysPrim. There are still some outstanding
pieces in #11471 though, so this doesn't actually nail the bug.

This commit also contains a few performance improvements:

* Short-cut equality checking of nullary type syns

* Compare types before kinds in eqType

* INLINE coreViewOneStarKind

* Store tycon binders separately from kinds.

This resulted in a ~10% performance improvement in compiling
the Cabal package. No change in functionality other than
performance. (This affects the interface file format, though.)

This commit updates the haddock submodule.

1 files changed, 118 insertions, 74 deletions

diff --git a/compiler/prelude/TysPrim.hs b/compiler/prelude/TysPrim.hs
index d1e42d5a10..ce25c308a1 100644
--- a/compiler/prelude/TysPrim.hs
+++ b/compiler/prelude/TysPrim.hs
@@ -15,13 +15,11 @@ module TysPrim(
         mkTemplateTyVars,
         alphaTyVars, alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar,
         alphaTys, alphaTy, betaTy, gammaTy, deltaTy,
-        levity1TyVar, levity2TyVar, levity1Ty, levity2Ty,
+        runtimeRep1TyVar, runtimeRep2TyVar, runtimeRep1Ty, runtimeRep2Ty,
         openAlphaTy, openBetaTy, openAlphaTyVar, openBetaTyVar,
         kKiVar,
 
         -- Kind constructors...
-        tYPETyCon, unliftedTypeKindTyCon, unliftedTypeKind,
-
         tYPETyConName, unliftedTypeKindTyConName,
 
         -- Kinds
@@ -80,7 +78,18 @@ module TysPrim(
 
 #include "HsVersions.h"
 
-import {-# SOURCE #-} TysWiredIn ( levityTy, unliftedDataConTy, liftedTypeKind )
+import {-# SOURCE #-} TysWiredIn
+  ( runtimeRepTy, liftedTypeKind
+  , vecRepDataConTyCon, ptrRepUnliftedDataConTyCon
+  , voidRepDataConTy, intRepDataConTy
+  , wordRepDataConTy, int64RepDataConTy, word64RepDataConTy, addrRepDataConTy
+  , floatRepDataConTy, doubleRepDataConTy
+  , vec2DataConTy, vec4DataConTy, vec8DataConTy, vec16DataConTy, vec32DataConTy
+  , vec64DataConTy
+  , int8ElemRepDataConTy, int16ElemRepDataConTy, int32ElemRepDataConTy
+  , int64ElemRepDataConTy, word8ElemRepDataConTy, word16ElemRepDataConTy
+  , word32ElemRepDataConTy, word64ElemRepDataConTy, floatElemRepDataConTy
+  , doubleElemRepDataConTy )
 
 import Var              ( TyVar, KindVar, mkTyVar )
 import Name
@@ -89,6 +98,7 @@ import SrcLoc
 import Unique
 import PrelNames
 import FastString
+import Outputable
 import TyCoRep   -- doesn't need special access, but this is easier to avoid
                  -- import loops
 
@@ -228,17 +238,17 @@ alphaTys = mkTyVarTys alphaTyVars
 alphaTy, betaTy, gammaTy, deltaTy :: Type
 (alphaTy:betaTy:gammaTy:deltaTy:_) = alphaTys
 
-levity1TyVar, levity2TyVar :: TyVar
-(levity1TyVar : levity2TyVar : _)
-  = drop 21 (mkTemplateTyVars (repeat levityTy))  -- selects 'v','w'
+runtimeRep1TyVar, runtimeRep2TyVar :: TyVar
+(runtimeRep1TyVar : runtimeRep2TyVar : _)
+  = drop 16 (mkTemplateTyVars (repeat runtimeRepTy))  -- selects 'q','r'
 
-levity1Ty, levity2Ty :: Type
-levity1Ty = mkTyVarTy levity1TyVar
-levity2Ty = mkTyVarTy levity2TyVar
+runtimeRep1Ty, runtimeRep2Ty :: Type
+runtimeRep1Ty = mkTyVarTy runtimeRep1TyVar
+runtimeRep2Ty = mkTyVarTy runtimeRep2TyVar
 
 openAlphaTyVar, openBetaTyVar :: TyVar
 [openAlphaTyVar,openBetaTyVar]
-  = mkTemplateTyVars [tYPE levity1Ty, tYPE levity2Ty]
+  = mkTemplateTyVars [tYPE runtimeRep1Ty, tYPE runtimeRep2Ty]
 
 openAlphaTy, openBetaTy :: Type
 openAlphaTy = mkTyVarTy openAlphaTyVar
@@ -260,9 +270,9 @@ funTyConName :: Name
 funTyConName = mkPrimTyConName (fsLit "(->)") funTyConKey funTyCon
 
 funTyCon :: TyCon
-funTyCon = mkFunTyCon funTyConName kind tc_rep_nm
+funTyCon = mkFunTyCon funTyConName (map Anon [liftedTypeKind, liftedTypeKind])
+                                   tc_rep_nm
   where
-    kind = mkFunTys [liftedTypeKind, liftedTypeKind] liftedTypeKind
         -- You might think that (->) should have type (?? -> ? -> *), and you'd be right
         -- But if we do that we get kind errors when saying
         --      instance Control.Arrow (->)
@@ -274,20 +284,6 @@ funTyCon = mkFunTyCon funTyConName kind tc_rep_nm
 
     tc_rep_nm = mkPrelTyConRepName funTyConName
 
--- One step to remove subkinding.
--- (->) :: * -> * -> *
--- but we should have (and want) the following typing rule for fully applied arrows
---      Gamma |- tau   :: k1    k1 in {*, #}
---      Gamma |- sigma :: k2    k2 in {*, #, (#)}
---      -----------------------------------------
---      Gamma |- tau -> sigma :: *
--- Currently we have the following rule which achieves more or less the same effect
---      Gamma |- tau   :: ??
---      Gamma |- sigma :: ?
---      --------------------------
---      Gamma |- tau -> sigma :: *
--- In the end we don't want subkinding at all.
-
 {-
 ************************************************************************
 *                                                                      *
@@ -299,35 +295,48 @@ Note [TYPE]
 ~~~~~~~~~~~
 There are a few places where we wish to be able to deal interchangeably
 with kind * and kind #. unsafeCoerce#, error, and (->) are some of these
-places. The way we do this is to use levity polymorphism.
+places. The way we do this is to use runtime-representation polymorphism.
 
-We have (levityTyCon, liftedDataCon, unliftedDataCon)
+We have
 
-    data Levity = Lifted | Unlifted
+    data RuntimeRep = PtrRepLifted | PtrRepUnlifted | ...
 
 and a magical constant (tYPETyCon)
 
-    TYPE :: Levity -> TYPE Lifted
+    TYPE :: RuntimeRep -> TYPE PtrRepLifted
 
 We then have synonyms (liftedTypeKindTyCon, unliftedTypeKindTyCon)
 
-    type Type = TYPE Lifted
-    type # = TYPE Unlifted
+    type * = TYPE PtrRepLifted
+    type # = TYPE PtrRepUnlifted
+
+The (...) in the definition for RuntimeRep includes possibilities for
+the unboxed, unlifted representations, isomorphic to the PrimRep type
+in TyCon. RuntimeRep is itself declared in GHC.Types.
+
+An alternative design would be to have
+
+  data RuntimeRep = PtrRep Levity | ...
+  data Levity = Lifted | Unlifted
 
-So, for example, we get
+but this slowed down GHC because every time we looked at *, we had to
+follow a bunch of pointers. When we have unpackable sums, we should
+go back to the stratified representation. This would allow, for example:
 
-    unsafeCoerce# :: forall (v1 :: Levity) (v2 :: Levity)
+    unsafeCoerce# :: forall (r1 :: RuntimeRep) (v2 :: Levity)
                             (a :: TYPE v1) (b :: TYPE v2). a -> b
 
-This replaces the old sub-kinding machinery. We call variables `a` and `b`
-above "levity polymorphic".
+TYPE replaces the old sub-kinding machinery. We call variables `a` and `b`
+above "runtime-representation polymorphic".
+
 -}
 
 tYPETyCon, unliftedTypeKindTyCon :: TyCon
 tYPETyConName, unliftedTypeKindTyConName :: Name
 
 tYPETyCon = mkKindTyCon tYPETyConName
-                        (ForAllTy (Anon levityTy) liftedTypeKind)
+                        [Anon runtimeRepTy]
+                        liftedTypeKind
                         [Nominal]
                         (mkPrelTyConRepName tYPETyConName)
 
@@ -335,9 +344,9 @@ tYPETyCon = mkKindTyCon tYPETyConName
    -- NB: unlifted is wired in because there is no way to parse it in
    -- Haskell. That's the only reason for wiring it in.
 unliftedTypeKindTyCon = mkSynonymTyCon unliftedTypeKindTyConName
-                                       liftedTypeKind
-                                       [] []
-                                       (tYPE unliftedDataConTy)
+                          [] liftedTypeKind
+                          [] []
+                          (tYPE (TyConApp ptrRepUnliftedDataConTyCon []))
 
 --------------------------
 -- ... and now their names
@@ -347,9 +356,6 @@ unliftedTypeKindTyCon = mkSynonymTyCon unliftedTypeKindTyConName
 tYPETyConName             = mkPrimTyConName (fsLit "TYPE") tYPETyConKey tYPETyCon
 unliftedTypeKindTyConName = mkPrimTyConName (fsLit "#") unliftedTypeKindTyConKey unliftedTypeKindTyCon
 
-unliftedTypeKind :: Kind
-unliftedTypeKind = tYPE unliftedDataConTy
-
 mkPrimTyConName :: FastString -> Unique -> TyCon -> Name
 mkPrimTyConName = mkPrimTcName BuiltInSyntax
   -- All of the super kinds and kinds are defined in Prim,
@@ -360,9 +366,9 @@ mkPrimTcName built_in_syntax occ key tycon
   = mkWiredInName gHC_PRIM (mkTcOccFS occ) key (ATyCon tycon) built_in_syntax
 
 -----------------------------
--- | Given a Levity, applies TYPE to it. See Note [TYPE].
+-- | Given a RuntimeRep, applies TYPE to it. See Note [TYPE].
 tYPE :: Type -> Type
-tYPE lev = TyConApp tYPETyCon [lev]
+tYPE rr = TyConApp tYPETyCon [rr]
 
 {-
 ************************************************************************
@@ -375,16 +381,48 @@ tYPE lev = TyConApp tYPETyCon [lev]
 -- only used herein
 pcPrimTyCon :: Name -> [Role] -> PrimRep -> TyCon
 pcPrimTyCon name roles rep
-  = mkPrimTyCon name kind roles rep
+  = mkPrimTyCon name binders result_kind roles
   where
-    kind        = mkFunTys (map (const liftedTypeKind) roles) result_kind
-    result_kind = unliftedTypeKind
+    binders     = map (const (Anon liftedTypeKind)) roles
+    result_kind = tYPE rr
+
+    rr = case rep of
+      VoidRep       -> voidRepDataConTy
+      PtrRep        -> TyConApp ptrRepUnliftedDataConTyCon []
+      IntRep        -> intRepDataConTy
+      WordRep       -> wordRepDataConTy
+      Int64Rep      -> int64RepDataConTy
+      Word64Rep     -> word64RepDataConTy
+      AddrRep       -> addrRepDataConTy
+      FloatRep      -> floatRepDataConTy
+      DoubleRep     -> doubleRepDataConTy
+      VecRep n elem -> TyConApp vecRepDataConTyCon [n', elem']
+        where
+          n' = case n of
+            2  -> vec2DataConTy
+            4  -> vec4DataConTy
+            8  -> vec8DataConTy
+            16 -> vec16DataConTy
+            32 -> vec32DataConTy
+            64 -> vec64DataConTy
+            _  -> pprPanic "Disallowed VecCount" (ppr n)
+
+          elem' = case elem of
+            Int8ElemRep   -> int8ElemRepDataConTy
+            Int16ElemRep  -> int16ElemRepDataConTy
+            Int32ElemRep  -> int32ElemRepDataConTy
+            Int64ElemRep  -> int64ElemRepDataConTy
+            Word8ElemRep  -> word8ElemRepDataConTy
+            Word16ElemRep -> word16ElemRepDataConTy
+            Word32ElemRep -> word32ElemRepDataConTy
+            Word64ElemRep -> word64ElemRepDataConTy
+            FloatElemRep  -> floatElemRepDataConTy
+            DoubleElemRep -> doubleElemRepDataConTy
+
 
 pcPrimTyCon0 :: Name -> PrimRep -> TyCon
 pcPrimTyCon0 name rep
-  = mkPrimTyCon name result_kind [] rep
-  where
-    result_kind = unliftedTypeKind
+  = pcPrimTyCon name [] rep
 
 charPrimTy :: Type
 charPrimTy      = mkTyConTy charPrimTyCon
@@ -627,7 +665,7 @@ RealWorld; it's only used in the type system, to parameterise State#.
 -}
 
 realWorldTyCon :: TyCon
-realWorldTyCon = mkLiftedPrimTyCon realWorldTyConName liftedTypeKind [] PtrRep
+realWorldTyCon = mkLiftedPrimTyCon realWorldTyConName [] liftedTypeKind []
 realWorldTy :: Type
 realWorldTy          = mkTyConTy realWorldTyCon
 realWorldStatePrimTy :: Type
@@ -647,11 +685,12 @@ mkProxyPrimTy :: Type -> Type -> Type
 mkProxyPrimTy k ty = TyConApp proxyPrimTyCon [k, ty]
 
 proxyPrimTyCon :: TyCon
-proxyPrimTyCon = mkPrimTyCon proxyPrimTyConName kind [Nominal,Nominal] VoidRep
-  where kind = ForAllTy (Named kv Specified) $
-               mkFunTy k unliftedTypeKind
-        kv   = kKiVar
-        k    = mkTyVarTy kv
+proxyPrimTyCon = mkPrimTyCon proxyPrimTyConName binders res_kind [Nominal,Nominal]
+  where binders  = [ Named kv Specified
+                   , Anon k ]
+        res_kind = tYPE voidRepDataConTy
+        kv       = kKiVar
+        k        = mkTyVarTy kv
 
 
 {- *********************************************************************
@@ -663,10 +702,12 @@ proxyPrimTyCon = mkPrimTyCon proxyPrimTyConName kind [Nominal,Nominal] VoidRep
 
 eqPrimTyCon :: TyCon  -- The representation type for equality predicates
                       -- See Note [The equality types story]
-eqPrimTyCon  = mkPrimTyCon eqPrimTyConName kind roles VoidRep
-  where kind = ForAllTy (Named kv1 Specified) $
-               ForAllTy (Named kv2 Specified) $
-               mkFunTys [k1, k2] unliftedTypeKind
+eqPrimTyCon  = mkPrimTyCon eqPrimTyConName binders res_kind roles
+  where binders = [ Named kv1 Specified
+                  , Named kv2 Specified
+                  , Anon k1
+                  , Anon k2 ]
+        res_kind = tYPE voidRepDataConTy
         [kv1, kv2] = mkTemplateTyVars [liftedTypeKind, liftedTypeKind]
         k1 = mkTyVarTy kv1
         k2 = mkTyVarTy kv2
@@ -676,11 +717,12 @@ eqPrimTyCon  = mkPrimTyCon eqPrimTyConName kind roles VoidRep
 -- this should only ever appear as the type of a covar. Its role is
 -- interpreted in coercionRole
 eqReprPrimTyCon :: TyCon   -- See Note [The equality types story]
-eqReprPrimTyCon = mkPrimTyCon eqReprPrimTyConName kind
-                              roles VoidRep
-  where kind = ForAllTy (Named kv1 Specified) $
-               ForAllTy (Named kv2 Specified) $
-               mkFunTys [k1, k2] unliftedTypeKind
+eqReprPrimTyCon = mkPrimTyCon eqReprPrimTyConName binders res_kind roles
+  where binders = [ Named kv1 Specified
+                  , Named kv2 Specified
+                  , Anon k1
+                  , Anon k2 ]
+        res_kind = tYPE voidRepDataConTy
         [kv1, kv2]    = mkTemplateTyVars [liftedTypeKind, liftedTypeKind]
         k1            = mkTyVarTy kv1
         k2            = mkTyVarTy kv2
@@ -690,12 +732,13 @@ eqReprPrimTyCon = mkPrimTyCon eqReprPrimTyConName kind
 -- This is only used to make higher-order equalities. Nothing
 -- should ever actually have this type!
 eqPhantPrimTyCon :: TyCon
-eqPhantPrimTyCon = mkPrimTyCon eqPhantPrimTyConName kind
+eqPhantPrimTyCon = mkPrimTyCon eqPhantPrimTyConName binders res_kind
                                [Nominal, Nominal, Phantom, Phantom]
-                               VoidRep
-  where kind = ForAllTy (Named kv1 Specified) $
-               ForAllTy (Named kv2 Specified) $
-               mkFunTys [k1, k2] unliftedTypeKind
+  where binders = [ Named kv1 Specified
+                  , Named kv2 Specified
+                  , Anon k1
+                  , Anon k2 ]
+        res_kind = tYPE voidRepDataConTy
         [kv1, kv2]    = mkTemplateTyVars [liftedTypeKind, liftedTypeKind]
         k1            = mkTyVarTy kv1
         k2            = mkTyVarTy kv2
@@ -920,12 +963,13 @@ anyTy :: Type
 anyTy = mkTyConTy anyTyCon
 
 anyTyCon :: TyCon
-anyTyCon = mkFamilyTyCon anyTyConName kind [kKiVar] Nothing
+anyTyCon = mkFamilyTyCon anyTyConName binders res_kind [kKiVar] Nothing
                          (ClosedSynFamilyTyCon Nothing)
                          Nothing
                          NotInjective
   where
-    kind = ForAllTy (Named kKiVar Specified) (mkTyVarTy kKiVar)
+    binders  = [Named kKiVar Specified]
+    res_kind = mkTyVarTy kKiVar
 
 anyTypeOfKind :: Kind -> Type
 anyTypeOfKind kind = TyConApp anyTyCon [kind]