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, 59 insertions, 37 deletions

diff --git a/compiler/iface/TcIface.hs b/compiler/iface/TcIface.hs
index 2e8a6ed796..8599afabec 100644
--- a/compiler/iface/TcIface.hs
+++ b/compiler/iface/TcIface.hs
@@ -312,20 +312,21 @@ tc_iface_decl _ ignore_prags (IfaceId {ifName = occ_name, ifType = iface_type,
 
 tc_iface_decl _ _ (IfaceData {ifName = occ_name,
                           ifCType = cType,
-                          ifKind = kind,
-                          ifTyVars = tv_bndrs,
+                          ifBinders = binders,
+                          ifResKind = res_kind,
                           ifRoles = roles,
                           ifCtxt = ctxt, ifGadtSyntax = gadt_syn,
                           ifCons = rdr_cons,
                           ifRec = is_rec, ifParent = mb_parent })
-  = bindIfaceTyVars_AT tv_bndrs $ \ tyvars -> do
+  = bindIfaceTyConBinders_AT binders $ \ tyvars binders' -> do
     { tc_name <- lookupIfaceTop occ_name
-    ; kind' <- tcIfaceType kind
+    ; res_kind' <- tcIfaceType res_kind
+
     ; tycon <- fixM $ \ tycon -> do
             { stupid_theta <- tcIfaceCtxt ctxt
             ; parent' <- tc_parent tc_name mb_parent
             ; cons <- tcIfaceDataCons tc_name tycon tyvars rdr_cons
-            ; return (mkAlgTyCon tc_name kind' tyvars roles cType stupid_theta
+            ; return (mkAlgTyCon tc_name binders' res_kind' tyvars roles cType stupid_theta
                                     cons parent' is_rec gadt_syn) }
     ; traceIf (text "tcIfaceDecl4" <+> ppr tycon)
     ; return (ATyCon tycon) }
@@ -341,31 +342,33 @@ tc_iface_decl _ _ (IfaceData {ifName = occ_name,
            ; lhs_tys <- tcIfaceTcArgs arg_tys
            ; return (DataFamInstTyCon ax_unbr fam_tc lhs_tys) }
 
-tc_iface_decl _ _ (IfaceSynonym {ifName = occ_name, ifTyVars = tv_bndrs,
+tc_iface_decl _ _ (IfaceSynonym {ifName = occ_name,
                                       ifRoles = roles,
                                       ifSynRhs = rhs_ty,
-                                      ifSynKind = kind })
-   = bindIfaceTyVars_AT tv_bndrs $ \ tyvars -> do
+                                      ifBinders = binders,
+                                      ifResKind = res_kind })
+   = bindIfaceTyConBinders_AT binders $ \ tyvars binders' -> do
      { tc_name  <- lookupIfaceTop occ_name
-     ; kind     <- tcIfaceType kind     -- Note [Synonym kind loop]
+     ; res_kind' <- tcIfaceType res_kind     -- Note [Synonym kind loop]
      ; rhs      <- forkM (mk_doc tc_name) $
                    tcIfaceType rhs_ty
-     ; let tycon = mkSynonymTyCon tc_name kind tyvars roles rhs
+     ; let tycon = mkSynonymTyCon tc_name binders' res_kind' tyvars roles rhs
      ; return (ATyCon tycon) }
    where
      mk_doc n = text "Type synonym" <+> ppr n
 
-tc_iface_decl parent _ (IfaceFamily {ifName = occ_name, ifTyVars = tv_bndrs,
+tc_iface_decl parent _ (IfaceFamily {ifName = occ_name,
                                      ifFamFlav = fam_flav,
-                                     ifFamKind = kind,
+                                     ifBinders = binders,
+                                     ifResKind = res_kind,
                                      ifResVar = res, ifFamInj = inj })
-   = bindIfaceTyVars_AT tv_bndrs $ \ tyvars -> do
-     { tc_name  <- lookupIfaceTop occ_name
-     ; kind     <- tcIfaceType kind        -- Note [Synonym kind loop]
+   = bindIfaceTyConBinders_AT binders $ \ tyvars binders' -> do
+     { tc_name   <- lookupIfaceTop occ_name
+     ; res_kind' <- tcIfaceType res_kind    -- Note [Synonym kind loop]
      ; rhs      <- forkM (mk_doc tc_name) $
                    tc_fam_flav tc_name fam_flav
      ; res_name <- traverse (newIfaceName . mkTyVarOccFS) res
-     ; let tycon = mkFamilyTyCon tc_name kind tyvars res_name rhs parent inj
+     ; let tycon = mkFamilyTyCon tc_name binders' res_kind' tyvars res_name rhs parent inj
      ; return (ATyCon tycon) }
    where
      mk_doc n = text "Type synonym" <+> ppr n
@@ -386,15 +389,15 @@ tc_iface_decl parent _ (IfaceFamily {ifName = occ_name, ifTyVars = tv_bndrs,
 
 tc_iface_decl _parent ignore_prags
             (IfaceClass {ifCtxt = rdr_ctxt, ifName = tc_occ,
-                         ifTyVars = tv_bndrs, ifRoles = roles, ifKind = kind,
+                         ifRoles = roles,
+                         ifBinders = binders,
                          ifFDs = rdr_fds,
                          ifATs = rdr_ats, ifSigs = rdr_sigs,
                          ifMinDef = mindef_occ, ifRec = tc_isrec })
 -- ToDo: in hs-boot files we should really treat abstract classes specially,
 --       as we do abstract tycons
-  = bindIfaceTvBndrs tv_bndrs $ \ tyvars -> do
+  = bindIfaceTyConBinders binders $ \ tyvars binders' -> do
     { tc_name <- lookupIfaceTop tc_occ
-    ; kind' <- tcIfaceType kind
     ; traceIf (text "tc-iface-class1" <+> ppr tc_occ)
     ; ctxt <- mapM tc_sc rdr_ctxt
     ; traceIf (text "tc-iface-class2" <+> ppr tc_occ)
@@ -405,7 +408,7 @@ tc_iface_decl _parent ignore_prags
     ; cls  <- fixM $ \ cls -> do
               { ats  <- mapM (tc_at cls) rdr_ats
               ; traceIf (text "tc-iface-class4" <+> ppr tc_occ)
-              ; buildClass tc_name tyvars roles ctxt kind' fds ats sigs mindef tc_isrec }
+              ; buildClass tc_name tyvars roles ctxt binders' fds ats sigs mindef tc_isrec }
     ; return (ATyCon (classTyCon cls)) }
   where
    tc_sc pred = forkM (mk_sc_doc pred) (tcIfaceType pred)
@@ -509,7 +512,8 @@ tc_ax_branch prev_branches
              (IfaceAxBranch { ifaxbTyVars = tv_bndrs, ifaxbCoVars = cv_bndrs
                             , ifaxbLHS = lhs, ifaxbRHS = rhs
                             , ifaxbRoles = roles, ifaxbIncomps = incomps })
-  = bindIfaceTyVars_AT tv_bndrs $ \ tvs ->
+  = bindIfaceTyConBinders_AT
+      (map (\b -> IfaceNamed (IfaceTv b Invisible)) tv_bndrs) $ \ tvs _ ->
          -- The _AT variant is needed here; see Note [CoAxBranch type variables] in CoAxiom
     bindIfaceIds cv_bndrs $ \ cvs -> do
     { tc_lhs <- tcIfaceTcArgs lhs
@@ -905,7 +909,7 @@ tcIfaceTupleTy sort info args
                         kind_args = map typeKind args'
                   ; return (mkTyConApp tc (kind_args ++ args')) } }
 
--- See Note [Unboxed tuple levity vars] in TyCon
+-- See Note [Unboxed tuple RuntimeRep vars] in TyCon
 tcTupleTyCon :: Bool    -- True <=> typechecking a *type* (vs. an expr)
              -> TupleSort
              -> Arity   -- the number of args. *not* the tuple arity.
@@ -1024,7 +1028,7 @@ tcIfaceExpr (IfaceTuple sort args)
        ; let con_tys = map exprType args'
              some_con_args = map Type con_tys ++ args'
              con_args = case sort of
-               UnboxedTuple -> map (Type . getLevity "tcIfaceExpr") con_tys ++ some_con_args
+               UnboxedTuple -> map (Type . getRuntimeRep "tcIfaceExpr") con_tys ++ some_con_args
                _            -> some_con_args
                         -- Put the missing type arguments back in
              con_id   = dataConWorkId (tyConSingleDataCon tc)
@@ -1426,21 +1430,39 @@ mk_iface_tyvar name ifKind
    = do { kind <- tcIfaceType ifKind
         ; return (Var.mkTyVar name kind) }
 
-bindIfaceTyVars_AT :: [IfaceTvBndr] -> ([TyVar] -> IfL a) -> IfL a
+bindIfaceTyConBinders :: [IfaceTyConBinder]
+                      -> ([TyVar] -> [TyBinder] -> IfL a) -> IfL a
+bindIfaceTyConBinders [] thing_inside = thing_inside [] []
+bindIfaceTyConBinders (b:bs) thing_inside
+  = bindIfaceTyConBinderX bindIfaceTyVar b $ \ tv'  b'  ->
+    bindIfaceTyConBinders bs               $ \ tvs' bs' ->
+    thing_inside (tv':tvs') (b':bs')
+
+bindIfaceTyConBinders_AT :: [IfaceTyConBinder]
+                         -> ([TyVar] -> [TyBinder] -> IfL a) -> IfL a
 -- Used for type variable in nested associated data/type declarations
 -- where some of the type variables are already in scope
 --    class C a where { data T a b }
 -- Here 'a' is in scope when we look at the 'data T'
-bindIfaceTyVars_AT [] thing_inside
-  = thing_inside []
-bindIfaceTyVars_AT (b : bs) thing_inside
-  = do { bindIfaceTyVar_AT b $ \b' ->
-         bindIfaceTyVars_AT bs $ \bs' ->
-         thing_inside (b':bs') }
-
-bindIfaceTyVar_AT :: IfaceTvBndr -> (TyVar -> IfL a) -> IfL a
-bindIfaceTyVar_AT tv thing
-  = do { mb_tv <- lookupIfaceTyVar tv
-       ; case mb_tv of
-           Just b' -> thing b'
-           Nothing -> bindIfaceTyVar tv thing }
+bindIfaceTyConBinders_AT [] thing_inside
+  = thing_inside [] []
+bindIfaceTyConBinders_AT (b : bs) thing_inside
+  = bindIfaceTyConBinderX bind_tv b  $ \tv'  b'  ->
+    bindIfaceTyConBinders_AT      bs $ \tvs' bs' ->
+    thing_inside (tv':tvs') (b':bs')
+  where
+    bind_tv tv thing
+      = do { mb_tv <- lookupIfaceTyVar tv
+           ; case mb_tv of
+               Just b' -> thing b'
+               Nothing -> bindIfaceTyVar tv thing }
+
+bindIfaceTyConBinderX :: (IfaceTvBndr -> (TyVar -> IfL a) -> IfL a)
+                      -> IfaceTyConBinder
+                      -> (TyVar -> TyBinder -> IfL a) -> IfL a
+bindIfaceTyConBinderX bind_tv (IfaceAnon name ki) thing_inside
+  = bind_tv (name, ki) $ \ tv' ->
+    thing_inside tv' (Anon (tyVarKind tv'))
+bindIfaceTyConBinderX bind_tv (IfaceNamed (IfaceTv tv vis)) thing_inside
+  = bind_tv tv $ \tv' ->
+    thing_inside tv' (Named tv' vis)