Coercion Quantification
authorningning <xnningxie@gmail.com>
Sat, 15 Sep 2018 14:16:47 +0000 (10:16 -0400)
committerRichard Eisenberg <rae@cs.brynmawr.edu>
Sat, 15 Sep 2018 14:28:41 +0000 (10:28 -0400)
This patch corresponds to #15497.

According to https://ghc.haskell.org/trac/ghc/wiki/DependentHaskell/Phase2,
 we would like to have coercion quantifications back. This will
allow us to migrate (~#) to be homogeneous, instead of its current
heterogeneous definition. This patch is (lots of) plumbing only. There
should be no user-visible effects.

An overview of changes:

- Both `ForAllTy` and `ForAllCo` can quantify over coercion variables,
but only in *Core*. All relevant functions are updated accordingly.
- Small changes that should be irrelevant to the main task:
    1. removed dead code `mkTransAppCo` in Coercion
    2. removed out-dated Note Computing a coercion kind and
       roles in Coercion
    3. Added `Eq4` in Note Respecting definitional equality in
       TyCoRep, and updated `mkCastTy` accordingly.
    4. Various updates and corrections of notes and typos.
- Haddock submodule needs to be changed too.

Acknowledgments:
This work was completed mostly during Ningning Xie's Google Summer
of Code, sponsored by Google. It was advised by Richard Eisenberg,
supported by NSF grant 1704041.

Test Plan: ./validate

Reviewers: goldfire, simonpj, bgamari, hvr, erikd, simonmar

Subscribers: RyanGlScott, monoidal, rwbarton, carter

GHC Trac Issues: #15497

Differential Revision: https://phabricator.haskell.org/D5054

55 files changed:
compiler/backpack/RnModIface.hs
compiler/basicTypes/ConLike.hs
compiler/basicTypes/DataCon.hs
compiler/basicTypes/DataCon.hs-boot
compiler/basicTypes/MkId.hs
compiler/basicTypes/PatSyn.hs
compiler/basicTypes/Var.hs
compiler/coreSyn/CoreArity.hs
compiler/coreSyn/CoreFVs.hs
compiler/coreSyn/CoreLint.hs
compiler/coreSyn/CoreMap.hs
compiler/coreSyn/CoreOpt.hs
compiler/coreSyn/CoreSubst.hs
compiler/coreSyn/CoreTidy.hs
compiler/coreSyn/CoreUtils.hs
compiler/deSugar/DsForeign.hs
compiler/deSugar/MatchCon.hs
compiler/ghci/RtClosureInspect.hs
compiler/iface/BuildTyCl.hs
compiler/iface/IfaceSyn.hs
compiler/iface/IfaceType.hs
compiler/iface/IfaceType.hs-boot
compiler/iface/MkIface.hs
compiler/iface/TcIface.hs
compiler/iface/ToIface.hs
compiler/iface/ToIface.hs-boot
compiler/prelude/TysPrim.hs
compiler/prelude/TysWiredIn.hs
compiler/specialise/SpecConstr.hs
compiler/typecheck/Inst.hs
compiler/typecheck/TcCanonical.hs
compiler/typecheck/TcErrors.hs
compiler/typecheck/TcFlatten.hs
compiler/typecheck/TcForeign.hs
compiler/typecheck/TcGenFunctor.hs
compiler/typecheck/TcHsSyn.hs
compiler/typecheck/TcHsType.hs
compiler/typecheck/TcMType.hs
compiler/typecheck/TcPatSyn.hs
compiler/typecheck/TcRnTypes.hs
compiler/typecheck/TcSplice.hs
compiler/typecheck/TcTyClsDecls.hs
compiler/typecheck/TcType.hs
compiler/typecheck/TcTypeable.hs
compiler/typecheck/TcUnify.hs
compiler/typecheck/TcValidity.hs
compiler/types/Coercion.hs
compiler/types/FamInstEnv.hs
compiler/types/OptCoercion.hs
compiler/types/TyCoRep.hs
compiler/types/TyCoRep.hs-boot
compiler/types/TyCon.hs
compiler/types/Type.hs
compiler/types/Unify.hs
utils/haddock

index 51f312f..3ae01d7 100644 (file)
@@ -524,7 +524,7 @@ rnIfaceConDecls IfAbstractTyCon = pure IfAbstractTyCon
 rnIfaceConDecl :: Rename IfaceConDecl
 rnIfaceConDecl d = do
     con_name <- rnIfaceGlobal (ifConName d)
-    con_ex_tvs <- mapM rnIfaceTvBndr (ifConExTvs d)
+    con_ex_tvs <- mapM rnIfaceBndr (ifConExTCvs d)
     con_user_tvbs <- mapM rnIfaceForAllBndr (ifConUserTvBinders d)
     let rnIfConEqSpec (n,t) = (,) n <$> rnIfaceType t
     con_eq_spec <- mapM rnIfConEqSpec (ifConEqSpec d)
@@ -535,7 +535,7 @@ rnIfaceConDecl d = do
         rnIfaceBang bang = pure bang
     con_stricts <- mapM rnIfaceBang (ifConStricts d)
     return d { ifConName = con_name
-             , ifConExTvs = con_ex_tvs
+             , ifConExTCvs = con_ex_tvs
              , ifConUserTvBinders = con_user_tvbs
              , ifConEqSpec = con_eq_spec
              , ifConCtxt = con_ctxt
@@ -624,7 +624,7 @@ rnIfaceTvBndr :: Rename IfaceTvBndr
 rnIfaceTvBndr (fs, kind) = (,) fs <$> rnIfaceType kind
 
 rnIfaceTyConBinder :: Rename IfaceTyConBinder
-rnIfaceTyConBinder (TvBndr tv vis) = TvBndr <$> rnIfaceTvBndr tv <*> pure vis
+rnIfaceTyConBinder (Bndr tv vis) = Bndr <$> rnIfaceBndr tv <*> pure vis
 
 rnIfaceAlt :: Rename IfaceAlt
 rnIfaceAlt (conalt, names, rhs)
@@ -656,7 +656,7 @@ rnIfaceCo (IfaceTyConAppCo role tc cos)
 rnIfaceCo (IfaceAppCo co1 co2)
     = IfaceAppCo <$> rnIfaceCo co1 <*> rnIfaceCo co2
 rnIfaceCo (IfaceForAllCo bndr co1 co2)
-    = IfaceForAllCo <$> rnIfaceTvBndr bndr <*> rnIfaceCo co1 <*> rnIfaceCo co2
+    = IfaceForAllCo <$> rnIfaceBndr bndr <*> rnIfaceCo co1 <*> rnIfaceCo co2
 rnIfaceCo (IfaceFreeCoVar c) = pure (IfaceFreeCoVar c)
 rnIfaceCo (IfaceCoVarCo lcl) = IfaceCoVarCo <$> pure lcl
 rnIfaceCo (IfaceHoleCo lcl)  = IfaceHoleCo  <$> pure lcl
@@ -711,7 +711,7 @@ rnIfaceType (IfaceCastTy ty co)
     = IfaceCastTy <$> rnIfaceType ty <*> rnIfaceCo co
 
 rnIfaceForAllBndr :: Rename IfaceForAllBndr
-rnIfaceForAllBndr (TvBndr tv vis) = TvBndr <$> rnIfaceTvBndr tv <*> pure vis
+rnIfaceForAllBndr (Bndr tv vis) = Bndr <$> rnIfaceBndr tv <*> pure vis
 
 rnIfaceAppArgs :: Rename IfaceAppArgs
 rnIfaceAppArgs (IA_Invis t ts) = IA_Invis <$> rnIfaceType t <*> rnIfaceAppArgs ts
index f1fc03b..a9d7548 100644 (file)
@@ -12,7 +12,7 @@ module ConLike (
         , conLikeArity
         , conLikeFieldLabels
         , conLikeInstOrigArgTys
-        , conLikeExTyVars
+        , conLikeExTyCoVars
         , conLikeName
         , conLikeStupidTheta
         , conLikeWrapId_maybe
@@ -113,10 +113,10 @@ conLikeInstOrigArgTys (RealDataCon data_con) tys =
 conLikeInstOrigArgTys (PatSynCon pat_syn) tys =
     patSynInstArgTys pat_syn tys
 
--- | Existentially quantified type variables
-conLikeExTyVars :: ConLike -> [TyVar]
-conLikeExTyVars (RealDataCon dcon1) = dataConExTyVars dcon1
-conLikeExTyVars (PatSynCon psyn1)   = patSynExTyVars psyn1
+-- | Existentially quantified type/coercion variables
+conLikeExTyCoVars :: ConLike -> [TyCoVar]
+conLikeExTyCoVars (RealDataCon dcon1) = dataConExTyCoVars dcon1
+conLikeExTyCoVars (PatSynCon psyn1)   = patSynExTyVars psyn1
 
 conLikeName :: ConLike -> Name
 conLikeName (RealDataCon data_con) = dataConName data_con
@@ -152,7 +152,7 @@ conLikeResTy (PatSynCon ps)    tys = patSynInstResTy ps tys
 --
 -- 1) The universally quantified type variables
 --
--- 2) The existentially quantified type variables
+-- 2) The existentially quantified type/coercion variables
 --
 -- 3) The equality specification
 --
@@ -165,7 +165,9 @@ conLikeResTy (PatSynCon ps)    tys = patSynInstResTy ps tys
 --
 -- 7) The original result type
 conLikeFullSig :: ConLike
-               -> ([TyVar], [TyVar], [EqSpec]
+               -> ([TyVar], [TyCoVar], [EqSpec]
+                   -- Why tyvars for universal but tycovars for existential?
+                   -- See Note [Existential coercion variables] in DataCon
                   , ThetaType, ThetaType, [Type], Type)
 conLikeFullSig (RealDataCon con) =
   let (univ_tvs, ex_tvs, eq_spec, theta, arg_tys, res_ty) = dataConFullSig con
index 9b62c27..b7435e5 100644 (file)
@@ -31,7 +31,7 @@ module DataCon (
         dataConName, dataConIdentity, dataConTag, dataConTagZ,
         dataConTyCon, dataConOrigTyCon,
         dataConUserType,
-        dataConUnivTyVars, dataConExTyVars, dataConUnivAndExTyVars,
+        dataConUnivTyVars, dataConExTyCoVars, dataConUnivAndExTyCoVars,
         dataConUserTyVars, dataConUserTyVarBinders,
         dataConEqSpec, dataConTheta,
         dataConStupidTheta,
@@ -288,19 +288,19 @@ data DataCon
         -- e.g.
         --
         --      dcUnivTyVars       = [a,b,c]
-        --      dcExTyVars         = [x,y]
+        --      dcExTyCoVars       = [x,y]
         --      dcUserTyVarBinders = [c,y,x,b]
         --      dcEqSpec           = [a~(x,y)]
         --      dcOtherTheta       = [x~y, Ord x]
         --      dcOrigArgTys       = [x,y]
         --      dcRepTyCon         = T
 
-        -- In general, the dcUnivTyVars are NOT NECESSARILY THE SAME AS THE TYVARS
-        -- FOR THE PARENT TyCon. (This is a change (Oct05): previously, vanilla
-        -- datacons guaranteed to have the same type variables as their parent TyCon,
-        -- but that seems ugly.) They can be different in the case where a GADT
-        -- constructor uses different names for the universal tyvars than does
-        -- the tycon. For example:
+        -- In general, the dcUnivTyVars are NOT NECESSARILY THE SAME AS THE
+        -- TYVARS FOR THE PARENT TyCon. (This is a change (Oct05): previously,
+        -- vanilla datacons guaranteed to have the same type variables as their
+        -- parent TyCon, but that seems ugly.) They can be different in the case
+        -- where a GADT constructor uses different names for the universal
+        -- tyvars than does the tycon. For example:
         --
         --   data H a where
         --     MkH :: b -> H b
@@ -312,7 +312,7 @@ data DataCon
                                 --          Its type is of form
                                 --              forall a1..an . t1 -> ... tm -> T a1..an
                                 --          No existentials, no coercions, nothing.
-                                -- That is: dcExTyVars = dcEqSpec = dcOtherTheta = []
+                                -- That is: dcExTyCoVars = dcEqSpec = dcOtherTheta = []
                 -- NB 1: newtypes always have a vanilla data con
                 -- NB 2: a vanilla constructor can still be declared in GADT-style
                 --       syntax, provided its type looks like the above.
@@ -323,23 +323,28 @@ data DataCon
         -- INVARIANT: result type of data con worker is exactly (T a b c)
         -- COROLLARY: The dcUnivTyVars are always in one-to-one correspondence with
         --            the tyConTyVars of the parent TyCon
-        dcUnivTyVars    :: [TyVar],
+        dcUnivTyVars     :: [TyVar],
 
-        -- Existentially-quantified type vars [x,y]
-        dcExTyVars     :: [TyVar],
+        -- Existentially-quantified type and coercion vars [x,y]
+        -- For an example involving coercion variables,
+        -- Why tycovars? See Note [Existential coercion variables]
+        dcExTyCoVars     :: [TyCoVar],
 
-        -- INVARIANT: the UnivTyVars and ExTyVars all have distinct OccNames
+        -- INVARIANT: the UnivTyVars and ExTyCoVars all have distinct OccNames
         -- Reason: less confusing, and easier to generate IfaceSyn
 
-        -- The type vars in the order the user wrote them [c,y,x,b]
-        -- INVARIANT: the set of tyvars in dcUserTyVarBinders is exactly the
-        --            set of dcExTyVars unioned with the set of dcUnivTyVars
-        --            whose tyvars do not appear in dcEqSpec
+        -- The type/coercion vars in the order the user wrote them [c,y,x,b]
+        -- INVARIANT: the set of tyvars in dcUserTyVarBinders is exactly the set
+        --            of tyvars (*not* covars) of dcExTyCoVars unioned with the
+        --            set of dcUnivTyVars whose tyvars do not appear in dcEqSpec
         -- See Note [DataCon user type variable binders]
         dcUserTyVarBinders :: [TyVarBinder],
 
         dcEqSpec :: [EqSpec],   -- Equalities derived from the result type,
-                                -- _as written by the programmer_
+                                -- _as written by the programmer_.
+                                -- Only non-dependent GADT equalities (dependent
+                                -- GADT equalities are in the covars of
+                                -- dcExTyCoVars).
 
                 -- This field allows us to move conveniently between the two ways
                 -- of representing a GADT constructor's type:
@@ -403,7 +408,7 @@ data DataCon
         dcRep      :: DataConRep,
 
         -- Cached; see Note [DataCon arities]
-        -- INVARIANT: dcRepArity    == length dataConRepArgTys
+        -- INVARIANT: dcRepArity    == length dataConRepArgTys + count isCoVar (dcExTyCoVars)
         -- INVARIANT: dcSourceArity == length dcOrigArgTys
         dcRepArity    :: Arity,
         dcSourceArity :: Arity,
@@ -441,7 +446,7 @@ For the TyVarBinders in a DataCon and PatSyn:
 
  * Each argument flag is Inferred or Specified.
    None are Required. (A DataCon is a term-level function; see
-   Note [No Required TyBinder in terms] in TyCoRep.)
+   Note [No Required TyCoBinder in terms] in TyCoRep.)
 
 Why do we need the TyVarBinders, rather than just the TyVars?  So that
 we can construct the right type for the DataCon with its foralls
@@ -451,6 +456,26 @@ can use visible type application at a call of the data constructor.
 See also [DataCon user type variable binders] for an extended discussion on the
 order in which TyVarBinders appear in a DataCon.
 
+Note [Existential coercion variables]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+For now (Aug 2018) we can't write coercion quantifications in source Haskell, but
+we can in Core. Consider having:
+
+  data T :: forall k. k -> k -> Constraint where
+    MkT :: forall k (a::k) (b::k). forall k' (c::k') (co::k'~k). (b~(c|>co))
+        => T k a b
+
+  dcUnivTyVars       = [k,a,b]
+  dcExTyCoVars       = [k',c,co]
+  dcUserTyVarBinders = [k,a,k',c]
+  dcEqSpec           = [b~(c|>co)]
+  dcOtherTheta       = []
+  dcOrigArgTys       = []
+  dcRepTyCon         = T
+
+  Function call 'dataConKindEqSpec' returns [k'~k]
+
 Note [DataCon arities]
 ~~~~~~~~~~~~~~~~~~~~~~
 dcSourceArity does not take constraints into account,
@@ -508,33 +533,35 @@ FC demands the variables go in universal-then-existential order under the hood.
 Our solution is thus to equip DataCon with two different sets of type
 variables:
 
-* dcUnivTyVars and dcExTyVars, for the universal and existential type
-  variables, respectively. Their order is irrelevant for the purposes of
-  TypeApplications, and as a consequence, they do not come equipped with
-  visibilities (that is, they are TyVars instead of TyVarBinders).
+* dcUnivTyVars and dcExTyCoVars, for the universal type variable and existential
+  type/coercion variables, respectively. Their order is irrelevant for the
+  purposes of TypeApplications, and as a consequence, they do not come equipped
+  with visibilities (that is, they are TyVars/TyCoVars instead of
+  TyCoVarBinders).
 * dcUserTyVarBinders, for the type variables binders in the order in which they
-  originally arose in the user-written type signature. Their order *does*
-  matter for TypeApplications, so they are full TyVarBinders, complete
-  with visibilities.
+  originally arose in the user-written type signature. Their order *does* matter
+  for TypeApplications, so they are full TyVarBinders, complete with
+  visibilities.
 
 This encoding has some redundancy. The set of tyvars in dcUserTyVarBinders
 consists precisely of:
 
 * The set of tyvars in dcUnivTyVars whose type variables do not appear in
   dcEqSpec, unioned with:
-* The set of tyvars in dcExTyVars
-
-The word "set" is used above because the order in which the tyvars
-appear in dcUserTyVarBinders can be completely different from the order in
-dcUnivTyVars or dcExTyVars. That is, the tyvars in dcUserTyVarBinders are a
-permutation of (dcExTyVars + a subset of dcUnivTyVars). But aside from the
-ordering, they in fact share the same type variables (with the same Uniques).
-We sometimes refer to this as "the dcUserTyVarBinders invariant".
-
-dcUserTyVarBinders, as the name suggests, is the one that users will see most
-of the time. It's used when computing the type signature of a data constructor
-(see dataConUserType), and as a result, it's what matters from a
-TypeApplications perspective.
+* The set of tyvars (*not* covars) in dcExTyCoVars
+  No covars here because because they're not user-written
+
+The word "set" is used above because the order in which the tyvars appear in
+dcUserTyVarBinders can be completely different from the order in dcUnivTyVars or
+dcExTyCoVars. That is, the tyvars in dcUserTyVarBinders are a permutation of
+(tyvars of dcExTyCoVars + a subset of dcUnivTyVars). But aside from the
+ordering, they in fact share the same type variables (with the same Uniques). We
+sometimes refer to this as "the dcUserTyVarBinders invariant".
+
+dcUserTyVarBinders, as the name suggests, is the one that users will see most of
+the time. It's used when computing the type signature of a data constructor (see
+dataConUserType), and as a result, it's what matters from a TypeApplications
+perspective.
 -}
 
 -- | Data Constructor Representation
@@ -640,7 +667,7 @@ data StrictnessMark = MarkedStrict | NotMarkedStrict
 data EqSpec = EqSpec TyVar
                      Type
 
--- | Make an 'EqSpec'
+-- | Make a non-dependent 'EqSpec'
 mkEqSpec :: TyVar -> Type -> EqSpec
 mkEqSpec tv ty = EqSpec tv ty
 
@@ -844,18 +871,18 @@ isMarkedStrict _               = True   -- All others are strict
 
 -- | Build a new data constructor
 mkDataCon :: Name
-          -> Bool               -- ^ Is the constructor declared infix?
-          -> TyConRepName       -- ^  TyConRepName for the promoted TyCon
-          -> [HsSrcBang]        -- ^ Strictness/unpack annotations, from user
-          -> [FieldLabel]       -- ^ Field labels for the constructor,
-                                -- if it is a record, otherwise empty
-          -> [TyVar]            -- ^ Universals.
-          -> [TyVar]            -- ^ Existentials.
-          -> [TyVarBinder]      -- ^ User-written 'TyVarBinder's.
-                                --   These must be Inferred/Specified.
-                                --   See @Note [TyVarBinders in DataCons]@
-          -> [EqSpec]           -- ^ GADT equalities
-          -> KnotTied ThetaType -- ^ Theta-type occuring before the arguments proper
+          -> Bool           -- ^ Is the constructor declared infix?
+          -> TyConRepName   -- ^  TyConRepName for the promoted TyCon
+          -> [HsSrcBang]    -- ^ Strictness/unpack annotations, from user
+          -> [FieldLabel]   -- ^ Field labels for the constructor,
+                            -- if it is a record, otherwise empty
+          -> [TyVar]        -- ^ Universals.
+          -> [TyCoVar]      -- ^ Existentials.
+          -> [TyVarBinder]  -- ^ User-written 'TyVarBinder's.
+                            --   These must be Inferred/Specified.
+                            --   See @Note [TyVarBinders in DataCons]@
+          -> [EqSpec]       -- ^ GADT equalities
+          -> KnotTied ThetaType -- ^ Theta-type occurring before the arguments proper
           -> [KnotTied Type]    -- ^ Original argument types
           -> KnotTied Type      -- ^ Original result type
           -> RuntimeRepInfo     -- ^ See comments on 'TyCon.RuntimeRepInfo'
@@ -890,7 +917,7 @@ mkDataCon name declared_infix prom_info
     con = MkData {dcName = name, dcUnique = nameUnique name,
                   dcVanilla = is_vanilla, dcInfix = declared_infix,
                   dcUnivTyVars = univ_tvs,
-                  dcExTyVars = ex_tvs,
+                  dcExTyCoVars = ex_tvs,
                   dcUserTyVarBinders = user_tvbs,
                   dcEqSpec = eq_spec,
                   dcOtherTheta = theta,
@@ -902,7 +929,7 @@ mkDataCon name declared_infix prom_info
                   dcWorkId = work_id,
                   dcRep = rep,
                   dcSourceArity = length orig_arg_tys,
-                  dcRepArity = length rep_arg_tys,
+                  dcRepArity = length rep_arg_tys + count isCoVar ex_tvs,
                   dcPromoted = promoted }
 
         -- The 'arg_stricts' passed to mkDataCon are simply those for the
@@ -918,13 +945,13 @@ mkDataCon name declared_infix prom_info
         NoDataConRep -> dataConUserType con
         -- If the DataCon has a wrapper, then the worker's type is never seen
         -- by the user. The visibilities we pick do not matter here.
-        DCR{} -> mkInvForAllTys univ_tvs $ mkInvForAllTys ex_tvs $
+        DCR{} -> mkInvForAllTys univ_tvs $ mkTyCoInvForAllTys ex_tvs $
                  mkFunTys rep_arg_tys $
                  mkTyConApp rep_tycon (mkTyVarTys univ_tvs)
 
       -- See Note [Promoted data constructors] in TyCon
     prom_tv_bndrs = [ mkNamedTyConBinder vis tv
-                    | TvBndr tv vis <- user_tvbs ]
+                    | Bndr tv vis <- user_tvbs ]
 
     prom_arg_bndrs = mkCleanAnonTyConBinders prom_tv_bndrs (theta ++ orig_arg_tys)
     prom_res_kind  = orig_res_ty
@@ -932,8 +959,9 @@ mkDataCon name declared_infix prom_info
                                        (prom_tv_bndrs ++ prom_arg_bndrs)
                                        prom_res_kind roles rep_info
 
-    roles = map (const Nominal) (univ_tvs ++ ex_tvs) ++
-            map (const Representational) orig_arg_tys
+    roles = map (\tv -> if isTyVar tv then Nominal else Phantom)
+                (univ_tvs ++ ex_tvs)
+            ++ map (const Representational) orig_arg_tys
 
 mkCleanAnonTyConBinders :: [TyConBinder] -> [Type] -> [TyConBinder]
 -- Make sure that the "anonymous" tyvars don't clash in
@@ -1000,13 +1028,14 @@ dataConIsInfix = dcInfix
 dataConUnivTyVars :: DataCon -> [TyVar]
 dataConUnivTyVars (MkData { dcUnivTyVars = tvbs }) = tvbs
 
--- | The existentially-quantified type variables of the constructor
-dataConExTyVars :: DataCon -> [TyVar]
-dataConExTyVars (MkData { dcExTyVars = tvbs }) = tvbs
+-- | The existentially-quantified type/coercion variables of the constructor
+-- including dependent (kind-) GADT equalities
+dataConExTyCoVars :: DataCon -> [TyCoVar]
+dataConExTyCoVars (MkData { dcExTyCoVars = tvbs }) = tvbs
 
--- | Both the universal and existential type variables of the constructor
-dataConUnivAndExTyVars :: DataCon -> [TyVar]
-dataConUnivAndExTyVars (MkData { dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs })
+-- | Both the universal and existential type/coercion variables of the constructor
+dataConUnivAndExTyCoVars :: DataCon -> [TyCoVar]
+dataConUnivAndExTyCoVars (MkData { dcUnivTyVars = univ_tvs, dcExTyCoVars = ex_tvs })
   = univ_tvs ++ ex_tvs
 
 -- See Note [DataCon user type variable binders]
@@ -1015,7 +1044,7 @@ dataConUserTyVars :: DataCon -> [TyVar]
 dataConUserTyVars (MkData { dcUserTyVarBinders = tvbs }) = binderVars tvbs
 
 -- See Note [DataCon user type variable binders]
--- | 'TyVarBinder's for the type variables of the constructor, in the order the
+-- | 'TyCoVarBinder's for the type variables of the constructor, in the order the
 -- user wrote them
 dataConUserTyVarBinders :: DataCon -> [TyVarBinder]
 dataConUserTyVarBinders = dcUserTyVarBinders
@@ -1024,8 +1053,9 @@ dataConUserTyVarBinders = dcUserTyVarBinders
 -- by the programmer in any GADT declaration. This includes *all* GADT-like
 -- equalities, including those written in by hand by the programmer.
 dataConEqSpec :: DataCon -> [EqSpec]
-dataConEqSpec (MkData { dcEqSpec = eq_spec, dcOtherTheta = theta })
-  = eq_spec ++
+dataConEqSpec con@(MkData { dcEqSpec = eq_spec, dcOtherTheta = theta })
+  = dataConKindEqSpec con
+    ++ eq_spec ++
     [ spec   -- heterogeneous equality
     | Just (tc, [_k1, _k2, ty1, ty2]) <- map splitTyConApp_maybe theta
     , tc `hasKey` heqTyConKey
@@ -1043,11 +1073,29 @@ dataConEqSpec (MkData { dcEqSpec = eq_spec, dcOtherTheta = theta })
                     _             -> []
     ]
 
+-- | Dependent (kind-level) equalities in a constructor.
+-- There are extracted from the existential variables.
+-- See Note [Existential coercion variables]
+dataConKindEqSpec :: DataCon -> [EqSpec]
+dataConKindEqSpec (MkData {dcExTyCoVars = ex_tcvs})
+  -- It is used in 'dataConEqSpec' (maybe also 'dataConFullSig' in the future),
+  -- which are frequently used functions.
+  -- For now (Aug 2018) this function always return empty set as we don't really
+  -- have coercion variables.
+  -- In the future when we do, we might want to cache this information in DataCon
+  -- so it won't be computed every time when aforementioned functions are called.
+  = [ EqSpec tv ty
+    | cv <- ex_tcvs
+    , isCoVar cv
+    , let (_, _, ty1, ty, _) = coVarKindsTypesRole cv
+          tv = getTyVar "dataConKindEqSpec" ty1
+    ]
 
--- | The *full* constraints on the constructor type.
+-- | The *full* constraints on the constructor type, including dependent GADT
+-- equalities.
 dataConTheta :: DataCon -> ThetaType
-dataConTheta (MkData { dcEqSpec = eq_spec, dcOtherTheta = theta })
-  = eqSpecPreds eq_spec ++ theta
+dataConTheta con@(MkData { dcEqSpec = eq_spec, dcOtherTheta = theta })
+  = eqSpecPreds (dataConKindEqSpec con ++ eq_spec) ++ theta
 
 -- | Get the Id of the 'DataCon' worker: a function that is the "actual"
 -- constructor and has no top level binding in the program. The type may
@@ -1057,9 +1105,11 @@ dataConWorkId :: DataCon -> Id
 dataConWorkId dc = dcWorkId dc
 
 -- | Get the Id of the 'DataCon' wrapper: a function that wraps the "actual"
--- constructor so it has the type visible in the source program: c.f. 'dataConWorkId'.
--- Returns Nothing if there is no wrapper, which occurs for an algebraic data constructor
--- and also for a newtype (whose constructor is inlined compulsorily)
+-- constructor so it has the type visible in the source program: c.f.
+-- 'dataConWorkId'.
+-- Returns Nothing if there is no wrapper, which occurs for an algebraic data
+-- constructor and also for a newtype (whose constructor is inlined
+-- compulsorily)
 dataConWrapId_maybe :: DataCon -> Maybe Id
 dataConWrapId_maybe dc = case dcRep dc of
                            NoDataConRep -> Nothing
@@ -1148,54 +1198,62 @@ dataConBoxer _ = Nothing
 
 -- | The \"signature\" of the 'DataCon' returns, in order:
 --
--- 1) The result of 'dataConUnivAndExTyVars',
+-- 1) The result of 'dataConUnivAndExTyCoVars',
 --
--- 2) All the 'ThetaType's relating to the 'DataCon' (coercion, dictionary, implicit
---    parameter - whatever)
+-- 2) All the 'ThetaType's relating to the 'DataCon' (coercion, dictionary,
+--    implicit parameter - whatever), including dependent GADT equalities.
+--    Dependent GADT equalities are *also* listed in return value (1), so be
+--    careful!
 --
 -- 3) The type arguments to the constructor
 --
 -- 4) The /original/ result type of the 'DataCon'
-dataConSig :: DataCon -> ([TyVar], ThetaType, [Type], Type)
+dataConSig :: DataCon -> ([TyCoVar], ThetaType, [Type], Type)
 dataConSig con@(MkData {dcOrigArgTys = arg_tys, dcOrigResTy = res_ty})
-  = (dataConUnivAndExTyVars con, dataConTheta con, arg_tys, res_ty)
+  = (dataConUnivAndExTyCoVars con, dataConTheta con, arg_tys, res_ty)
 
 dataConInstSig
   :: DataCon
   -> [Type]    -- Instantiate the *universal* tyvars with these types
-  -> ([TyVar], ThetaType, [Type])  -- Return instantiated existentials
-                                   -- theta and arg tys
+  -> ([TyCoVar], ThetaType, [Type])  -- Return instantiated existentials
+                                     -- theta and arg tys
 -- ^ Instantiate the universal tyvars of a data con,
---   returning the instantiated existentials, constraints, and args
-dataConInstSig (MkData { dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs
-                       , dcEqSpec = eq_spec, dcOtherTheta  = theta
-                       , dcOrigArgTys = arg_tys })
+--   returning
+--     ( instantiated existentials
+--     , instantiated constraints including dependent GADT equalities
+--         which are *also* listed in the instantiated existentials
+--     , instantiated args)
+dataConInstSig con@(MkData { dcUnivTyVars = univ_tvs, dcExTyCoVars = ex_tvs
+                           , dcOrigArgTys = arg_tys })
                univ_tys
   = ( ex_tvs'
-    , substTheta subst (eqSpecPreds eq_spec ++ theta)
+    , substTheta subst (dataConTheta con)
     , substTys   subst arg_tys)
   where
     univ_subst = zipTvSubst univ_tvs univ_tys
-    (subst, ex_tvs') = Type.substTyVarBndrs univ_subst ex_tvs
+    (subst, ex_tvs') = Type.substVarBndrs univ_subst ex_tvs
 
 
 -- | The \"full signature\" of the 'DataCon' returns, in order:
 --
 -- 1) The result of 'dataConUnivTyVars'
 --
--- 2) The result of 'dataConExTyVars'
+-- 2) The result of 'dataConExTyCoVars'
 --
--- 3) The GADT equalities
+-- 3) The non-dependent GADT equalities.
+--    Dependent GADT equalities are implied by coercion variables in
+--    return value (2).
 --
--- 4) The result of 'dataConDictTheta'
+-- 4) The other constraints of the data constructor type, excluding GADT
+-- equalities
 --
 -- 5) The original argument types to the 'DataCon' (i.e. before
 --    any change of the representation of the type)
 --
 -- 6) The original result type of the 'DataCon'
 dataConFullSig :: DataCon
-               -> ([TyVar], [TyVar], [EqSpec], ThetaType, [Type], Type)
-dataConFullSig (MkData {dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs,
+               -> ([TyVar], [TyCoVar], [EqSpec], ThetaType, [Type], Type)
+dataConFullSig (MkData {dcUnivTyVars = univ_tvs, dcExTyCoVars = ex_tvs,
                         dcEqSpec = eq_spec, dcOtherTheta = theta,
                         dcOrigArgTys = arg_tys, dcOrigResTy = res_ty})
   = (univ_tvs, ex_tvs, eq_spec, theta, arg_tys, res_ty)
@@ -1232,7 +1290,8 @@ dataConUserType (MkData { dcUserTyVarBinders = user_tvbs,
     mkFunTys arg_tys $
     res_ty
 
--- | Finds the instantiated types of the arguments required to construct a 'DataCon' representation
+-- | Finds the instantiated types of the arguments required to construct a
+-- 'DataCon' representation
 -- NB: these INCLUDE any dictionary args
 --     but EXCLUDE the data-declaration context, which is discarded
 -- It's all post-flattening etc; this is a representation type
@@ -1242,7 +1301,7 @@ dataConInstArgTys :: DataCon    -- ^ A datacon with no existentials or equality
                   -> [Type]     -- ^ Instantiated at these types
                   -> [Type]
 dataConInstArgTys dc@(MkData {dcUnivTyVars = univ_tvs,
-                              dcExTyVars = ex_tvs}) inst_tys
+                              dcExTyCoVars = ex_tvs}) inst_tys
  = ASSERT2( univ_tvs `equalLength` inst_tys
           , text "dataConInstArgTys" <+> ppr dc $$ ppr univ_tvs $$ ppr inst_tys)
    ASSERT2( null ex_tvs, ppr dc )
@@ -1259,19 +1318,20 @@ dataConInstOrigArgTys
 -- But for the call in MatchCon, we really do want just the value args
 dataConInstOrigArgTys dc@(MkData {dcOrigArgTys = arg_tys,
                                   dcUnivTyVars = univ_tvs,
-                                  dcExTyVars = ex_tvs}) inst_tys
+                                  dcExTyCoVars = ex_tvs}) inst_tys
   = ASSERT2( tyvars `equalLength` inst_tys
-          , text "dataConInstOrigArgTys" <+> ppr dc $$ ppr tyvars $$ ppr inst_tys )
-    map (substTyWith tyvars inst_tys) arg_tys
+           , text "dataConInstOrigArgTys" <+> ppr dc $$ ppr tyvars $$ ppr inst_tys )
+    map (substTy subst) arg_tys
   where
     tyvars = univ_tvs ++ ex_tvs
+    subst  = zipTCvSubst tyvars inst_tys
 
 -- | Returns the argument types of the wrapper, excluding all dictionary arguments
 -- and without substituting for any type variables
 dataConOrigArgTys :: DataCon -> [Type]
 dataConOrigArgTys dc = dcOrigArgTys dc
 
--- | Returns the arg types of the worker, including *all*
+-- | Returns the arg types of the worker, including *all* non-dependent
 -- evidence, after any flattening has been done and without substituting for
 -- any type variables
 dataConRepArgTys :: DataCon -> [Type]
@@ -1346,9 +1406,9 @@ dataConCannotMatch tys con
 -- Note [Data con wrappers and GADT syntax] for an explanation of what
 -- mkDataConRep is doing with this function.
 dataConUserTyVarsArePermuted :: DataCon -> Bool
-dataConUserTyVarsArePermuted (MkData { dcUnivTyVars = univ_tvs,
-                                       dcExTyVars = ex_tvs, dcEqSpec = eq_spec,
-                                       dcUserTyVarBinders = user_tvbs }) =
+dataConUserTyVarsArePermuted (MkData { dcUnivTyVars = univ_tvs
+                                     , dcExTyCoVars = ex_tvs, dcEqSpec = eq_spec
+                                     , dcUserTyVarBinders = user_tvbs }) =
   (filterEqSpec eq_spec univ_tvs ++ ex_tvs) /= binderVars user_tvbs
 
 {-
index 61fb3ce..a691334 100644 (file)
@@ -1,7 +1,7 @@
 module DataCon where
 
 import GhcPrelude
-import Var( TyVar, TyVarBinder )
+import Var( TyVar, TyCoVar, TyVarBinder )
 import Name( Name, NamedThing )
 import {-# SOURCE #-} TyCon( TyCon )
 import FieldLabel ( FieldLabel )
@@ -16,7 +16,7 @@ data EqSpec
 
 dataConName      :: DataCon -> Name
 dataConTyCon     :: DataCon -> TyCon
-dataConExTyVars  :: DataCon -> [TyVar]
+dataConExTyCoVars :: DataCon -> [TyCoVar]
 dataConUserTyVars :: DataCon -> [TyVar]
 dataConUserTyVarBinders :: DataCon -> [TyVarBinder]
 dataConSourceArity  :: DataCon -> Arity
@@ -24,7 +24,7 @@ dataConFieldLabels :: DataCon -> [FieldLabel]
 dataConInstOrigArgTys  :: DataCon -> [Type] -> [Type]
 dataConStupidTheta :: DataCon -> ThetaType
 dataConFullSig :: DataCon
-               -> ([TyVar], [TyVar], [EqSpec], ThetaType, [Type], Type)
+               -> ([TyVar], [TyCoVar], [EqSpec], ThetaType, [Type], Type)
 isUnboxedSumCon :: DataCon -> Bool
 
 instance Eq DataCon
index 47fbce7..5a6f1fb 100644 (file)
@@ -394,7 +394,8 @@ mkDictSelRhs clas val_index
     dict_id        = mkTemplateLocal 1 pred
     arg_ids        = mkTemplateLocalsNum 2 arg_tys
 
-    rhs_body | new_tycon = unwrapNewTypeBody tycon (mkTyVarTys tyvars) (Var dict_id)
+    rhs_body | new_tycon = unwrapNewTypeBody tycon (mkTyVarTys tyvars)
+                                                   (Var dict_id)
              | otherwise = Case (Var dict_id) dict_id (idType the_arg_id)
                                 [(DataAlt data_con, arg_ids, varToCoreExpr the_arg_id)]
                                 -- varToCoreExpr needed for equality superclass selectors
@@ -465,7 +466,7 @@ mkDataConWorkId wkr_name data_con
 
         ----------- Workers for newtypes --------------
     (nt_tvs, _, nt_arg_tys, _) = dataConSig data_con
-    res_ty_args  = mkTyVarTys nt_tvs
+    res_ty_args  = mkTyCoVarTys nt_tvs
     nt_wrap_ty   = dataConUserType data_con
     nt_work_info = noCafIdInfo          -- The NoCaf-ness is set by noCafIdInfo
                   `setArityInfo` 1      -- Arity 1
@@ -484,7 +485,7 @@ dataConCPR :: DataCon -> DmdResult
 dataConCPR con
   | isDataTyCon tycon     -- Real data types only; that is,
                           -- not unboxed tuples or newtypes
-  , null (dataConExTyVars con)  -- No existentials
+  , null (dataConExTyCoVars con)  -- No existentials
   , wkr_arity > 0
   , wkr_arity <= mAX_CPR_SIZE
   = if is_prod then vanillaCprProdRes (dataConRepArity con)
@@ -631,7 +632,7 @@ mkDataConRep dflags fam_envs wrap_name mb_bangs data_con
     orig_bangs   = dataConSrcBangs data_con
 
     wrap_arg_tys = theta ++ orig_arg_tys
-    wrap_arity   = length wrap_arg_tys
+    wrap_arity   = count isCoVar ex_tvs + length wrap_arg_tys
              -- The wrap_args are the arguments *other than* the eq_spec
              -- Because we are going to apply the eq_spec args manually in the
              -- wrapper
@@ -672,8 +673,8 @@ mkDataConRep dflags fam_envs wrap_name mb_bangs data_con
     mk_boxer boxers = DCB (\ ty_args src_vars ->
                       do { let (ex_vars, term_vars) = splitAtList ex_tvs src_vars
                                subst1 = zipTvSubst univ_tvs ty_args
-                               subst2 = extendTvSubstList subst1 ex_tvs
-                                                          (mkTyVarTys ex_vars)
+                               subst2 = extendTCvSubstList subst1 ex_tvs
+                                                           (mkTyCoVarTys ex_vars)
                          ; (rep_ids, binds) <- go subst2 boxers term_vars
                          ; return (ex_vars ++ rep_ids, binds) } )
 
@@ -892,7 +893,8 @@ dataConArgUnpack arg_ty
       -- A recursive newtype might mean that
       -- 'arg_ty' is a newtype
   , let rep_tys = dataConInstArgTys con tc_args
-  = ASSERT( null (dataConExTyVars con) )  -- Note [Unpacking GADTs and existentials]
+  = ASSERT( null (dataConExTyCoVars con) )
+      -- Note [Unpacking GADTs and existentials]
     ( rep_tys `zip` dataConRepStrictness con
     ,( \ arg_id ->
        do { rep_ids <- mapM newLocal rep_tys
@@ -959,7 +961,8 @@ isUnpackableType dflags fam_envs ty
     unpackable_type ty
       | Just (tc, _) <- splitTyConApp_maybe ty
       , Just data_con <- tyConSingleAlgDataCon_maybe tc
-      , null (dataConExTyVars data_con)  -- See Note [Unpacking GADTs and existentials]
+      , null (dataConExTyCoVars data_con)
+          -- See Note [Unpacking GADTs and existentials]
       = Just data_con
       | otherwise
       = Nothing
@@ -975,7 +978,7 @@ components, like
 And it'd be fine to unpack a product type with existential components
 too, but that would require a bit more plumbing, so currently we don't.
 
-So for now we require: null (dataConExTyVars data_con)
+So for now we require: null (dataConExTyCoVars data_con)
 See Trac #14978
 
 Note [Unpack one-wide fields]
@@ -1136,7 +1139,7 @@ mkFCallId dflags uniq fcall ty
            `setLevityInfoWithType` ty
 
     (bndrs, _) = tcSplitPiTys ty
-    arity      = count isAnonTyBinder bndrs
+    arity      = count isAnonTyCoBinder bndrs
     strict_sig = mkClosedStrictSig (replicate arity topDmd) topRes
     -- the call does not claim to be strict in its arguments, since they
     -- may be lifted (foreign import prim) and the called code doesn't
index 2e838d6..bf9426e 100644 (file)
@@ -79,7 +79,7 @@ data PatSyn
 
         -- Result type
         psResultTy   :: Type,  -- Mentions only psUnivTyVars
-                                -- See Note [Pattern synonym result type]
+                               -- See Note [Pattern synonym result type]
 
         -- See Note [Matchers and builders for pattern synonyms]
         psMatcher     :: (Id, Bool),
@@ -339,10 +339,10 @@ instance Data.Data PatSyn where
 -- | Build a new pattern synonym
 mkPatSyn :: Name
          -> Bool                 -- ^ Is the pattern synonym declared infix?
-         -> ([TyVarBinder], ThetaType) -- ^ Universially-quantified type variables
-                                 --   and required dicts
-         -> ([TyVarBinder], ThetaType) -- ^ Existentially-quantified type variables
-                                 --   and provided dicts
+         -> ([TyVarBinder], ThetaType) -- ^ Universially-quantified type
+                                       -- variables and required dicts
+         -> ([TyVarBinder], ThetaType) -- ^ Existentially-quantified type
+                                       -- variables and provided dicts
          -> [Type]               -- ^ Original arguments
          -> Type                 -- ^ Original result type
          -> (Id, Bool)           -- ^ Name of matcher
index afefa6e..2009b6c 100644 (file)
@@ -61,10 +61,12 @@ module Var (
         mustHaveLocalBinding,
 
         -- * TyVar's
-        TyVarBndr(..), ArgFlag(..), TyVarBinder,
-        binderVar, binderVars, binderArgFlag, binderKind,
+        VarBndr(..), ArgFlag(..), TyCoVarBinder, TyVarBinder,
+        binderVar, binderVars, binderArgFlag, binderType,
         isVisibleArgFlag, isInvisibleArgFlag, sameVis,
+        mkTyCoVarBinder, mkTyCoVarBinders,
         mkTyVarBinder, mkTyVarBinders,
+        isTyVarBinder,
 
         -- ** Constructing TyVar's
         mkTyVar, mkTcTyVar,
@@ -190,7 +192,7 @@ type OutId      = Id
 Note [Kind and type variables]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Before kind polymorphism, TyVar were used to mean type variables. Now
-they are use to mean kind *or* type variables. KindVar is used when we
+they are used to mean kind *or* type variables. KindVar is used when we
 know for sure that it is a kind variable. In future, we might want to
 go over the whole compiler code to use:
    - TKVar   to mean kind or type variables
@@ -380,7 +382,7 @@ updateVarTypeM f id = do { ty' <- f (varType id)
 -- Is something required to appear in source Haskell ('Required'),
 -- permitted by request ('Specified') (visible type application), or
 -- prohibited entirely from appearing in source Haskell ('Inferred')?
--- See Note [TyVarBndrs, TyVarBinders, TyConBinders, and visibility] in TyCoRep
+-- See Note [VarBndrs, TyCoVarBinders, TyConBinders, and visibility] in TyCoRep
 data ArgFlag = Inferred | Specified | Required
   deriving (Eq, Ord, Data)
   -- (<) on ArgFlag meant "is less visible than"
@@ -405,45 +407,68 @@ sameVis _        _        = True
 
 {- *********************************************************************
 *                                                                      *
-*                   TyVarBndr, TyVarBinder
+*                   VarBndr, TyCoVarBinder
 *                                                                      *
 ********************************************************************* -}
 
--- Type Variable Binder
+-- Variable Binder
 --
--- TyVarBndr is polymorphic in both tyvar and visibility fields:
---   * tyvar can be TyVar or IfaceTv
---   * argf  can be ArgFlag or TyConBndrVis
-data TyVarBndr tyvar argf = TvBndr tyvar argf
+-- VarBndr is polymorphic in both var and visibility fields.
+-- Currently there are six different uses of 'VarBndr':
+--   * Var.TyVarBinder   = VarBndr TyVar ArgFlag
+--   * Var.TyCoVarBinder = VarBndr TyCoVar ArgFlag
+--   * TyCon.TyConBinder     = VarBndr TyVar TyConBndrVis
+--   * TyCon.TyConTyCoBinder = VarBndr TyCoVar TyConBndrVis
+--   * IfaceType.IfaceForAllBndr  = VarBndr IfaceBndr ArgFlag
+--   * IfaceType.IfaceTyConBinder = VarBndr IfaceBndr TyConBndrVis
+data VarBndr var argf = Bndr var argf
   deriving( Data )
 
--- | Type Variable Binder
+-- | Variable Binder
 --
--- A 'TyVarBinder' is the binder of a ForAllTy
+-- A 'TyCoVarBinder' is the binder of a ForAllTy
 -- It's convenient to define this synonym here rather its natural
 -- home in TyCoRep, because it's used in DataCon.hs-boot
-type TyVarBinder = TyVarBndr TyVar ArgFlag
+--
+-- A 'TyVarBinder' is a binder with only TyVar
+type TyCoVarBinder = VarBndr TyCoVar ArgFlag
+type TyVarBinder   = VarBndr TyVar ArgFlag
 
-binderVar :: TyVarBndr tv argf -> tv
-binderVar (TvBndr v _) = v
+binderVar :: VarBndr tv argf -> tv
+binderVar (Bndr v _) = v
 
-binderVars :: [TyVarBndr tv argf] -> [tv]
+binderVars :: [VarBndr tv argf] -> [tv]
 binderVars tvbs = map binderVar tvbs
 
-binderArgFlag :: TyVarBndr tv argf -> argf
-binderArgFlag (TvBndr _ argf) = argf
+binderArgFlag :: VarBndr tv argf -> argf
+binderArgFlag (Bndr _ argf) = argf
+
+binderType :: VarBndr TyCoVar argf -> Type
+binderType (Bndr tv _) = varType tv
 
-binderKind :: TyVarBndr TyVar argf -> Kind
-binderKind (TvBndr tv _) = tyVarKind tv
+-- | Make a named binder
+mkTyCoVarBinder :: ArgFlag -> TyCoVar -> TyCoVarBinder
+mkTyCoVarBinder vis var = Bndr var vis
 
 -- | Make a named binder
-mkTyVarBinder :: ArgFlag -> Var -> TyVarBinder
-mkTyVarBinder vis var = TvBndr var vis
+-- 'var' should be a type variable
+mkTyVarBinder :: ArgFlag -> TyVar -> TyVarBinder
+mkTyVarBinder vis var
+  = ASSERT( isTyVar var )
+    Bndr var vis
 
 -- | Make many named binders
+mkTyCoVarBinders :: ArgFlag -> [TyCoVar] -> [TyCoVarBinder]
+mkTyCoVarBinders vis = map (mkTyCoVarBinder vis)
+
+-- | Make many named binders
+-- Input vars should be type variables
 mkTyVarBinders :: ArgFlag -> [TyVar] -> [TyVarBinder]
 mkTyVarBinders vis = map (mkTyVarBinder vis)
 
+isTyVarBinder :: TyCoVarBinder -> Bool
+isTyVarBinder (Bndr v _) = isTyVar v
+
 {-
 ************************************************************************
 *                                                                      *
@@ -500,20 +525,20 @@ setTcTyVarDetails :: TyVar -> TcTyVarDetails -> TyVar
 setTcTyVarDetails tv details = tv { tc_tv_details = details }
 
 -------------------------------------
-instance Outputable tv => Outputable (TyVarBndr tv ArgFlag) where
-  ppr (TvBndr v Required)  = ppr v
-  ppr (TvBndr v Specified) = char '@' <> ppr v
-  ppr (TvBndr v Inferred)  = braces (ppr v)
+instance Outputable tv => Outputable (VarBndr tv ArgFlag) where
+  ppr (Bndr v Required)  = ppr v
+  ppr (Bndr v Specified) = char '@' <> ppr v
+  ppr (Bndr v Inferred)  = braces (ppr v)
 
 instance Outputable ArgFlag where
   ppr Required  = text "[req]"
   ppr Specified = text "[spec]"
   ppr Inferred  = text "[infrd]"
 
-instance (Binary tv, Binary vis) => Binary (TyVarBndr tv vis) where
-  put_ bh (TvBndr tv vis) = do { put_ bh tv; put_ bh vis }
+instance (Binary tv, Binary vis) => Binary (VarBndr tv vis) where
+  put_ bh (Bndr tv vis) = do { put_ bh tv; put_ bh vis }
 
-  get bh = do { tv <- get bh; vis <- get bh; return (TvBndr tv vis) }
+  get bh = do { tv <- get bh; vis <- get bh; return (Bndr tv vis) }
 
 
 instance Binary ArgFlag where
index 5f934e0..d15da87 100644 (file)
@@ -1037,10 +1037,19 @@ mkEtaWW orig_n orig_expr in_scope orig_ty
        | n == 0
        = (getTCvInScope subst, reverse eis)
 
-       | Just (tv,ty') <- splitForAllTy_maybe ty
-       , let (subst', tv') = Type.substTyVarBndr subst tv
+       | Just (tcv,ty') <- splitForAllTy_maybe ty
+       , let (subst', tcv') = Type.substVarBndr subst tcv
+       = let ((n_subst, n_tcv), n_n)
+               -- We want to have at least 'n' lambdas at the top.
+               -- If tcv is a tyvar, it corresponds to one Lambda (/\).
+               --   And we won't reduce n.
+               -- If tcv is a covar, we could eta-expand the expr with one
+               --   lambda \co:ty. e co. In this case we generate a new variable
+               --   of the coercion type, update the scope, and reduce n by 1.
+               | isTyVar tcv = ((subst', tcv'), n)
+               | otherwise  = (freshEtaId n subst' (varType tcv'), n-1)
            -- Avoid free vars of the original expression
-       = go n subst' ty' (EtaVar tv' : eis)
+         in go n_n n_subst ty' (EtaVar n_tcv : eis)
 
        | Just (arg_ty, res_ty) <- splitFunTy_maybe ty
        , not (isTypeLevPoly arg_ty)
@@ -1123,8 +1132,8 @@ etaBodyForJoinPoint need_args body
       = (reverse rev_bs, e)
     go n ty subst rev_bs e
       | Just (tv, res_ty) <- splitForAllTy_maybe ty
-      , let (subst', tv') = Type.substTyVarBndr subst tv
-      = go (n-1) res_ty subst' (tv' : rev_bs) (e `App` Type (mkTyVarTy tv'))
+      , let (subst', tv') = Type.substVarBndr subst tv
+      = go (n-1) res_ty subst' (tv' : rev_bs) (e `App` varToCoreExpr tv')
       | Just (arg_ty, res_ty) <- splitFunTy_maybe ty
       , let (subst', b) = freshEtaId n subst arg_ty
       = go (n-1) res_ty subst' (b : rev_bs) (e `App` Var b)
index 607fb73..bc54d26 100644 (file)
@@ -351,7 +351,7 @@ orphNamesOfType (TyVarTy _)          = emptyNameSet
 orphNamesOfType (LitTy {})           = emptyNameSet
 orphNamesOfType (TyConApp tycon tys) = orphNamesOfTyCon tycon
                                        `unionNameSet` orphNamesOfTypes tys
-orphNamesOfType (ForAllTy bndr res)  = orphNamesOfType (binderKind bndr)
+orphNamesOfType (ForAllTy bndr res)  = orphNamesOfType (binderType bndr)
                                        `unionNameSet` orphNamesOfType res
 orphNamesOfType (FunTy arg res)      = unitNameSet funTyConName    -- NB!  See Trac #8535
                                        `unionNameSet` orphNamesOfType arg
index 349d36d..21edba1 100644 (file)
@@ -1352,9 +1352,10 @@ lintType ty@(FunTy t1 t2)
        ; k2 <- lintType t2
        ; lintArrow (text "type or kind" <+> quotes (ppr ty)) k1 k2 }
 
-lintType t@(ForAllTy (TvBndr tv _vis) ty)
-  = do { lintL (isTyVar tv) (text "Covar bound in type:" <+> ppr t)
-       ; lintTyBndr tv $ \tv' ->
+lintType t@(ForAllTy (Bndr tv _vis) ty)
+  -- forall over types
+  | isTyVar tv
+  = do { lintTyBndr tv $ \tv' ->
     do { k <- lintType ty
        ; checkValueKind k (text "the body of forall:" <+> ppr t)
        ; case occCheckExpand [tv'] k of  -- See Note [Stupid type synonyms]
@@ -1364,6 +1365,20 @@ lintType t@(ForAllTy (TvBndr tv _vis) ty)
                                             , text "kind:" <+> ppr k ]))
     }}
 
+lintType t@(ForAllTy (Bndr cv _vis) ty)
+  -- forall over coercions
+  = do { lintL (isCoVar cv)
+               (text "Non-Tyvar or Non-Covar bound in type:" <+> ppr t)
+       ; lintL (cv `elemVarSet` tyCoVarsOfType ty)
+               (text "Covar does not occur in the body:" <+> ppr t)
+       ; lintCoBndr cv $ \_ ->
+    do { k <- lintType ty
+       ; checkValueKind k (text "the body of forall:" <+> ppr t)
+       ; return liftedTypeKind
+           -- We don't check variable escape here. Namely, k could refer to cv'
+           -- See Note [NthCo and newtypes] in TyCoRep
+    }}
+
 lintType ty@(LitTy l) = lintTyLit l >> return (typeKind ty)
 
 lintType (CastTy ty co)
@@ -1491,11 +1506,11 @@ lint_app doc kfn kas
              addErrL (fail_msg (text "Fun:" <+> (ppr kfa $$ ppr tka)))
            ; return kfb }
 
-    go_app in_scope (ForAllTy (TvBndr kv _vis) kfn) tka@(ta,ka)
-      = do { let kv_kind = tyVarKind kv
+    go_app in_scope (ForAllTy (Bndr kv _vis) kfn) tka@(ta,ka)
+      = do { let kv_kind = varType kv
            ; unless (ka `eqType` kv_kind) $
              addErrL (fail_msg (text "Forall:" <+> (ppr kv $$ ppr kv_kind $$ ppr tka)))
-           ; return (substTyWithInScope in_scope [kv] [ta] kfn) }
+           ; return $ substTy (extendTCvSubst (mkEmptyTCvSubst in_scope) kv ta) kfn }
 
     go_app _ kfn ka
        = failWithL (fail_msg (text "Not a fun:" <+> (ppr kfn $$ ppr ka)))
@@ -1681,6 +1696,8 @@ lintCoercion co@(AppCo co1 co2)
 
 ----------
 lintCoercion (ForAllCo tv1 kind_co co)
+  -- forall over types
+  | isTyVar tv1
   = do { (_, k2) <- lintStarCoercion kind_co
        ; let tv2 = setTyVarKind tv1 k2
        ; addInScopeVar tv1 $
@@ -1700,6 +1717,37 @@ lintCoercion (ForAllCo tv1 kind_co co)
                    substTy subst t2
        ; return (k3, k4, tyl, tyr, r) } }
 
+lintCoercion (ForAllCo cv1 kind_co co)
+  -- forall over coercions
+  = ASSERT( isCoVar cv1 )
+    do { (_, k2) <- lintStarCoercion kind_co
+       ; let cv2 = setVarType cv1 k2
+       ; addInScopeVar cv1 $
+    do {
+       ; (k3, k4, t1, t2, r) <- lintCoercion co
+       ; checkValueKind k3 (text "the body of a ForAllCo over covar:" <+> ppr co)
+       ; checkValueKind k4 (text "the body of a ForAllCo over covar:" <+> ppr co)
+           -- See Note [Weird typing rule for ForAllTy] in Type
+       ; in_scope <- getInScope
+       ; let tyl   = mkTyCoInvForAllTy cv1 t1
+             r2    = coVarRole cv1
+             kind_co' = downgradeRole r2 Nominal kind_co
+             eta1  = mkNthCo r2 2 kind_co'
+             eta2  = mkNthCo r2 3 kind_co'
+             subst = mkCvSubst in_scope $
+                     -- We need both the free vars of the `t2` and the
+                     -- free vars of the range of the substitution in
+                     -- scope. All the free vars of `t2` and `kind_co` should
+                     -- already be in `in_scope`, because they've been
+                     -- linted and `cv2` has the same unique as `cv1`.
+                     -- See Note [The substitution invariant]
+                     unitVarEnv cv1 (eta1 `mkTransCo` (mkCoVarCo cv2)
+                                          `mkTransCo` (mkSymCo eta2))
+             tyr = mkTyCoInvForAllTy cv2 $
+                   substTy subst t2
+       ; return (liftedTypeKind, liftedTypeKind, tyl, tyr, r) } }
+                   -- See Note [Weird typing rule for ForAllTy] in Type
+
 lintCoercion co@(FunCo r co1 co2)
   = do { (k1,k'1,s1,t1,r1) <- lintCoercion co1
        ; (k2,k'2,s2,t2,r2) <- lintCoercion co2
@@ -1804,13 +1852,16 @@ lintCoercion co@(TransCo co1 co2)
 lintCoercion the_co@(NthCo r0 n co)
   = do { (_, _, s, t, r) <- lintCoercion co
        ; case (splitForAllTy_maybe s, splitForAllTy_maybe t) of
-         { (Just (tv_s, _ty_s), Just (tv_t, _ty_t))
-             |  n == 0
+         { (Just (tcv_s, _ty_s), Just (tcv_t, _ty_t))
+             -- works for both tyvar and covar
+             | n == 0
+             ,  (isForAllTy_ty s && isForAllTy_ty t)
+             || (isForAllTy_co s && isForAllTy_co t)
              -> do { lintRole the_co Nominal r0
                    ; return (ks, kt, ts, tt, r0) }
              where
-               ts = tyVarKind tv_s
-               tt = tyVarKind tv_t
+               ts = varType tcv_s
+               tt = varType tcv_t
                ks = typeKind ts
                kt = typeKind tt
 
@@ -1853,16 +1904,32 @@ lintCoercion (InstCo co arg)
        ; (k1',k2',s1,s2, r') <- lintCoercion arg
        ; lintRole arg Nominal r'
        ; in_scope <- getInScope
-       ; case (splitForAllTy_maybe t1', splitForAllTy_maybe t2') of
-          (Just (tv1,t1), Just (tv2,t2))
-            | k1' `eqType` tyVarKind tv1
-            , k2' `eqType` tyVarKind tv2
-            -> return (k3, k4,
-                       substTyWithInScope in_scope [tv1] [s1] t1,
-                       substTyWithInScope in_scope [tv2] [s2] t2, r)
-            | otherwise
-            -> failWithL (text "Kind mis-match in inst coercion")
-          _ -> failWithL (text "Bad argument of inst") }
+       ; case (splitForAllTy_ty_maybe t1', splitForAllTy_ty_maybe t2') of
+         -- forall over tvar
+         { (Just (tv1,t1), Just (tv2,t2))
+             | k1' `eqType` tyVarKind tv1
+             , k2' `eqType` tyVarKind tv2
+             -> return (k3, k4,
+                        substTyWithInScope in_scope [tv1] [s1] t1,
+                        substTyWithInScope in_scope [tv2] [s2] t2, r)
+             | otherwise
+             -> failWithL (text "Kind mis-match in inst coercion")
+         ; _ -> case (splitForAllTy_co_maybe t1', splitForAllTy_co_maybe t2') of
+         -- forall over covar
+         { (Just (cv1, t1), Just (cv2, t2))
+             | k1' `eqType` varType cv1
+             , k2' `eqType` varType cv2
+             , CoercionTy s1' <- s1
+             , CoercionTy s2' <- s2
+             -> do { return $
+                       (liftedTypeKind, liftedTypeKind
+                          -- See Note [Weird typing rule for ForAllTy] in Type
+                       , substTy (mkCvSubst in_scope $ unitVarEnv cv1 s1') t1
+                       , substTy (mkCvSubst in_scope $ unitVarEnv cv2 s2') t2
+                       , r) }
+             | otherwise
+             -> failWithL (text "Kind mis-match in inst coercion")
+         ; _ -> failWithL (text "Bad argument of inst") }}}
 
 lintCoercion co@(AxiomInstCo con ind cos)
   = do { unless (0 <= ind && ind < numBranches (coAxiomBranches con))
index 0c9faa3..11f2fb1 100644 (file)
@@ -522,8 +522,8 @@ instance Eq (DeBruijn Type) where
             -> tc == tc' && D env tys == D env' tys'
         (LitTy l, LitTy l')
             -> l == l'
-        (ForAllTy (TvBndr tv _) ty, ForAllTy (TvBndr tv' _) ty')
-            -> D env (tyVarKind tv)    == D env' (tyVarKind tv') &&
+        (ForAllTy (Bndr tv _) ty, ForAllTy (Bndr tv' _) ty')
+            -> D env (varType tv)      == D env' (varType tv') &&
                D (extendCME env tv) ty == D (extendCME env' tv') ty'
         (CoercionTy {}, CoercionTy {})
             -> True
@@ -563,7 +563,7 @@ lkT (D env ty) m = go ty m
     go (TyConApp tc [])            = tm_tycon  >.> lkDNamed tc
     go ty@(TyConApp _ (_:_))       = pprPanic "lkT TyConApp" (ppr ty)
     go (LitTy l)                   = tm_tylit  >.> lkTyLit l
-    go (ForAllTy (TvBndr tv _) ty) = tm_forall >.> lkG (D (extendCME env tv) ty)
+    go (ForAllTy (Bndr tv _) ty)   = tm_forall >.> lkG (D (extendCME env tv) ty)
                                                >=> lkBndr env tv
     go ty@(FunTy {})               = pprPanic "lkT FunTy" (ppr ty)
     go (CastTy t _)                = go t
@@ -580,7 +580,7 @@ xtT (D _   (TyConApp tc []))  f m = m { tm_tycon  = tm_tycon m |> xtDNamed tc f
 xtT (D _   (LitTy l))         f m = m { tm_tylit  = tm_tylit m |> xtTyLit l f }
 xtT (D env (CastTy t _))      f m = xtT (D env t) f m
 xtT (D _   (CoercionTy {}))   f m = m { tm_coerce = tm_coerce m |> f }
-xtT (D env (ForAllTy (TvBndr tv _) ty))  f m
+xtT (D env (ForAllTy (Bndr tv _) ty))  f m
   = m { tm_forall = tm_forall m |> xtG (D (extendCME env tv) ty)
                                 |>> xtBndr env tv f }
 xtT (D _   ty@(TyConApp _ (_:_))) _ _ = pprPanic "xtT TyConApp" (ppr ty)
index 3254d73..2367c45 100644 (file)
@@ -1010,8 +1010,8 @@ pushCoTyArg co ty
   | isReflCo co
   = Just (ty, MRefl)
 
-  | isForAllTy tyL
-  = ASSERT2( isForAllTy tyR, ppr co $$ ppr ty )
+  | isForAllTy_ty tyL
+  = ASSERT2( isForAllTy_ty tyR, ppr co $$ ppr ty )
     Just (ty `mkCastTy` co1, MCo co2)
 
   | otherwise
@@ -1112,11 +1112,11 @@ pushCoDataCon dc dc_args co
   = let
         tc_arity       = tyConArity to_tc
         dc_univ_tyvars = dataConUnivTyVars dc
-        dc_ex_tyvars   = dataConExTyVars dc
+        dc_ex_tcvars   = dataConExTyCoVars dc
         arg_tys        = dataConRepArgTys dc
 
         non_univ_args  = dropList dc_univ_tyvars dc_args
-        (ex_args, val_args) = splitAtList dc_ex_tyvars non_univ_args
+        (ex_args, val_args) = splitAtList dc_ex_tcvars non_univ_args
 
         -- Make the "Psi" from the paper
         omegas = decomposeCo tc_arity co (tyConRolesRepresentational to_tc)
@@ -1124,7 +1124,7 @@ pushCoDataCon dc dc_args co
           = liftCoSubstWithEx Representational
                               dc_univ_tyvars
                               omegas
-                              dc_ex_tyvars
+                              dc_ex_tcvars
                               (map exprToType ex_args)
 
           -- Cast the value arguments (which include dictionaries)
@@ -1133,7 +1133,7 @@ pushCoDataCon dc dc_args co
 
         to_ex_args = map Type to_ex_arg_tys
 
-        dump_doc = vcat [ppr dc,      ppr dc_univ_tyvars, ppr dc_ex_tyvars,
+        dump_doc = vcat [ppr dc,      ppr dc_univ_tyvars, ppr dc_ex_tcvars,
                          ppr arg_tys, ppr dc_args,
                          ppr ex_args, ppr val_args, ppr co, ppr from_ty, ppr to_ty, ppr to_tc ]
     in
@@ -1179,11 +1179,19 @@ collectBindersPushingCo e
     go_lam bs b e co
       | isTyVar b
       , let Pair tyL tyR = coercionKind co
-      , ASSERT( isForAllTy tyL )
-        isForAllTy tyR
+      , ASSERT( isForAllTy_ty tyL )
+        isForAllTy_ty tyR
       , isReflCo (mkNthCo Nominal 0 co)  -- See Note [collectBindersPushingCo]
       = go_c (b:bs) e (mkInstCo co (mkNomReflCo (mkTyVarTy b)))
 
+      | isCoVar b
+      , let Pair tyL tyR = coercionKind co
+      , ASSERT( isForAllTy_co tyL )
+        isForAllTy_co tyR
+      , isReflCo (mkNthCo Nominal 0 co)  -- See Note [collectBindersPushingCo]
+      , let cov = mkCoVarCo b
+      = go_c (b:bs) e (mkInstCo co (mkNomReflCo (mkCoercionTy cov)))
+
       | isId b
       , let Pair tyL tyR = coercionKind co
       , ASSERT( isFunTy tyL) isFunTy tyR
index 3d2b4b1..2df3fb1 100644 (file)
@@ -89,7 +89,7 @@ data Subst
           TvSubstEnv  -- Substitution from TyVars to Types
           CvSubstEnv  -- Substitution from CoVars to Coercions
 
-        -- INVARIANT 1: See TyCORep Note [The substitution invariant]
+        -- INVARIANT 1: See TyCoRep Note [The substitution invariant]
         -- This is what lets us deal with name capture properly
         -- It's a hard invariant to check...
         --
@@ -171,7 +171,7 @@ mkEmptySubst in_scope = Subst in_scope emptyVarEnv emptyVarEnv emptyVarEnv
 mkSubst :: InScopeSet -> TvSubstEnv -> CvSubstEnv -> IdSubstEnv -> Subst
 mkSubst in_scope tvs cvs ids = Subst in_scope ids tvs cvs
 
--- | Find the in-scope set: see TyCORep Note [The substitution invariant]
+-- | Find the in-scope set: see TyCoRep Note [The substitution invariant]
 substInScope :: Subst -> InScopeSet
 substInScope (Subst in_scope _ _ _) = in_scope
 
@@ -181,7 +181,7 @@ zapSubstEnv :: Subst -> Subst
 zapSubstEnv (Subst in_scope _ _ _) = Subst in_scope emptyVarEnv emptyVarEnv emptyVarEnv
 
 -- | Add a substitution for an 'Id' to the 'Subst': you must ensure that the in-scope set is
--- such that TyCORep Note [The substitution invariant]
+-- such that TyCoRep Note [The substitution invariant]
 -- holds after extending the substitution like this
 extendIdSubst :: Subst -> Id -> CoreExpr -> Subst
 -- ToDo: add an ASSERT that fvs(subst-result) is already in the in-scope set
@@ -198,7 +198,7 @@ extendIdSubstList (Subst in_scope ids tvs cvs) prs
 -- | Add a substitution for a 'TyVar' to the 'Subst'
 -- The 'TyVar' *must* be a real TyVar, and not a CoVar
 -- You must ensure that the in-scope set is such that
--- TyCORep Note [The substitution invariant] holds
+-- TyCoRep Note [The substitution invariant] holds
 -- after extending the substitution like this.
 extendTvSubst :: Subst -> TyVar -> Type -> Subst
 extendTvSubst (Subst in_scope ids tvs cvs) tv ty
@@ -214,7 +214,7 @@ extendTvSubstList subst vrs
 
 -- | Add a substitution from a 'CoVar' to a 'Coercion' to the 'Subst':
 -- you must ensure that the in-scope set satisfies
--- TyCORep Note [The substitution invariant]
+-- TyCoRep Note [The substitution invariant]
 -- after extending the substitution like this
 extendCvSubst :: Subst -> CoVar -> Coercion -> Subst
 extendCvSubst (Subst in_scope ids tvs cvs) v r
index 5c2a44f..be5e6c1 100644 (file)
@@ -22,7 +22,7 @@ import CoreArity
 import Id
 import IdInfo
 import Demand ( zapUsageEnvSig )
-import Type( tidyType, tidyTyCoVarBndr )
+import Type( tidyType, tidyVarBndr )
 import Coercion( tidyCo )
 import Var
 import VarEnv
@@ -130,7 +130,7 @@ tidyVarOcc (_, var_env) v = lookupVarEnv var_env v `orElse` v
 -- tidyBndr is used for lambda and case binders
 tidyBndr :: TidyEnv -> Var -> (TidyEnv, Var)
 tidyBndr env var
-  | isTyCoVar var = tidyTyCoVarBndr env var
+  | isTyCoVar var = tidyVarBndr env var
   | otherwise     = tidyIdBndr env var
 
 tidyBndrs :: TidyEnv -> [Var] -> (TidyEnv, [Var])
index 7635a6d..a1dae98 100644 (file)
@@ -77,7 +77,7 @@ import Id
 import IdInfo
 import PrelNames( absentErrorIdKey )
 import Type
-import TyCoRep( TyBinder(..) )
+import TyCoRep( TyCoBinder(..), TyBinder )
 import Coercion
 import TyCon
 import Unique
@@ -1879,8 +1879,8 @@ exprIsTickedString_maybe _ = Nothing
 These InstPat functions go here to avoid circularity between DataCon and Id
 -}
 
-dataConRepInstPat   ::                 [Unique] -> DataCon -> [Type] -> ([TyVar], [Id])
-dataConRepFSInstPat :: [FastString] -> [Unique] -> DataCon -> [Type] -> ([TyVar], [Id])
+dataConRepInstPat   ::                 [Unique] -> DataCon -> [Type] -> ([TyCoVar], [Id])
+dataConRepFSInstPat :: [FastString] -> [Unique] -> DataCon -> [Type] -> ([TyCoVar], [Id])
 
 dataConRepInstPat   = dataConInstPat (repeat ((fsLit "ipv")))
 dataConRepFSInstPat = dataConInstPat
@@ -1889,7 +1889,7 @@ dataConInstPat :: [FastString]          -- A long enough list of FSs to use for
                -> [Unique]              -- An equally long list of uniques, at least one for each binder
                -> DataCon
                -> [Type]                -- Types to instantiate the universally quantified tyvars
-               -> ([TyVar], [Id])       -- Return instantiated variables
+               -> ([TyCoVar], [Id])     -- Return instantiated variables
 -- dataConInstPat arg_fun fss us con inst_tys returns a tuple
 -- (ex_tvs, arg_ids),
 --
@@ -1922,7 +1922,7 @@ dataConInstPat fss uniqs con inst_tys
     (ex_bndrs, arg_ids)
   where
     univ_tvs = dataConUnivTyVars con
-    ex_tvs   = dataConExTyVars con
+    ex_tvs   = dataConExTyCoVars con
     arg_tys  = dataConRepArgTys con
     arg_strs = dataConRepStrictness con  -- 1-1 with arg_tys
     n_ex = length ex_tvs
@@ -1938,13 +1938,16 @@ dataConInstPat fss uniqs con inst_tys
     (full_subst, ex_bndrs) = mapAccumL mk_ex_var univ_subst
                                        (zip3 ex_tvs ex_fss ex_uniqs)
 
-    mk_ex_var :: TCvSubst -> (TyVar, FastString, Unique) -> (TCvSubst, TyVar)
-    mk_ex_var subst (tv, fs, uniq) = (Type.extendTvSubstWithClone subst tv
+    mk_ex_var :: TCvSubst -> (TyCoVar, FastString, Unique) -> (TCvSubst, TyCoVar)
+    mk_ex_var subst (tv, fs, uniq) = (Type.extendTCvSubstWithClone subst tv
                                        new_tv
                                      , new_tv)
       where
-        new_tv = mkTyVar (mkSysTvName uniq fs) kind
-        kind   = Type.substTyUnchecked subst (tyVarKind tv)
+        new_tv | isTyVar tv
+               = mkTyVar (mkSysTvName uniq fs) kind
+               | otherwise
+               = mkCoVar (mkSystemVarName uniq fs) kind
+        kind   = Type.substTyUnchecked subst (varType tv)
 
       -- Make value vars, instantiating types
     arg_ids = zipWith4 mk_id_var id_uniqs id_fss arg_tys arg_strs
index fdece6e..5856ff2 100644 (file)
@@ -203,7 +203,7 @@ dsFCall :: Id -> Coercion -> ForeignCall -> Maybe Header
 dsFCall fn_id co fcall mDeclHeader = do
     let
         ty                   = pFst $ coercionKind co
-        (tv_bndrs, rho)      = tcSplitForAllTyVarBndrs ty
+        (tv_bndrs, rho)      = tcSplitForAllVarBndrs ty
         (arg_tys, io_res_ty) = tcSplitFunTys rho
 
     args <- newSysLocalsDs arg_tys  -- no FFI levity-polymorphism
index 49586bc..af54234 100644 (file)
@@ -120,7 +120,10 @@ matchOneConLike :: [Id]
                 -> [EquationInfo]
                 -> DsM (CaseAlt ConLike)
 matchOneConLike vars ty (eqn1 : eqns)   -- All eqns for a single constructor
-  = do  { let inst_tys = ASSERT( tvs1 `equalLength` ex_tvs )
+  = do  { let inst_tys = ASSERT( all tcIsTcTyVar ex_tvs )
+                           -- ex_tvs can only be tyvars as data types in source
+                           -- Haskell cannot mention covar yet (Aug 2018).
+                         ASSERT( tvs1 `equalLength` ex_tvs )
                          arg_tys ++ mkTyVarTys tvs1
 
               val_arg_tys = conLikeInstOrigArgTys con1 inst_tys
@@ -169,7 +172,7 @@ matchOneConLike vars ty (eqn1 : eqns)   -- All eqns for a single constructor
               = firstPat eqn1
     fields1 = map flSelector (conLikeFieldLabels con1)
 
-    ex_tvs = conLikeExTyVars con1
+    ex_tvs = conLikeExTyCoVars con1
 
     -- Choose the right arg_vars in the right order for this group
     -- Note [Record patterns]
index e2c76c4..18feeb5 100644 (file)
@@ -712,7 +712,7 @@ cvObtainTerm hsc_env max_depth force old_ty hval = runTR hsc_env $ do
                   -- MutVar# :: contents_ty -> MutVar# s contents_ty
          traceTR (text "Following a MutVar")
          contents_tv <- newVar liftedTypeKind
-         ASSERT(isUnliftedType my_ty) return ()
+         MASSERT(isUnliftedType my_ty)
          (mutvar_ty,_) <- instScheme $ quantifyType $ mkFunTy
                             contents_ty (mkTyConApp tycon [world,contents_ty])
          addConstraint (mkFunTy contents_tv my_ty) mutvar_ty
@@ -1002,6 +1002,9 @@ getDataConArgTys dc con_app_ty
   = do { let rep_con_app_ty = unwrapType con_app_ty
        ; traceTR (text "getDataConArgTys 1" <+> (ppr con_app_ty $$ ppr rep_con_app_ty
                    $$ ppr (tcSplitTyConApp_maybe rep_con_app_ty)))
+       ; ASSERT( all isTyVar ex_tvs ) return ()
+                 -- ex_tvs can only be tyvars as data types in source
+                 -- Haskell cannot mention covar yet (Aug 2018)
        ; (subst, _) <- instTyVars (univ_tvs ++ ex_tvs)
        ; addConstraint rep_con_app_ty (substTy subst (dataConOrigResTy dc))
               -- See Note [Constructor arg types]
@@ -1010,7 +1013,7 @@ getDataConArgTys dc con_app_ty
        ; return con_arg_tys }
   where
     univ_tvs = dataConUnivTyVars dc
-    ex_tvs   = dataConExTyVars dc
+    ex_tvs   = dataConExTyCoVars dc
 
 {- Note [Constructor arg types]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
index 3ddd355..693e289 100644 (file)
@@ -101,7 +101,7 @@ buildDataCon :: FamInstEnvs
                 -- See Note [Bangs on imported data constructors] in MkId
            -> [FieldLabel]             -- Field labels
            -> [TyVar]                  -- Universals
-           -> [TyVar]                  -- Existentials
+           -> [TyCoVar]                -- Existentials
            -> [TyVarBinder]            -- User-written 'TyVarBinder's
            -> [EqSpec]                 -- Equality spec
            -> KnotTied ThetaType       -- Does not include the "stupid theta"
index 2784dda..3266c5a 100644 (file)
@@ -64,7 +64,7 @@ import SrcLoc
 import Fingerprint
 import Binary
 import BooleanFormula ( BooleanFormula, pprBooleanFormula, isTrue )
-import Var( TyVarBndr(..) )
+import Var( VarBndr(..) )
 import TyCon ( Role (..), Injectivity(..) )
 import Util( dropList, filterByList )
 import DataCon (SrcStrictness(..), SrcUnpackedness(..))
@@ -243,13 +243,13 @@ data IfaceConDecl
         -- but it's not so easy for the original TyCon/DataCon
         -- So this guarantee holds for IfaceConDecl, but *not* for DataCon
 
-        ifConExTvs   :: [IfaceTvBndr],  -- Existential tyvars
+        ifConExTCvs   :: [IfaceBndr],  -- Existential ty/covars
         ifConUserTvBinders :: [IfaceForAllBndr],
           -- The tyvars, in the order the user wrote them
           -- INVARIANT: the set of tyvars in ifConUserTvBinders is exactly the
-          --            set of ifConExTvs, unioned with the set of ifBinders
-          --            (from the parent IfaceDecl) whose tyvars do not appear
-          --            in ifConEqSpec
+          --            set of tyvars (*not* covars) of ifConExTCvs, unioned
+          --            with the set of ifBinders (from the parent IfaceDecl)
+          --            whose tyvars do not appear in ifConEqSpec
           -- See Note [DataCon user type variable binders] in DataCon
         ifConEqSpec  :: IfaceEqSpec,        -- Equality constraints
         ifConCtxt    :: IfaceContext,       -- Non-stupid context
@@ -1062,8 +1062,11 @@ pprIfaceConDecl ss gadt_style tycon tc_binders parent
     ppr_tc_app gadt_subst dflags
        = pprPrefixIfDeclBndr how_much (occName tycon)
          <+> sep [ pprParendIfaceType (substIfaceTyVar gadt_subst tv)
-                 | (tv,_kind)
-                     <- map ifTyConBinderTyVar $
+                 | IfaceTvBndr (tv,_kind)
+                   -- Coercions variables are invisible, see Note
+                   -- [VarBndrs, TyCoVarBinders, TyConBinders, and visibility]
+                   -- in TyCoRep
+                     <- map (ifTyConBinderVar) $
                         suppressIfaceInvisibles dflags tc_binders tc_binders ]
 
 instance Outputable IfaceRule where
@@ -1290,7 +1293,7 @@ freeNamesIfDecl (IfaceId { ifType = t, ifIdDetails = d, ifIdInfo = i})
 
 freeNamesIfDecl (IfaceData { ifBinders = bndrs, ifResKind = res_k
                            , ifParent = p, ifCtxt = ctxt, ifCons = cons })
-  = freeNamesIfTyVarBndrs bndrs &&&
+  = freeNamesIfVarBndrs bndrs &&&
     freeNamesIfType res_k &&&
     freeNamesIfaceTyConParent p &&&
     freeNamesIfContext ctxt &&&
@@ -1298,18 +1301,18 @@ freeNamesIfDecl (IfaceData { ifBinders = bndrs, ifResKind = res_k
 
 freeNamesIfDecl (IfaceSynonym { ifBinders = bndrs, ifResKind = res_k
                               , ifSynRhs = rhs })
-  = freeNamesIfTyVarBndrs bndrs &&&
+  = freeNamesIfVarBndrs bndrs &&&
     freeNamesIfKind res_k &&&
     freeNamesIfType rhs
 
 freeNamesIfDecl (IfaceFamily { ifBinders = bndrs, ifResKind = res_k
                              , ifFamFlav = flav })
-  = freeNamesIfTyVarBndrs bndrs &&&
+  = freeNamesIfVarBndrs bndrs &&&
     freeNamesIfKind res_k &&&
     freeNamesIfFamFlav flav
 
 freeNamesIfDecl (IfaceClass{ ifBinders = bndrs, ifBody = cls_body })
-  = freeNamesIfTyVarBndrs bndrs &&&
+  = freeNamesIfVarBndrs bndrs &&&
     freeNamesIfClassBody cls_body
 
 freeNamesIfDecl (IfaceAxiom { ifTyCon = tc, ifAxBranches = branches })
@@ -1327,8 +1330,8 @@ freeNamesIfDecl (IfacePatSyn { ifPatMatcher = (matcher, _)
                              , ifFieldLabels = lbls })
   = unitNameSet matcher &&&
     maybe emptyNameSet (unitNameSet . fst) mb_builder &&&
-    freeNamesIfTyVarBndrs univ_bndrs &&&
-    freeNamesIfTyVarBndrs ex_bndrs &&&
+    freeNamesIfVarBndrs univ_bndrs &&&
+    freeNamesIfVarBndrs ex_bndrs &&&
     freeNamesIfContext prov_ctxt &&&
     freeNamesIfContext req_ctxt &&&
     fnList freeNamesIfType args &&&
@@ -1391,12 +1394,12 @@ freeNamesIfConDecls (IfNewTyCon  c) = freeNamesIfConDecl c
 freeNamesIfConDecls _                   = emptyNameSet
 
 freeNamesIfConDecl :: IfaceConDecl -> NameSet
-freeNamesIfConDecl (IfCon { ifConExTvs   = ex_tvs, ifConCtxt = ctxt
+freeNamesIfConDecl (IfCon { ifConExTCvs  = ex_tvs, ifConCtxt = ctxt
                           , ifConArgTys  = arg_tys
                           , ifConFields  = flds
                           , ifConEqSpec  = eq_spec
                           , ifConStricts = bangs })
-  = fnList freeNamesIfTvBndr ex_tvs &&&
+  = fnList freeNamesIfBndr ex_tvs &&&
     freeNamesIfContext ctxt &&&
     fnList freeNamesIfType arg_tys &&&
     mkNameSet (map flSelector flds) &&&
@@ -1422,7 +1425,7 @@ freeNamesIfType (IfaceAppTy s t)      = freeNamesIfType s &&& freeNamesIfAppArgs
 freeNamesIfType (IfaceTyConApp tc ts) = freeNamesIfTc tc &&& freeNamesIfAppArgs ts
 freeNamesIfType (IfaceTupleTy _ _ ts) = freeNamesIfAppArgs ts
 freeNamesIfType (IfaceLitTy _)        = emptyNameSet
-freeNamesIfType (IfaceForAllTy tv t)  = freeNamesIfTyVarBndr tv &&& freeNamesIfType t
+freeNamesIfType (IfaceForAllTy tv t)  = freeNamesIfVarBndr tv &&& freeNamesIfType t
 freeNamesIfType (IfaceFunTy s t)      = freeNamesIfType s &&& freeNamesIfType t
 freeNamesIfType (IfaceDFunTy s t)     = freeNamesIfType s &&& freeNamesIfType t
 freeNamesIfType (IfaceCastTy t c)     = freeNamesIfType t &&& freeNamesIfCoercion c
@@ -1475,11 +1478,11 @@ freeNamesIfProv (IfacePhantomProv co)    = freeNamesIfCoercion co
 freeNamesIfProv (IfaceProofIrrelProv co) = freeNamesIfCoercion co
 freeNamesIfProv (IfacePluginProv _)      = emptyNameSet
 
-freeNamesIfTyVarBndr :: TyVarBndr IfaceTvBndr vis -> NameSet
-freeNamesIfTyVarBndr (TvBndr tv _) = freeNamesIfTvBndr tv
+freeNamesIfVarBndr :: VarBndr IfaceBndr vis -> NameSet
+freeNamesIfVarBndr (Bndr bndr _) = freeNamesIfBndr bndr
 
-freeNamesIfTyVarBndrs :: [TyVarBndr IfaceTvBndr vis] -> NameSet
-freeNamesIfTyVarBndrs = fnList freeNamesIfTyVarBndr
+freeNamesIfVarBndrs :: [VarBndr IfaceBndr vis] -> NameSet
+freeNamesIfVarBndrs = fnList freeNamesIfVarBndr
 
 freeNamesIfBndr :: IfaceBndr -> NameSet
 freeNamesIfBndr (IfaceIdBndr b) = freeNamesIfIdBndr b
index 06ea8ff..23b09da 100644 (file)
@@ -22,8 +22,8 @@ module IfaceType (
         IfaceTvBndr, IfaceIdBndr, IfaceTyConBinder,
         IfaceForAllBndr, ArgFlag(..), ShowForAllFlag(..),
 
-        ifForAllBndrTyVar, ifForAllBndrName,
-        ifTyConBinderTyVar, ifTyConBinderName,
+        ifForAllBndrVar, ifForAllBndrName,
+        ifTyConBinderVar, ifTyConBinderName,
 
         -- Equality testing
         isIfaceLiftedTypeKind,
@@ -96,6 +96,13 @@ type IfaceTvBndr  = (IfLclName, IfaceKind)
 ifaceTvBndrName :: IfaceTvBndr -> IfLclName
 ifaceTvBndrName (n,_) = n
 
+ifaceIdBndrName :: IfaceIdBndr -> IfLclName
+ifaceIdBndrName (n,_) = n
+
+ifaceBndrName :: IfaceBndr -> IfLclName
+ifaceBndrName (IfaceTvBndr bndr) = ifaceTvBndrName bndr
+ifaceBndrName (IfaceIdBndr bndr) = ifaceIdBndrName bndr
+
 type IfaceLamBndr = (IfaceBndr, IfaceOneShot)
 
 data IfaceOneShot    -- See Note [Preserve OneShotInfo] in CoreTicy
@@ -148,8 +155,8 @@ data IfaceTyLit
   | IfaceStrTyLit FastString
   deriving (Eq)
 
-type IfaceTyConBinder = TyVarBndr IfaceTvBndr TyConBndrVis
-type IfaceForAllBndr  = TyVarBndr IfaceTvBndr ArgFlag
+type IfaceTyConBinder = VarBndr IfaceBndr TyConBndrVis
+type IfaceForAllBndr  = VarBndr IfaceBndr ArgFlag
 
 -- See Note [Suppressing invisible arguments]
 -- We use a new list type (rather than [(IfaceType,Bool)], because
@@ -297,7 +304,7 @@ data IfaceCoercion
   | IfaceFunCo        Role IfaceCoercion IfaceCoercion
   | IfaceTyConAppCo   Role IfaceTyCon [IfaceCoercion]
   | IfaceAppCo        IfaceCoercion IfaceCoercion
-  | IfaceForAllCo     IfaceTvBndr IfaceCoercion IfaceCoercion
+  | IfaceForAllCo     IfaceBndr IfaceCoercion IfaceCoercion
   | IfaceCoVarCo      IfLclName
   | IfaceAxiomInstCo  IfExtName BranchIndex [IfaceCoercion]
   | IfaceAxiomRuleCo  IfLclName [IfaceCoercion]
@@ -398,21 +405,21 @@ stripIfaceInvisVars dflags tyvars
   | gopt Opt_PrintExplicitKinds dflags = tyvars
   | otherwise = filterOut isInvisibleTyConBinder tyvars
 
--- | Extract an 'IfaceTvBndr' from an 'IfaceForAllBndr'.
-ifForAllBndrTyVar :: IfaceForAllBndr -> IfaceTvBndr
-ifForAllBndrTyVar = binderVar
+-- | Extract an 'IfaceBndr' from an 'IfaceForAllBndr'.
+ifForAllBndrVar :: IfaceForAllBndr -> IfaceBndr
+ifForAllBndrVar = binderVar
 
 -- | Extract the variable name from an 'IfaceForAllBndr'.
 ifForAllBndrName :: IfaceForAllBndr -> IfLclName
-ifForAllBndrName fab = ifaceTvBndrName (ifForAllBndrTyVar fab)
+ifForAllBndrName fab = ifaceBndrName (ifForAllBndrVar fab)
 
--- | Extract an 'IfaceTvBndr' from an 'IfaceTyConBinder'.
-ifTyConBinderTyVar :: IfaceTyConBinder -> IfaceTvBndr
-ifTyConBinderTyVar = binderVar
+-- | Extract an 'IfaceBndr' from an 'IfaceTyConBinder'.
+ifTyConBinderVar :: IfaceTyConBinder -> IfaceBndr
+ifTyConBinderVar = binderVar
 
 -- | Extract the variable name from an 'IfaceTyConBinder'.
 ifTyConBinderName :: IfaceTyConBinder -> IfLclName
-ifTyConBinderName tcb = ifaceTvBndrName (ifTyConBinderTyVar tcb)
+ifTyConBinderName tcb = ifaceBndrName (ifTyConBinderVar tcb)
 
 ifTypeIsVarFree :: IfaceType -> Bool
 -- Returns True if the type definitely has no variables at all
@@ -532,8 +539,8 @@ stripInvisArgs dflags tys
             IA_Vis   t ts -> IA_Vis t $ suppress_invis ts
               -- Keep recursing through the remainder of the arguments, as it's
               -- possible that there are remaining invisible ones.
-              -- See the "In type declarations" section of Note [TyVarBndrs,
-              -- TyVarBinders, TyConBinders, and visibility] in TyCoRep.
+              -- See the "In type declarations" section of Note [VarBndrs,
+              -- TyCoVarBinders, TyConBinders, and visibility] in TyCoRep.
 
 appArgsIfaceTypes :: IfaceAppArgs -> [IfaceType]
 appArgsIfaceTypes IA_Nil = []
@@ -660,9 +667,10 @@ pprIfaceTvBndr use_parens (tv, ki)
                  | otherwise  = id
 
 pprIfaceTyConBinders :: [IfaceTyConBinder] -> SDoc
-pprIfaceTyConBinders = sep . map go
+pprIfaceTyConBinders = sep . map (go . ifTyConBinderVar)
   where
-    go tcb = pprIfaceTvBndr True (ifTyConBinderTyVar tcb)
+    go (IfaceIdBndr bndr) = pprIfaceIdBndr bndr
+    go (IfaceTvBndr bndr) = pprIfaceTvBndr True bndr
 
 instance Binary IfaceBndr where
     put_ bh (IfaceIdBndr aa) = do
@@ -756,7 +764,7 @@ ppr_ty ctxt_prec (IfaceCoercionTy co)
       (ppr_co ctxt_prec co)
       (text "<>")
 
-ppr_ty ctxt_prec ty
+ppr_ty ctxt_prec ty -- IfaceForAllTy
   = maybeParen ctxt_prec funPrec (pprIfaceSigmaType ShowForAllMust ty)
 
 {-
@@ -804,18 +812,15 @@ defaultRuntimeRepVars :: PprStyle -> IfaceType -> IfaceType
 defaultRuntimeRepVars sty = go emptyFsEnv
   where
     go :: FastStringEnv () -> IfaceType -> IfaceType
-    go subs (IfaceForAllTy bndr ty)
+    go subs (IfaceForAllTy (Bndr (IfaceTvBndr (var, var_kind)) argf) ty)
       | isRuntimeRep var_kind
-      , isInvisibleArgFlag (binderArgFlag bndr) -- don't default *visible* quantification
-                                                -- or we get the mess in #13963
+      , isInvisibleArgFlag argf -- don't default *visible* quantification
+                                -- or we get the mess in #13963
       = let subs' = extendFsEnv subs var ()
         in go subs' ty
-      | otherwise
-      = IfaceForAllTy (TvBndr (var, go subs var_kind) (binderArgFlag bndr))
-                      (go subs ty)
-      where
-        var :: IfLclName
-        (var, var_kind) = binderVar bndr
+
+    go subs (IfaceForAllTy bndr ty)
+      = IfaceForAllTy (go_ifacebndr subs bndr) (go subs ty)
 
     go subs ty@(IfaceTyVar tv)
       | tv `elemFsEnv` subs
@@ -851,6 +856,12 @@ defaultRuntimeRepVars sty = go emptyFsEnv
     go _ ty@(IfaceLitTy {}) = ty
     go _ ty@(IfaceCoercionTy {}) = ty
 
+    go_ifacebndr :: FastStringEnv () -> IfaceForAllBndr -> IfaceForAllBndr
+    go_ifacebndr subs (Bndr (IfaceIdBndr (n, t)) argf)
+      = Bndr (IfaceIdBndr (n, go subs t)) argf
+    go_ifacebndr subs (Bndr (IfaceTvBndr (n, t)) argf)
+      = Bndr (IfaceTvBndr (n, go subs t)) argf
+
     go_args :: FastStringEnv () -> IfaceAppArgs -> IfaceAppArgs
     go_args _ IA_Nil = IA_Nil
     go_args subs (IA_Vis ty args)   = IA_Vis   (go subs ty) (go_args subs args)
@@ -917,7 +928,7 @@ ppr_iface_forall_part show_forall tvs ctxt sdoc
 -- | Render the "forall ... ." or "forall ... ->" bit of a type.
 pprIfaceForAll :: [IfaceForAllBndr] -> SDoc
 pprIfaceForAll [] = empty
-pprIfaceForAll bndrs@(TvBndr _ vis : _)
+pprIfaceForAll bndrs@(Bndr _ vis : _)
   = add_separator (forAllLit <+> doc) <+> pprIfaceForAll bndrs'
   where
     (bndrs', doc) = ppr_itv_bndrs bndrs vis
@@ -933,7 +944,7 @@ pprIfaceForAll bndrs@(TvBndr _ vis : _)
 ppr_itv_bndrs :: [IfaceForAllBndr]
              -> ArgFlag  -- ^ visibility of the first binder in the list
              -> ([IfaceForAllBndr], SDoc)
-ppr_itv_bndrs all_bndrs@(bndr@(TvBndr _ vis) : bndrs) vis1
+ppr_itv_bndrs all_bndrs@(bndr@(Bndr _ vis) : bndrs) vis1
   | vis `sameVis` vis1 = let (bndrs', doc) = ppr_itv_bndrs bndrs vis1 in
                          (bndrs', pprIfaceForAllBndr bndr <+> doc)
   | otherwise   = (all_bndrs, empty)
@@ -947,11 +958,13 @@ pprIfaceForAllCoBndrs :: [(IfLclName, IfaceCoercion)] -> SDoc
 pprIfaceForAllCoBndrs bndrs = hsep $ map pprIfaceForAllCoBndr bndrs
 
 pprIfaceForAllBndr :: IfaceForAllBndr -> SDoc
-pprIfaceForAllBndr (TvBndr tv Inferred) = sdocWithDynFlags $ \dflags ->
-                                           if gopt Opt_PrintExplicitForalls dflags
-                                           then braces $ pprIfaceTvBndr False tv
-                                           else pprIfaceTvBndr True tv
-pprIfaceForAllBndr (TvBndr tv _)        = pprIfaceTvBndr True tv
+pprIfaceForAllBndr (Bndr (IfaceTvBndr tv) Inferred)
+  = sdocWithDynFlags $ \dflags ->
+                          if gopt Opt_PrintExplicitForalls dflags
+                          then braces $ pprIfaceTvBndr False tv
+                          else pprIfaceTvBndr True tv
+pprIfaceForAllBndr (Bndr (IfaceTvBndr tv) _)  = pprIfaceTvBndr True tv
+pprIfaceForAllBndr (Bndr (IfaceIdBndr idv) _) = pprIfaceIdBndr idv
 
 pprIfaceForAllCoBndr :: (IfLclName, IfaceCoercion) -> SDoc
 pprIfaceForAllCoBndr (tv, kind_co)
@@ -981,7 +994,10 @@ pprUserIfaceForAll tvs
              || gopt Opt_PrintExplicitForalls dflags) $
      pprIfaceForAll tvs
    where
-     tv_has_kind_var (TvBndr (_,kind) _) = not (ifTypeIsVarFree kind)
+     tv_has_kind_var (Bndr (IfaceTvBndr (_,kind)) _)
+       = not (ifTypeIsVarFree kind)
+     tv_has_kind_var _ = False
+
      tv_is_required = isVisibleArgFlag . binderArgFlag
 
 {-
@@ -1012,8 +1028,10 @@ criteria are met:
    because omitting it and printing "T :: k -> Type" would be
    utterly misleading.
 
-   See Note [TyVarBndrs, TyVarBinders, TyConBinders, and visibility]
+   See Note [VarBndrs, TyCoVarBinders, TyConBinders, and visibility]
    in TyCoRep.
+
+N.B. Until now (Aug 2018) we didn't check anything for coercion variables.
 -}
 
 -------------------
@@ -1108,7 +1126,7 @@ pprTyTcApp' ctxt_prec tc tys dflags style
 -- of   eqTyCon          (~)
 --      eqPrimTyCon      (~#)
 --      eqReprPrimTyCon  (~R#)
---      hEqTyCon         (~~)
+--      heqTyCon         (~~)
 --
 -- See Note [Equality predicates in IfaceType]
 -- and Note [The equality types story] in TysPrim
@@ -1280,7 +1298,9 @@ ppr_co ctxt_prec co@(IfaceForAllCo {})
   where
     (tvs, inner_co) = split_co co
 
-    split_co (IfaceForAllCo (name, _) kind_co co')
+    split_co (IfaceForAllCo (IfaceTvBndr (name, _)) kind_co co')
+      = let (tvs, co'') = split_co co' in ((name,kind_co):tvs,co'')
+    split_co (IfaceForAllCo (IfaceIdBndr (name, _)) kind_co co')
       = let (tvs, co'') = split_co co' in ((name,kind_co):tvs,co'')
     split_co co' = ([], co')
 
index 200e96c..44f1f3c 100644 (file)
@@ -3,16 +3,13 @@
 module IfaceType( IfaceType, IfaceTyCon, IfaceForAllBndr
                 , IfaceCoercion, IfaceTyLit, IfaceAppArgs ) where
 
-import Var (TyVarBndr, ArgFlag)
-import FastString (FastString)
+import Var (VarBndr, ArgFlag)
 
 data IfaceAppArgs
-type IfLclName = FastString
-type IfaceKind = IfaceType
 
 data IfaceType
 data IfaceTyCon
 data IfaceTyLit
 data IfaceCoercion
-type IfaceTvBndr      = (IfLclName, IfaceKind)
-type IfaceForAllBndr  = TyVarBndr IfaceTvBndr ArgFlag
+data IfaceBndr
+type IfaceForAllBndr  = VarBndr IfaceBndr ArgFlag
index 59a396e..4d2fa83 100644 (file)
@@ -1646,7 +1646,7 @@ coAxBranchToIfaceBranch' tc (CoAxBranch { cab_tvs = tvs, cab_cvs = cvs
                   , ifaxbRHS     = tidyToIfaceType env1 rhs
                   , ifaxbIncomps = [] }
   where
-    (env1, tidy_tvs) = tidyTyCoVarBndrs emptyTidyEnv tvs
+    (env1, tidy_tvs) = tidyVarBndrs emptyTidyEnv tvs
     -- Don't re-bind in-scope tyvars
     -- See Note [CoAxBranch type variables] in CoAxiom
 
@@ -1710,7 +1710,7 @@ tyConToIfaceDecl env tycon
     -- an error.
     (tc_env1, tc_binders) = tidyTyConBinders env (tyConBinders tycon)
     tc_tyvars      = binderVars tc_binders
-    if_binders     = toIfaceTyVarBinders tc_binders
+    if_binders     = toIfaceTyCoVarBinders tc_binders
     if_res_kind    = tidyToIfaceType tc_env1 (tyConResKind tycon)
     if_syn_type ty = tidyToIfaceType tc_env1 ty
     if_res_var     = getOccFS `fmap` tyConFamilyResVar_maybe tycon
@@ -1751,7 +1751,7 @@ tyConToIfaceDecl env tycon
         = IfCon   { ifConName    = dataConName data_con,
                     ifConInfix   = dataConIsInfix data_con,
                     ifConWrapper = isJust (dataConWrapId_maybe data_con),
-                    ifConExTvs   = map toIfaceTvBndr ex_tvs',
+                    ifConExTCvs  = map toIfaceBndr ex_tvs',
                     ifConUserTvBinders = map toIfaceForAllBndr user_bndrs',
                     ifConEqSpec  = map (to_eq_spec . eqSpecPair) eq_spec,
                     ifConCtxt    = tidyToIfaceContext con_env2 theta,
@@ -1776,27 +1776,27 @@ tyConToIfaceDecl env tycon
           con_env1 = (fst tc_env1, mkVarEnv (zipEqual "ifaceConDecl" univ_tvs tc_tyvars))
                      -- A bit grimy, perhaps, but it's simple!
 
-          (con_env2, ex_tvs') = tidyTyCoVarBndrs con_env1 ex_tvs
-          user_bndrs' = map (tidyUserTyVarBinder con_env2) user_bndrs
+          (con_env2, ex_tvs') = tidyVarBndrs con_env1 ex_tvs
+          user_bndrs' = map (tidyUserTyCoVarBinder con_env2) user_bndrs
           to_eq_spec (tv,ty) = (tidyTyVar con_env2 tv, tidyToIfaceType con_env2 ty)
 
           -- By this point, we have tidied every universal and existential
-          -- tyvar. Because of the dcUserTyVarBinders invariant
+          -- tyvar. Because of the dcUserTyCoVarBinders invariant
           -- (see Note [DataCon user type variable binders]), *every*
           -- user-written tyvar must be contained in the substitution that
           -- tidying produced. Therefore, tidying the user-written tyvars is a
           -- simple matter of looking up each variable in the substitution,
-          -- which tidyTyVarOcc accomplishes.
-          tidyUserTyVarBinder :: TidyEnv -> TyVarBinder -> TyVarBinder
-          tidyUserTyVarBinder env (TvBndr tv vis) =
-            TvBndr (tidyTyVarOcc env tv) vis
+          -- which tidyTyCoVarOcc accomplishes.
+          tidyUserTyCoVarBinder :: TidyEnv -> TyCoVarBinder -> TyCoVarBinder
+          tidyUserTyCoVarBinder env (Bndr tv vis) =
+            Bndr (tidyTyCoVarOcc env tv) vis
 
 classToIfaceDecl :: TidyEnv -> Class -> (TidyEnv, IfaceDecl)
 classToIfaceDecl env clas
   = ( env1
     , IfaceClass { ifName   = getName tycon,
                    ifRoles  = tyConRoles (classTyCon clas),
-                   ifBinders = toIfaceTyVarBinders tc_binders,
+                   ifBinders = toIfaceTyCoVarBinders tc_binders,
                    ifBody   = body,
                    ifFDs    = map toIfaceFD clas_fds })
   where
@@ -1848,10 +1848,10 @@ tidyTyConBinder :: TidyEnv -> TyConBinder -> (TidyEnv, TyConBinder)
 -- If the type variable "binder" is in scope, don't re-bind it
 -- In a class decl, for example, the ATD binders mention
 -- (amd must mention) the class tyvars
-tidyTyConBinder env@(_, subst) tvb@(TvBndr tv vis)
+tidyTyConBinder env@(_, subst) tvb@(Bndr tv vis)
  = case lookupVarEnv subst tv of
-     Just tv' -> (env,  TvBndr tv' vis)
-     Nothing  -> tidyTyVarBinder env tvb
+     Just tv' -> (env,  Bndr tv' vis)
+     Nothing  -> tidyTyCoVarBinder env tvb
 
 tidyTyConBinders :: TidyEnv -> [TyConBinder] -> (TidyEnv, [TyConBinder])
 tidyTyConBinders = mapAccumL tidyTyConBinder
index 0dc3fb5..248f7d3 100644 (file)
@@ -861,7 +861,7 @@ tc_ax_branch prev_branches
                             , ifaxbLHS = lhs, ifaxbRHS = rhs
                             , ifaxbRoles = roles, ifaxbIncomps = incomps })
   = bindIfaceTyConBinders_AT
-      (map (\b -> TvBndr b (NamedTCB Inferred)) tv_bndrs) $ \ tvs ->
+      (map (\b -> Bndr (IfaceTvBndr b) (NamedTCB Inferred)) tv_bndrs) $ \ tvs ->
          -- The _AT variant is needed here; see Note [CoAxBranch type variables] in CoAxiom
     bindIfaceIds cv_bndrs $ \ cvs -> do
     { tc_lhs <- tcIfaceAppArgs lhs
@@ -891,7 +891,7 @@ tcIfaceDataCons tycon_name tycon tc_tybinders if_cons
     tag_map = mkTyConTagMap tycon
 
     tc_con_decl (IfCon { ifConInfix = is_infix,
-                         ifConExTvs = ex_bndrs,
+                         ifConExTCvs = ex_bndrs,
                          ifConUserTvBinders = user_bndrs,
                          ifConName = dc_name,
                          ifConCtxt = ctxt, ifConEqSpec = spec,
@@ -900,7 +900,7 @@ tcIfaceDataCons tycon_name tycon tc_tybinders if_cons
                          ifConSrcStricts = if_src_stricts})
      = -- Universally-quantified tyvars are shared with
        -- parent TyCon, and are already in scope
-       bindIfaceTyVars ex_bndrs    $ \ ex_tvs -> do
+       bindIfaceBndrs ex_bndrs    $ \ ex_tvs -> do
         { traceIf (text "Start interface-file tc_con_decl" <+> ppr dc_name)
 
           -- By this point, we have bound every universal and existential
@@ -909,8 +909,12 @@ tcIfaceDataCons tycon_name tycon tc_tybinders if_cons
           -- ifConUserTvBinders has a matching counterpart somewhere in the
           -- bound universals/existentials. As a result, calling tcIfaceTyVar
           -- below is always guaranteed to succeed.
-        ; user_tv_bndrs <- mapM (\(TvBndr (name, _) vis) ->
-                                    TvBndr <$> tcIfaceTyVar name <*> pure vis)
+        ; user_tv_bndrs <- mapM (\(Bndr bd vis) ->
+                                   case bd of
+                                     IfaceIdBndr (name, _) ->
+                                       Bndr <$> tcIfaceLclId name <*> pure vis
+                                     IfaceTvBndr (name, _) ->
+                                       Bndr <$> tcIfaceTyVar name <*> pure vis)
                                 user_bndrs
 
         -- Read the context and argument types, but lazily for two reasons
@@ -936,7 +940,7 @@ tcIfaceDataCons tycon_name tycon tc_tybinders if_cons
 
         -- Remember, tycon is the representation tycon
         ; let orig_res_ty = mkFamilyTyConApp tycon
-                                (substTyVars (mkTvSubstPrs (map eqSpecPair eq_spec))
+                              (substTyCoVars (mkTvSubstPrs (map eqSpecPair eq_spec))
                                              (binderVars tc_tybinders))
 
         ; prom_rep_name <- newTyConRepName dc_name
@@ -1145,7 +1149,7 @@ tcIfaceType = go
            ; return (mkTyConApp tc' tks') }
     go (IfaceForAllTy bndr t)
       = bindIfaceForAllBndr bndr $ \ tv' vis ->
-        ForAllTy (TvBndr tv' vis) <$> go t
+        ForAllTy (Bndr tv' vis) <$> go t
     go (IfaceCastTy ty co)   = CastTy <$> go ty <*> tcIfaceCo co
     go (IfaceCoercionTy co)  = CoercionTy <$> tcIfaceCo co
 
@@ -1211,7 +1215,7 @@ tcIfaceCo = go
       = TyConAppCo r <$> tcIfaceTyCon tc <*> mapM go cs
     go (IfaceAppCo c1 c2)        = AppCo <$> go c1 <*> go c2
     go (IfaceForAllCo tv k c)  = do { k' <- go k
-                                      ; bindIfaceTyVar tv $ \ tv' ->
+                                      ; bindIfaceBndr tv $ \ tv' ->
                                         ForAllCo tv' k' <$> go c }
     go (IfaceCoVarCo n)          = CoVarCo <$> go_var n
     go (IfaceAxiomInstCo n i cs) = AxiomInstCo <$> tcIfaceCoAxiom n <*> pure i <*> mapM go cs
@@ -1745,23 +1749,18 @@ bindIfaceBndrs (b:bs) thing_inside
     thing_inside (b':bs')
 
 -----------------------
-bindIfaceForAllBndrs :: [IfaceForAllBndr] -> ([TyVarBinder] -> IfL a) -> IfL a
+bindIfaceForAllBndrs :: [IfaceForAllBndr] -> ([TyCoVarBinder] -> IfL a) -> IfL a
 bindIfaceForAllBndrs [] thing_inside = thing_inside []
 bindIfaceForAllBndrs (bndr:bndrs) thing_inside
   = bindIfaceForAllBndr bndr $ \tv vis ->
     bindIfaceForAllBndrs bndrs $ \bndrs' ->
-    thing_inside (mkTyVarBinder vis tv : bndrs')
+    thing_inside (mkTyCoVarBinder vis tv : bndrs')
 
-bindIfaceForAllBndr :: IfaceForAllBndr -> (TyVar -> ArgFlag -> IfL a) -> IfL a
-bindIfaceForAllBndr (TvBndr tv vis) thing_inside
+bindIfaceForAllBndr :: IfaceForAllBndr -> (TyCoVar -> ArgFlag -> IfL a) -> IfL a
+bindIfaceForAllBndr (Bndr (IfaceTvBndr tv) vis) thing_inside
   = bindIfaceTyVar tv $ \tv' -> thing_inside tv' vis
-
-bindIfaceTyVars :: [IfaceTvBndr] -> ([TyVar] -> IfL a) -> IfL a
-bindIfaceTyVars [] thing_inside = thing_inside []
-bindIfaceTyVars (tv:tvs) thing_inside
-  = bindIfaceTyVar tv   $ \tv' ->
-    bindIfaceTyVars tvs $ \tvs' ->
-    thing_inside (tv' : tvs')
+bindIfaceForAllBndr (Bndr (IfaceIdBndr tv) vis) thing_inside
+  = bindIfaceId tv $ \tv' -> thing_inside tv' vis
 
 bindIfaceTyVar :: IfaceTvBndr -> (TyVar -> IfL a) -> IfL a
 bindIfaceTyVar (occ,kind) thing_inside
@@ -1778,8 +1777,8 @@ bindIfaceTyConBinders :: [IfaceTyConBinder]
                       -> ([TyConBinder] -> IfL a) -> IfL a
 bindIfaceTyConBinders [] thing_inside = thing_inside []
 bindIfaceTyConBinders (b:bs) thing_inside
-  = bindIfaceTyConBinderX bindIfaceTyVar b $ \ b'  ->
-    bindIfaceTyConBinders bs               $ \ bs' ->
+  = bindIfaceTyConBinderX bindIfaceBndr b $ \ b'  ->
+    bindIfaceTyConBinders bs              $ \ bs' ->
     thing_inside (b':bs')
 
 bindIfaceTyConBinders_AT :: [IfaceTyConBinder]
@@ -1796,14 +1795,14 @@ bindIfaceTyConBinders_AT (b : bs) thing_inside
     thing_inside (b':bs')
   where
     bind_tv tv thing
-      = do { mb_tv <- lookupIfaceTyVar tv
+      = do { mb_tv <- lookupIfaceVar tv
            ; case mb_tv of
                Just b' -> thing b'
-               Nothing -> bindIfaceTyVar tv thing }
+               Nothing -> bindIfaceBndr tv thing }
 
-bindIfaceTyConBinderX :: (IfaceTvBndr -> (TyVar -> IfL a) -> IfL a)
+bindIfaceTyConBinderX :: (IfaceBndr -> (TyCoVar -> IfL a) -> IfL a)
                       -> IfaceTyConBinder
                       -> (TyConBinder -> IfL a) -> IfL a
-bindIfaceTyConBinderX bind_tv (TvBndr tv vis) thing_inside
+bindIfaceTyConBinderX bind_tv (Bndr tv vis) thing_inside
   = bind_tv tv $ \tv' ->
-    thing_inside (TvBndr tv' vis)
+    thing_inside (Bndr tv' vis)
index 0b0782d..653b740 100644 (file)
@@ -8,7 +8,7 @@ module ToIface
     , toIfaceIdBndr
     , toIfaceBndr
     , toIfaceForAllBndr
-    , toIfaceTyVarBinders
+    , toIfaceTyCoVarBinders
     , toIfaceTyVar
       -- * Types
     , toIfaceType, toIfaceTypeX
@@ -81,23 +81,32 @@ toIfaceTvBndrX fr tyvar = ( occNameFS (getOccName tyvar)
                           , toIfaceTypeX fr (tyVarKind tyvar)
                           )
 
-
-toIfaceIdBndr :: Id -> (IfLclName, IfaceType)
-toIfaceIdBndr id      = (occNameFS (getOccName id),    toIfaceType (idType id))
-
 toIfaceTvBndrs :: [TyVar] -> [IfaceTvBndr]
 toIfaceTvBndrs = map toIfaceTvBndr
 
+toIfaceIdBndr :: Id -> IfaceIdBndr
+toIfaceIdBndr = toIfaceIdBndrX emptyVarSet
+
+toIfaceIdBndrX :: VarSet -> CoVar -> IfaceIdBndr
+toIfaceIdBndrX fr covar = ( occNameFS (getOccName covar)
+                          , toIfaceTypeX fr (varType covar)
+                          )
+
 toIfaceBndr :: Var -> IfaceBndr
 toIfaceBndr var
   | isId var  = IfaceIdBndr (toIfaceIdBndr var)
   | otherwise = IfaceTvBndr (toIfaceTvBndr var)
 
-toIfaceTyVarBinder :: TyVarBndr TyVar vis -> TyVarBndr IfaceTvBndr vis
-toIfaceTyVarBinder (TvBndr tv vis) = TvBndr (toIfaceTvBndr tv) vis
+toIfaceBndrX :: VarSet -> Var -> IfaceBndr
+toIfaceBndrX fr var
+  | isId var  = IfaceIdBndr (toIfaceIdBndrX fr var)
+  | otherwise = IfaceTvBndr (toIfaceTvBndrX fr var)
+
+toIfaceTyCoVarBinder :: VarBndr Var vis -> VarBndr IfaceBndr vis
+toIfaceTyCoVarBinder (Bndr tv vis) = Bndr (toIfaceBndr tv) vis
 
-toIfaceTyVarBinders :: [TyVarBndr TyVar vis] -> [TyVarBndr IfaceTvBndr vis]
-toIfaceTyVarBinders = map toIfaceTyVarBinder
+toIfaceTyCoVarBinders :: [VarBndr Var vis] -> [VarBndr IfaceBndr vis]
+toIfaceTyCoVarBinders = map toIfaceTyCoVarBinder
 
 {-
 ************************************************************************
@@ -168,11 +177,11 @@ toIfaceTyVar = occNameFS . getOccName
 toIfaceCoVar :: CoVar -> FastString
 toIfaceCoVar = occNameFS . getOccName
 
-toIfaceForAllBndr :: TyVarBinder -> IfaceForAllBndr
+toIfaceForAllBndr :: TyCoVarBinder -> IfaceForAllBndr
 toIfaceForAllBndr = toIfaceForAllBndrX emptyVarSet
 
-toIfaceForAllBndrX :: VarSet -> TyVarBinder -> IfaceForAllBndr
-toIfaceForAllBndrX fr (TvBndr v vis) = TvBndr (toIfaceTvBndrX fr v) vis
+toIfaceForAllBndrX :: VarSet -> TyCoVarBinder -> IfaceForAllBndr
+toIfaceForAllBndrX fr (Bndr v vis) = Bndr (toIfaceBndrX fr v) vis
 
 ----------------
 toIfaceTyCon :: TyCon -> IfaceTyCon
@@ -256,7 +265,7 @@ toIfaceCoercionX fr co
       | otherwise                = IfaceTyConAppCo r (toIfaceTyCon tc) (map go cos)
     go (FunCo r co1 co2)   = IfaceFunCo r (go co1) (go co2)
 
-    go (ForAllCo tv k co) = IfaceForAllCo (toIfaceTvBndr tv)
+    go (ForAllCo tv k co) = IfaceForAllCo (toIfaceBndr tv)
                                           (toIfaceCoercionX fr' k)
                                           (toIfaceCoercionX fr' co)
                           where
@@ -295,12 +304,12 @@ toIfaceAppArgsX fr kind ty_args
     go env ty                  ts
       | Just ty' <- coreView ty
       = go env ty' ts
-    go env (ForAllTy (TvBndr tv vis) res) (t:ts)
+    go env (ForAllTy (Bndr tv vis) res) (t:ts)
       | isVisibleArgFlag vis = IA_Vis   t' ts'
       | otherwise            = IA_Invis t' ts'
       where
         t'  = toIfaceTypeX fr t
-        ts' = go (extendTvSubst env tv t) res ts
+        ts' = go (extendTCvSubst env tv t) res ts
 
     go env (FunTy _ res) (t:ts) -- No type-class args in tycon apps
       = IA_Vis (toIfaceTypeX fr t) (go env res ts)
@@ -354,8 +363,8 @@ patSynToIfaceDecl ps
     (_univ_tvs, req_theta, _ex_tvs, prov_theta, args, rhs_ty) = patSynSig ps
     univ_bndrs = patSynUnivTyVarBinders ps
     ex_bndrs   = patSynExTyVarBinders ps
-    (env1, univ_bndrs') = tidyTyVarBinders emptyTidyEnv univ_bndrs
-    (env2, ex_bndrs')   = tidyTyVarBinders env1 ex_bndrs
+    (env1, univ_bndrs') = tidyTyCoVarBinders emptyTidyEnv univ_bndrs
+    (env2, ex_bndrs')   = tidyTyCoVarBinders env1 ex_bndrs
     to_if_pr (id, needs_dummy) = (idName id, needs_dummy)
 
 {-
index 46083f0..e5f57ff 100644 (file)
@@ -3,14 +3,14 @@ module ToIface where
 import {-# SOURCE #-} TyCoRep
 import {-# SOURCE #-} IfaceType( IfaceType, IfaceTyCon, IfaceForAllBndr
                                , IfaceCoercion, IfaceTyLit, IfaceAppArgs )
-import Var ( TyVarBinder )
+import Var ( TyCoVarBinder )
 import TyCon ( TyCon )
 import VarSet( VarSet )
 
 -- For TyCoRep
 toIfaceTypeX :: VarSet -> Type -> IfaceType
 toIfaceTyLit :: TyLit -> IfaceTyLit
-toIfaceForAllBndr :: TyVarBinder -> IfaceForAllBndr
+toIfaceForAllBndr :: TyCoVarBinder -> IfaceForAllBndr
 toIfaceTyCon :: TyCon -> IfaceTyCon
 toIfaceTcArgs :: TyCon -> [Type] -> IfaceAppArgs
 toIfaceCoercionX :: VarSet -> Coercion -> IfaceCoercion
index 30dca25..c5af4a5 100644 (file)
@@ -96,7 +96,7 @@ import {-# SOURCE #-} TysWiredIn
   , doubleElemRepDataConTy
   , mkPromotedListTy )
 
-import Var              ( TyVar, TyVarBndr(TvBndr), mkTyVar )
+import Var              ( TyVar, VarBndr(Bndr), mkTyVar )
 import Name
 import TyCon
 import SrcLoc
@@ -351,8 +351,8 @@ funTyConName = mkPrimTyConName (fsLit "->") funTyConKey funTyCon
 funTyCon :: TyCon
 funTyCon = mkFunTyCon funTyConName tc_bndrs tc_rep_nm
   where
-    tc_bndrs = [ TvBndr runtimeRep1TyVar (NamedTCB Inferred)
-               , TvBndr runtimeRep2TyVar (NamedTCB Inferred)
+    tc_bndrs = [ Bndr runtimeRep1TyVar (NamedTCB Inferred)
+               , Bndr runtimeRep2TyVar (NamedTCB Inferred)
                ]
                ++ mkTemplateAnonTyConBinders [ tYPE runtimeRep1Ty
                                              , tYPE runtimeRep2Ty
@@ -598,7 +598,7 @@ GHC sports a veritable menagerie of equality types:
          class?    L/U                        TyCon
 -----------------------------------------------------------------------------------------
 ~#         T        U      hetero   nominal   eqPrimTyCon      GHC.Prim
-~~         C        L      hetero   nominal   hEqTyCon         GHC.Types
+~~         C        L      hetero   nominal   heqTyCon         GHC.Types
 ~          C        L      homo     nominal   eqTyCon          GHC.Types
 :~:        T        L      homo     nominal   (not built-in)   Data.Type.Equality
 :~~:       T        L      hetero   nominal   (not built-in)   Data.Type.Equality
index 740d0d7..1d47185 100644 (file)
@@ -486,8 +486,8 @@ pcDataCon n univs = pcDataConWithFixity False n univs
 pcDataConWithFixity :: Bool      -- ^ declared infix?
                     -> Name      -- ^ datacon name
                     -> [TyVar]   -- ^ univ tyvars
-                    -> [TyVar]   -- ^ ex tyvars
-                    -> [TyVar]   -- ^ user-written tyvars
+                    -> [TyCoVar] -- ^ ex tycovars
+                    -> [TyCoVar] -- ^ user-written tycovars
                     -> [Type]    -- ^ args
                     -> TyCon
                     -> DataCon
@@ -501,7 +501,7 @@ pcDataConWithFixity infx n = pcDataConWithFixity' infx n (dataConWorkerUnique (n
 -- one DataCon unique per pair of Ints.
 
 pcDataConWithFixity' :: Bool -> Name -> Unique -> RuntimeRepInfo
-                     -> [TyVar] -> [TyVar] -> [TyVar]
+                     -> [TyVar] -> [TyCoVar] -> [TyCoVar]
                      -> [Type] -> TyCon -> DataCon
 -- The Name should be in the DataName name space; it's the name
 -- of the DataCon itself.
@@ -521,7 +521,7 @@ pcDataConWithFixity' declared_infix dc_name wrk_key rri
                 (map (const no_bang) arg_tys)
                 []      -- No labelled fields
                 tyvars ex_tyvars
-                (mkTyVarBinders Specified user_tyvars)
+                (mkTyCoVarBinders Specified user_tyvars)
                 []      -- No equality spec
                 []      -- No theta
                 arg_tys (mkTyConApp tycon (mkTyVarTys tyvars))
@@ -585,7 +585,7 @@ constraintKind   = mkTyConApp constraintKindTyCon []
 mkFunKind :: Kind -> Kind -> Kind
 mkFunKind = mkFunTy
 
-mkForAllKind :: TyVar -> ArgFlag -> Kind -> Kind
+mkForAllKind :: TyCoVar -> ArgFlag -> Kind -> Kind
 mkForAllKind = mkForAllTy
 
 {-
index 0d57860..f6d27cc 100644 (file)
@@ -38,7 +38,6 @@ import TyCon            ( tyConName )
 import Id
 import PprCore          ( pprParendExpr )
 import MkCore           ( mkImpossibleExpr )
-import Var
 import VarEnv
 import VarSet
 import Name
index 4e854fc..4f380d3 100644 (file)
@@ -58,7 +58,7 @@ import MkId( mkDictFunId )
 import CoreSyn( Expr(..) )  -- For the Coercion constructor
 import Id
 import Name
-import Var      ( EvVar, mkTyVar, tyVarName, TyVarBndr(..) )
+import Var      ( EvVar, mkTyVar, tyVarName, VarBndr(..) )
 import DataCon
 import VarEnv
 import PrelNames
@@ -223,7 +223,7 @@ top_instantiate inst_all orig ty
 
   | otherwise = return (idHsWrapper, ty)
   where
-    (binders, phi) = tcSplitForAllTyVarBndrs ty
+    (binders, phi) = tcSplitForAllVarBndrs ty
     (theta, rho)   = tcSplitPhiTy phi
 
     should_inst bndr
@@ -499,7 +499,7 @@ tcInstTyBinders subst mb_kind_info bndrs
 -- | Used only in *types*
 tcInstTyBinder :: Maybe (VarEnv Kind)
                -> TCvSubst -> TyBinder -> TcM (TCvSubst, TcType)
-tcInstTyBinder mb_kind_info subst (Named (TvBndr tv _))
+tcInstTyBinder mb_kind_info subst (Named (Bndr tv _))
   = case lookup_tv tv of
       Just ki -> return (extendTvSubstAndInScope subst tv ki, ki)
       Nothing -> do { (subst', tv') <- newMetaTyVarX subst tv
index 3ff54df..6579556 100644 (file)
@@ -995,8 +995,8 @@ can_eq_nc_forall :: CtEvidence -> EqRel
 can_eq_nc_forall ev eq_rel s1 s2
  | CtWanted { ctev_loc = loc, ctev_dest = orig_dest } <- ev
  = do { let free_tvs       = tyCoVarsOfTypes [s1,s2]
-            (bndrs1, phi1) = tcSplitForAllTyVarBndrs s1
-            (bndrs2, phi2) = tcSplitForAllTyVarBndrs s2
+            (bndrs1, phi1) = tcSplitForAllVarBndrs s1
+            (bndrs2, phi2) = tcSplitForAllVarBndrs s2
       ; if not (equalLength bndrs1 bndrs2)
         then do { traceTcS "Forall failure" $
                      vcat [ ppr s1, ppr s2, ppr bndrs1, ppr bndrs2
index 87b853f..6827a58 100644 (file)
@@ -408,7 +408,7 @@ reportImplic ctxt implic@(Implic { ic_skols = tvs, ic_telescope = m_telescope
   where
     tcl_env      = implicLclEnv implic
     insoluble    = isInsolubleStatus status
-    (env1, tvs') = mapAccumL tidyTyCoVarBndr (cec_tidy ctxt) tvs
+    (env1, tvs') = mapAccumL tidyVarBndr (cec_tidy ctxt) tvs
     info'        = tidySkolemInfo env1 info
     implic' = implic { ic_skols = tvs'
                      , ic_given = map (tidyEvVar env1) given
@@ -1644,7 +1644,7 @@ mkTyVarEqErr' dflags ctxt report ct oriented tv1 co1 ty2
              extra3 = relevant_bindings $
                       ppWhen (not (null interesting_tyvars)) $
                       hang (text "Type variable kinds:") 2 $
-                      vcat (map (tyvar_binding . tidyTyVarOcc (cec_tidy ctxt))
+                      vcat (map (tyvar_binding . tidyTyCoVarOcc (cec_tidy ctxt))
                                 interesting_tyvars)
 
              tyvar_binding tv = ppr tv <+> dcolon <+> ppr (tyVarKind tv)
index 4129b87..5c9bdd9 100644 (file)
@@ -1153,7 +1153,7 @@ flatten_args_tc tc = flatten_args all_bndrs any_named_bndrs inner_ki emptyVarSet
     -- NB: Those bangs there drop allocations in T9872{a,c,d} by 8%.
 
 {-# INLINE flatten_args #-}
-flatten_args :: [TyBinder] -> Bool   -- Binders, and True iff any of them are
+flatten_args :: [TyCoBinder] -> Bool -- Binders, and True iff any of them are
                                      -- named.
              -> Kind -> TcTyCoVarSet -- function kind; kind's free vars
              -> [Role] -> [Type]     -- these are in 1-to-1 correspondence
@@ -1186,7 +1186,7 @@ flatten_args orig_binders
 -- There are many bang patterns in here. It's been observed that they
 -- greatly improve performance of an optimized build.
 -- The T9872 test cases are good witnesses of this fact.
-flatten_args_fast :: [TyBinder]
+flatten_args_fast :: [TyCoBinder]
                   -> Kind
                   -> [Role]
                   -> [Type]
@@ -1197,8 +1197,8 @@ flatten_args_fast orig_binders orig_inner_ki orig_roles orig_tys
 
     iterate :: [Type]
             -> [Role]
-            -> [TyBinder]
-            -> FlatM ([Xi], [Coercion], [TyBinder])
+            -> [TyCoBinder]
+            -> FlatM ([Xi], [Coercion], [TyCoBinder])
     iterate (ty:tys) (role:roles) (_:binders) = do
       (xi, co) <- go role ty
       (xis, cos, binders) <- iterate tys roles binders
@@ -1233,7 +1233,7 @@ flatten_args_fast orig_binders orig_inner_ki orig_roles orig_tys
           --   mkCastTy x (Refl _ _) = x
           --   mkTcGReflLeftCo _ ty (Refl _ _) `mkTransCo` co = co
           --
-          -- Also, no need to check isAnonTyBinder or isNamedTyBinder, since
+          -- Also, no need to check isAnonTyCoBinder or isNamedTyCoBinder, since
           -- we've already established that they're all anonymous.
           Nominal          -> setEqRel NomEq  $ flatten_one ty
           Representational -> setEqRel ReprEq $ flatten_one ty
@@ -1243,7 +1243,7 @@ flatten_args_fast orig_binders orig_inner_ki orig_roles orig_tys
 
 
     {-# INLINE finish #-}
-    finish :: ([Xi], [Coercion], [TyBinder]) -> ([Xi], [Coercion], CoercionN)
+    finish :: ([Xi], [Coercion], [TyCoBinder]) -> ([Xi], [Coercion], CoercionN)
     finish (xis, cos, binders) = (xis, cos, kind_co)
       where
         final_kind = mkPiTys binders orig_inner_ki
@@ -1252,7 +1252,7 @@ flatten_args_fast orig_binders orig_inner_ki orig_roles orig_tys
 {-# INLINE flatten_args_slow #-}
 -- | Slow path, compared to flatten_args_fast, because this one must track
 -- a lifting context.
-flatten_args_slow :: [TyBinder] -> Kind -> TcTyCoVarSet
+flatten_args_slow :: [TyCoBinder] -> Kind -> TcTyCoVarSet
                   -> [Role] -> [Type]
                   -> FlatM ([Xi], [Coercion], CoercionN)
 flatten_args_slow orig_binders orig_inner_ki orig_fvs orig_roles orig_tys
@@ -1264,7 +1264,7 @@ flatten_args_slow orig_binders orig_inner_ki orig_fvs orig_roles orig_tys
        -> [Coercion]  -- Coercions accumulator, in reverse order
                       -- These are in 1-to-1 correspondence
        -> LiftingContext  -- mapping from tyvars to flattening coercions
-       -> [TyBinder]  -- Unsubsted binders of function's kind
+       -> [TyCoBinder]    -- Unsubsted binders of function's kind
        -> Kind        -- Unsubsted result kind of function (not a Pi-type)
        -> [Role]      -- Roles at which to flatten these ...
        -> [Type]      -- ... unflattened types
@@ -1272,21 +1272,21 @@ flatten_args_slow orig_binders orig_inner_ki orig_fvs orig_roles orig_tys
     go acc_xis acc_cos lc binders inner_ki _ []
       = return (reverse acc_xis, reverse acc_cos, kind_co)
       where
-        final_kind = mkPiTys binders inner_ki
+        final_kind = mkTyCoPiTys binders inner_ki
         kind_co = liftCoSubst Nominal lc final_kind
 
     go acc_xis acc_cos lc (binder:binders) inner_ki (role:roles) (ty:tys)
       = do { (xi, co) <- case role of
                Nominal          -> setEqRel NomEq $
-                                   if isNamedTyBinder binder
+                                   if isNamedTyCoBinder binder
                                    then noBogusCoercions $ flatten_one ty
                                    else                    flatten_one ty
 
-               Representational -> ASSERT( isAnonTyBinder binder )
+               Representational -> ASSERT( isAnonTyCoBinder binder )
                                    setEqRel ReprEq $ flatten_one ty
 
                Phantom          -> -- See Note [Phantoms in the flattener]
-                                   ASSERT( isAnonTyBinder binder )
+                                   ASSERT( isAnonTyCoBinder binder )
                                    do { ty <- liftTcS $ zonkTcType ty
                                       ; return (ty, mkReflCo Phantom ty) }
 
@@ -1299,12 +1299,12 @@ flatten_args_slow orig_binders orig_inner_ki orig_fvs orig_roles orig_tys
              -- The bangs here have been observed to improve performance
              -- significantly in optimized builds.
            ; let kind_co = mkTcSymCo $
-                   liftCoSubst Nominal lc (tyBinderType binder)
+                   liftCoSubst Nominal lc (tyCoBinderType binder)
                  !casted_xi = xi `mkCastTy` kind_co
                  casted_co =  mkTcCoherenceLeftCo role xi kind_co co
 
              -- now, extend the lifting context with the new binding
-                 !new_lc | Just tv <- tyBinderVar_maybe binder
+                 !new_lc | Just tv <- tyCoBinderVar_maybe binder
                          = extendLiftingContextAndInScope lc tv casted_co
                          | otherwise
                          = lc
@@ -1421,7 +1421,7 @@ flatten_one ty@(ForAllTy {})
 
 -- We allow for-alls when, but only when, no type function
 -- applications inside the forall involve the bound type variables.
-  = do { let (bndrs, rho) = tcSplitForAllTyVarBndrs ty
+  = do { let (bndrs, rho) = tcSplitForAllVarBndrs ty
              tvs           = binderVars bndrs
        ; (rho', co) <- setMode FM_SubstOnly $ flatten_one rho
                          -- Substitute only under a forall
@@ -2160,7 +2160,7 @@ Flatten using the fun-eqs first.
 
 -- | Like 'splitPiTys'' but comes with a 'Bool' which is 'True' iff there is at
 -- least one named binder.
-split_pi_tys' :: Type -> ([TyBinder], Type, Bool)
+split_pi_tys' :: Type -> ([TyCoBinder], Type, Bool)
 split_pi_tys' ty = split ty ty
   where
   split orig_ty ty | Just ty' <- coreView ty = split orig_ty ty'
@@ -2171,14 +2171,14 @@ split_pi_tys' ty = split ty ty
   split orig_ty _                = ([], orig_ty, False)
 {-# INLINE split_pi_tys' #-}
 
--- | Like 'tyConBindersTyBinders' but you also get a 'Bool' which is true iff
+-- | Like 'tyConBindersTyCoBinders' but you also get a 'Bool' which is true iff
 -- there is at least one named binder.
-ty_con_binders_ty_binders' :: [TyConBinder] -> ([TyBinder], Bool)
+ty_con_binders_ty_binders' :: [TyConBinder] -> ([TyCoBinder], Bool)
 ty_con_binders_ty_binders' = foldr go ([], False)
   where
-    go (TvBndr tv (NamedTCB vis)) (bndrs, _)
-      = (Named (TvBndr tv vis) : bndrs, True)
-    go (TvBndr tv AnonTCB)        (bndrs, n)
+    go (Bndr tv (NamedTCB vis)) (bndrs, _)
+      = (Named (Bndr tv vis) : bndrs, True)
+    go (Bndr tv AnonTCB)        (bndrs, n)
       = (Anon (tyVarKind tv)   : bndrs, n)
     {-# INLINE go #-}
 {-# INLINE ty_con_binders_ty_binders' #-}
index f7ec465..8038de3 100644 (file)
@@ -131,7 +131,7 @@ normaliseFfiType' env ty0 = go initRecTc ty0
       | Just (tc, tys) <- splitTyConApp_maybe ty
       = go_tc_app rec_nts tc tys
 
-      | (bndrs, inner_ty) <- splitForAllTyVarBndrs ty
+      | (bndrs, inner_ty) <- splitForAllVarBndrs ty
       , not (null bndrs)
       = do (coi, nty1, gres1) <- go rec_nts inner_ty
            return ( mkHomoForAllCos (binderVars bndrs) coi
index 8310cf9..41d8eb8 100644 (file)
@@ -392,7 +392,7 @@ functorLikeTraverse var (FT { ft_triv = caseTrivial,     ft_var = caseVar
          -- variables in a unboxed tuple pattern match and expression as it
          -- actually needs. See Trac #12399
          (xrs,xcs) = unzip (map (go co) (dropRuntimeRepArgs args))
-    go co (ForAllTy (TvBndr v vis) x)
+    go co (ForAllTy (Bndr v vis) x)
        | isVisibleArgFlag vis = panic "unexpected visible binder"
        | v /= var && xc       = (caseForAll v xr,True)
        where (xr,xc) = go co x
index e2567c6..3363aa2 100644 (file)
@@ -429,20 +429,20 @@ zonkTyBndrX env tv
        ; let tv' = mkTyVar (tyVarName tv) ki
        ; return (extendTyZonkEnv1 env tv', tv') }
 
-zonkTyVarBinders ::  [TyVarBndr TcTyVar vis]
-                 -> TcM (ZonkEnv, [TyVarBndr TyVar vis])
+zonkTyVarBinders ::  [VarBndr TcTyVar vis]
+                 -> TcM (ZonkEnv, [VarBndr TyVar vis])
 zonkTyVarBinders = initZonkEnv zonkTyVarBindersX
 
-zonkTyVarBindersX :: ZonkEnv -> [TyVarBndr TcTyVar vis]
-                             -> TcM (ZonkEnv, [TyVarBndr TyVar vis])
+zonkTyVarBindersX :: ZonkEnv -> [VarBndr TcTyVar vis]
+                             -> TcM (ZonkEnv, [VarBndr TyVar vis])
 zonkTyVarBindersX = mapAccumLM zonkTyVarBinderX
 
-zonkTyVarBinderX :: ZonkEnv -> TyVarBndr TcTyVar vis
-                            -> TcM (ZonkEnv, TyVarBndr TyVar vis)
+zonkTyVarBinderX :: ZonkEnv -> VarBndr TcTyVar vis
+                            -> TcM (ZonkEnv, VarBndr TyVar vis)
 -- Takes a TcTyVar and guarantees to return a TyVar
-zonkTyVarBinderX env (TvBndr tv vis)
+zonkTyVarBinderX env (Bndr tv vis)
   = do { (env', tv') <- zonkTyBndrX env tv
-       ; return (env', TvBndr tv' vis) }
+       ; return (env', Bndr tv' vis) }
 
 zonkTopExpr :: HsExpr GhcTcId -> TcM (HsExpr GhcTc)
 zonkTopExpr e = initZonkEnv zonkExpr e
@@ -1814,7 +1814,7 @@ zonk_tycomapper = TyCoMapper
   , tcm_tyvar = zonkTyVarOcc
   , tcm_covar = zonkCoVarOcc
   , tcm_hole  = zonkCoHole
-  , tcm_tybinder = \env tv _vis -> zonkTyBndrX env tv
+  , tcm_tycobinder = \env tv _vis -> zonkTyBndrX env tv
   , tcm_tycon = zonkTcTyConToTyCon }
 
 -- Zonk a TyCon by changing a TcTyCon to a regular TyCon
index 6370626..a9d6d46 100644 (file)
@@ -73,7 +73,7 @@ import TcHsSyn
 import TcErrors ( reportAllUnsolved )
 import TcType
 import Inst   ( tcInstTyBinders, tcInstTyBinder )
-import TyCoRep( TyBinder(..) )  -- Used in tcDataKindSig
+import TyCoRep( TyCoBinder(..), TyBinder )  -- Used in tcDataKindSig
 import Type
 import Coercion
 import RdrName( lookupLocalRdrOcc )
@@ -1348,7 +1348,7 @@ Here
 and
   T :: forall {k3} k1. forall k3 -> k1 -> k2 -> k3 -> *
 
-See Note [TyVarBndrs, TyVarBinders, TyConBinders, and visibility]
+See Note [VarBndrs, TyCoVarBinders, TyConBinders, and visibility]
 in TyCoRep.
 
 kcLHsQTyVars uses the hsq_dependent field to decide whether
@@ -2187,15 +2187,15 @@ tcDataKindSig tc_bndrs kind
               arg'   = substTy subst arg
               tv     = mkTyVar (mkInternalName uniq occ loc) arg'
               subst' = extendTCvInScope subst tv
-              tcb    = TvBndr tv AnonTCB
+              tcb    = Bndr tv AnonTCB
               (uniq:uniqs') = uniqs
               (occ:occs')   = occs
 
-          Just (Named (TvBndr tv vis), kind')
+          Just (Named (Bndr tv vis), kind')
             -> go loc occs uniqs subst' (tcb : acc) kind'
             where
               (subst', tv') = substTyVarBndr subst tv
-              tcb = TvBndr tv' (NamedTCB vis)
+              tcb = Bndr tv' (NamedTCB vis)
 
 badKindSig :: Bool -> Kind -> SDoc
 badKindSig check_for_type kind
@@ -2585,7 +2585,7 @@ zonkPromoteMapper = TyCoMapper { tcm_smart    = True
                                , tcm_tyvar    = const zonkPromoteTcTyVar
                                , tcm_covar    = const covar
                                , tcm_hole     = const hole
-                               , tcm_tybinder = const tybinder
+                               , tcm_tycobinder = const tybinder
                                , tcm_tycon    = return }
   where
     covar cv
@@ -2737,7 +2737,7 @@ reportFloatingKvs tycon_name flav all_tvs bad_tvs
     do { all_tvs <- mapM zonkTcTyVarToTyVar all_tvs
        ; bad_tvs <- mapM zonkTcTyVarToTyVar bad_tvs
        ; let (tidy_env, tidy_all_tvs) = tidyOpenTyCoVars emptyTidyEnv all_tvs
-             tidy_bad_tvs             = map (tidyTyVarOcc tidy_env) bad_tvs
+             tidy_bad_tvs             = map (tidyTyCoVarOcc tidy_env) bad_tvs
        ; mapM_ (report tidy_all_tvs) tidy_bad_tvs }
   where
     report tidy_all_tvs tidy_bad_tv
index 642a16a..26d1a33 100644 (file)
@@ -1542,7 +1542,7 @@ zonkTcTypeMapper = TyCoMapper
   , tcm_tyvar = const zonkTcTyVar
   , tcm_covar = const (\cv -> mkCoVarCo <$> zonkTyCoVarKind cv)
   , tcm_hole  = hole
-  , tcm_tybinder = \_env tv _vis -> ((), ) <$> zonkTcTyCoVarBndr tv
+  , tcm_tycobinder = \_env tv _vis -> ((), ) <$> zonkTcTyCoVarBndr tv
   , tcm_tycon = return }
   where
     hole :: () -> CoercionHole -> TcM Coercion
@@ -1580,10 +1580,10 @@ zonkTcTyCoVarBndr tyvar
   = ASSERT2( isImmutableTyVar tyvar || (not $ isTyVar tyvar), pprTyVar tyvar )
     updateTyVarKindM zonkTcType tyvar
 
-zonkTcTyVarBinder :: TyVarBndr TcTyVar vis -> TcM (TyVarBndr TcTyVar vis)
-zonkTcTyVarBinder (TvBndr tv vis)
+zonkTcTyVarBinder :: VarBndr TcTyVar vis -> TcM (VarBndr TcTyVar vis)
+zonkTcTyVarBinder (Bndr tv vis)
   = do { tv' <- zonkTcTyCoVarBndr tv
-       ; return (TvBndr tv' vis) }
+       ; return (Bndr tv' vis) }
 
 zonkTcTyVar :: TcTyVar -> TcM TcType
 -- Simply look through all Flexis
@@ -1731,11 +1731,11 @@ tidySigSkol :: TidyEnv -> UserTypeCtxt
 tidySigSkol env cx ty tv_prs
   = SigSkol cx (tidy_ty env ty) tv_prs'
   where
-    tv_prs' = mapSnd (tidyTyVarOcc env) tv_prs
+    tv_prs' = mapSnd (tidyTyCoVarOcc env) tv_prs
     inst_env = mkNameEnv tv_prs'
 
-    tidy_ty env (ForAllTy (TvBndr tv vis) ty)
-      = ForAllTy (TvBndr tv' vis) (tidy_ty env' ty)
+    tidy_ty env (ForAllTy (Bndr tv vis) ty)
+      = ForAllTy (Bndr tv' vis) (tidy_ty env' ty)
       where
         (env', tv') = tidy_tv_bndr env tv
 
@@ -1744,13 +1744,13 @@ tidySigSkol env cx ty tv_prs
 
     tidy_ty env ty = tidyType env ty
 
-    tidy_tv_bndr :: TidyEnv -> TyVar -> (TidyEnv, TyVar)
+    tidy_tv_bndr :: TidyEnv -> TyCoVar -> (TidyEnv, TyCoVar)
     tidy_tv_bndr env@(occ_env, subst) tv
       | Just tv' <- lookupNameEnv inst_env (tyVarName tv)
       = ((occ_env, extendVarEnv subst tv tv'), tv')
 
       | otherwise
-      = tidyTyCoVarBndr env tv
+      = tidyVarBndr env tv
 
 -------------------------------------------------------------------------
 {-
index 5ec71d1..d10829f 100644 (file)
@@ -17,7 +17,7 @@ import GhcPrelude
 
 import HsSyn
 import TcPat
-import Type( mkEmptyTCvSubst, tidyTyVarBinders, tidyTypes, tidyType )
+import Type( mkEmptyTCvSubst, tidyTyCoVarBinders, tidyTypes, tidyType )
 import TcRnMonad
 import TcSigs( emptyPragEnv, completeSigFromId )
 import TcType( mkMinimalBySCs )
@@ -618,8 +618,8 @@ tc_patsyn_finish lname dir is_infix lpat'
        ; pat_ty'         <- zonkTcTypeToTypeX ze pat_ty
        ; arg_tys'        <- zonkTcTypesToTypesX ze arg_tys
 
-       ; let (env1, univ_tvs) = tidyTyVarBinders emptyTidyEnv univ_tvs'
-             (env2, ex_tvs)   = tidyTyVarBinders env1 ex_tvs'
+       ; let (env1, univ_tvs) = tidyTyCoVarBinders emptyTidyEnv univ_tvs'
+             (env2, ex_tvs)   = tidyTyCoVarBinders env1 ex_tvs'
              req_theta  = tidyTypes env2 req_theta'
              prov_theta = tidyTypes env2 prov_theta'
              arg_tys    = tidyTypes env2 arg_tys'
index bdcb5b1..147c16b 100644 (file)
@@ -1563,7 +1563,7 @@ data TcPatSynInfo
         patsig_name           :: Name,
         patsig_implicit_bndrs :: [TyVarBinder], -- Implicitly-bound kind vars (Inferred) and
                                                 -- implicitly-bound type vars (Specified)
-          -- See Note [The pattern-synonym signature splitting rule] in TcSigs
+          -- See Note [The pattern-synonym signature splitting rule] in TcPatSyn
         patsig_univ_bndrs     :: [TyVar],       -- Bound by explicit user forall
         patsig_req            :: TcThetaType,
         patsig_ex_bndrs       :: [TyVar],       -- Bound by explicit user forall
index 21eb829..c26ba0d 100644 (file)
@@ -1527,7 +1527,9 @@ reifyDataCon isGadtDataCon tys dc
                   return $ TH.NormalC name (dcdBangs `zip` r_arg_tys)
 
        ; let (ex_tvs', theta') | isGadtDataCon = (g_user_tvs, g_theta)
-                               | otherwise     = (ex_tvs, theta)
+                               | otherwise     = ASSERT( all isTyVar ex_tvs )
+                                                 -- no covars for haskell syntax
+                                                 (ex_tvs, theta)
              ret_con | null ex_tvs' && null theta' = return main_con
                      | otherwise                   = do
                          { cxt <- reifyCxt theta'
index 9fdc069..eafb5b3 100644 (file)
@@ -3284,7 +3284,7 @@ checkValidDependency binders res_kind
         tcb_var  = binderVar tcb
         tcb_kind = tyVarKind tcb_var
 
-        pp_binder binder = ppr (binderVar binder) <+> dcolon <+> ppr (binderKind binder)
+        pp_binder binder = ppr (binderVar binder) <+> dcolon <+> ppr (binderType binder)
 
 {-
 ************************************************************************
@@ -3401,7 +3401,7 @@ checkValidRoles tc
       =  check_ty_roles env role ty1
       >> check_ty_roles env role ty2
 
-    check_ty_roles env role (ForAllTy (TvBndr tv _) ty)
+    check_ty_roles env role (ForAllTy (Bndr tv _) ty)
       =  check_ty_roles env Nominal (tyVarKind tv)
       >> check_ty_roles (extendVarEnv env tv Nominal) role ty
 
@@ -3517,7 +3517,8 @@ noClassTyVarErr clas fam_tc
 
 badDataConTyCon :: DataCon -> Type -> Type -> SDoc
 badDataConTyCon data_con res_ty_tmpl actual_res_ty
-  | tcIsForAllTy actual_res_ty
+  | ASSERT( all isTyVar actual_ex_tvs )
+    tcIsForAllTy actual_res_ty
   = nested_foralls_contexts_suggestion
   | isJust (tcSplitPredFunTy_maybe actual_res_ty)
   = nested_foralls_contexts_suggestion
@@ -3555,7 +3556,7 @@ badDataConTyCon data_con res_ty_tmpl actual_res_ty
     --    underneath the nested foralls and contexts.
     -- 3) Smash together the type variables and class predicates from 1) and
     --    2), and prepend them to the rho type from 2).
-    actual_ex_tvs = dataConExTyVars data_con
+    actual_ex_tvs = dataConExTyCoVars data_con
     actual_theta  = dataConTheta data_con
     (actual_res_tvs, actual_res_theta, actual_res_rho)
       = tcSplitNestedSigmaTys actual_res_ty
index 77608e7..e6cd073 100644 (file)
@@ -40,7 +40,7 @@ module TcType (
   TcTyVarDetails(..), pprTcTyVarDetails, vanillaSkolemTv, superSkolemTv,
   MetaDetails(Flexi, Indirect), MetaInfo(..),
   isImmutableTyVar, isSkolemTyVar, isMetaTyVar,  isMetaTyVarTy, isTyVarTy,
-  isTyVarTyVar, isOverlappableTyVar,  isTyConableTyVar,
+  tcIsTcTyVar, isTyVarTyVar, isOverlappableTyVar,  isTyConableTyVar,
   isFskTyVar, isFmvTyVar, isFlattenTyVar,
   isAmbiguousTyVar, metaTyVarRef, metaTyVarInfo,
   isFlexi, isIndirect, isRuntimeUnkSkol,
@@ -59,7 +59,7 @@ module TcType (
   -- These are important because they do not look through newtypes
   getTyVar,
   tcSplitForAllTy_maybe,
-  tcSplitForAllTys, tcSplitPiTys, tcSplitPiTy_maybe, tcSplitForAllTyVarBndrs,
+  tcSplitForAllTys, tcSplitPiTys, tcSplitPiTy_maybe, tcSplitForAllVarBndrs,
   tcSplitPhiTy, tcSplitPredFunTy_maybe,
   tcSplitFunTy_maybe, tcSplitFunTys, tcFunArgTy, tcFunResultTy, tcFunResultTyN,
   tcSplitFunTysN,
@@ -131,13 +131,14 @@ module TcType (
 
   --------------------------------
   -- Rexported from Type
-  Type, PredType, ThetaType, TyBinder, ArgFlag(..),
+  Type, PredType, ThetaType, TyCoBinder, ArgFlag(..),
 
-  mkForAllTy, mkForAllTys, mkInvForAllTys, mkSpecForAllTys, mkInvForAllTy,
+  mkForAllTy, mkForAllTys, mkTyCoInvForAllTys, mkSpecForAllTys, mkTyCoInvForAllTy,
+  mkInvForAllTy, mkInvForAllTys,
   mkFunTy, mkFunTys,
   mkTyConApp, mkAppTy, mkAppTys,
-  mkTyConTy, mkTyVarTy,
-  mkTyVarTys,
+  mkTyConTy, mkTyVarTy, mkTyVarTys,
+  mkTyCoVarTy, mkTyCoVarTys,
 
   isClassPred, isEqPred, isNomEqPred, isIPPred,
   mkClassPred,
@@ -179,7 +180,7 @@ module TcType (
   pprKind, pprParendKind, pprSigmaType,
   pprType, pprParendType, pprTypeApp, pprTyThingCategory, tyThingCategory,
   pprTheta, pprParendTheta, pprThetaArrowTy, pprClassPred,
-  pprTvBndr, pprTvBndrs,
+  pprTCvBndr, pprTCvBndrs,
 
   TypeSize, sizeType, sizeTypes, toposortTyVars,
 
@@ -338,8 +339,8 @@ type TcTyCoVar = Var    -- Either a TcTyVar or a CoVar
         -- a cannot occur inside a MutTyVar in T; that is,
         -- T is "flattened" before quantifying over a
 
-type TcTyVarBinder = TyVarBinder
-type TcTyCon       = TyCon   -- these can be the TcTyCon constructor
+type TcTyVarBinder   = TyVarBinder
+type TcTyCon         = TyCon   -- these can be the TcTyCon constructor
 
 -- These types do not have boxy type variables in them
 type TcPredType     = PredType
@@ -867,7 +868,7 @@ tcTyFamInsts (TyConApp tc tys)
   | isTypeFamilyTyCon tc        = [(tc, take (tyConArity tc) tys)]
   | otherwise                   = concat (map tcTyFamInsts tys)
 tcTyFamInsts (LitTy {})         = []
-tcTyFamInsts (ForAllTy bndr ty) = tcTyFamInsts (binderKind bndr)
+tcTyFamInsts (ForAllTy bndr ty) = tcTyFamInsts (binderType bndr)
                                   ++ tcTyFamInsts ty
 tcTyFamInsts (FunTy ty1 ty2)    = tcTyFamInsts ty1 ++ tcTyFamInsts ty2
 tcTyFamInsts (AppTy ty1 ty2)    = tcTyFamInsts ty1 ++ tcTyFamInsts ty2
@@ -927,7 +928,7 @@ exactTyCoVarsOfType ty
     go (LitTy {})           = emptyVarSet
     go (AppTy fun arg)      = go fun `unionVarSet` go arg
     go (FunTy arg res)      = go arg `unionVarSet` go res
-    go (ForAllTy bndr ty)   = delBinderVar (go ty) bndr `unionVarSet` go (binderKind bndr)
+    go (ForAllTy bndr ty)   = delBinderVar (go ty) bndr `unionVarSet` go (binderType bndr)
     go (CastTy ty co)       = go ty `unionVarSet` goCo co
     go (CoercionTy co)      = goCo co
 
@@ -1147,7 +1148,7 @@ split_dvs bound dvs ty
                       kill_bound (tyCoVarsOfTypeDSet (tyVarKind tv))
            , dv_tvs = tvs `extendDVarSet` tv }
 
-    go dv (ForAllTy (TvBndr tv _) ty)
+    go dv (ForAllTy (Bndr tv _) ty)
       = DV { dv_kvs = kvs `unionDVarSet`
                       kill_bound (tyCoVarsOfTypeDSet (tyVarKind tv))
            , dv_tvs = tvs }
@@ -1350,18 +1351,18 @@ findDupTyVarTvs prs
 ************************************************************************
 -}
 
-mkSigmaTy :: [TyVarBinder] -> [PredType] -> Type -> Type
+mkSigmaTy :: [TyCoVarBinder] -> [PredType] -> Type -> Type
 mkSigmaTy bndrs theta tau = mkForAllTys bndrs (mkPhiTy theta tau)
 
 -- | Make a sigma ty where all type variables are 'Inferred'. That is,
 -- they cannot be used with visible type application.
-mkInfSigmaTy :: [TyVar] -> [PredType] -> Type -> Type
-mkInfSigmaTy tyvars theta ty = mkSigmaTy (mkTyVarBinders Inferred tyvars) theta ty
+mkInfSigmaTy :: [TyCoVar] -> [PredType] -> Type -> Type
+mkInfSigmaTy tyvars theta ty = mkSigmaTy (mkTyCoVarBinders Inferred tyvars) theta ty
 
 -- | Make a sigma ty where all type variables are "specified". That is,
 -- they can be used with visible type application
 mkSpecSigmaTy :: [TyVar] -> [PredType] -> Type -> Type
-mkSpecSigmaTy tyvars preds ty = mkSigmaTy (mkTyVarBinders Specified tyvars) preds ty
+mkSpecSigmaTy tyvars preds ty = mkSigmaTy (mkTyCoVarBinders Specified tyvars) preds ty
 
 mkPhiTy :: [PredType] -> Type -> Type
 mkPhiTy = mkFunTys
@@ -1408,7 +1409,7 @@ then consider the type
 If we call typeKind on that, we'll crash, because the (un-zonked)
 kind of 'a' is just kappa, not an arrow kind.  If we zonk first
 we'd be fine, but that is too tiresome, so instead we maintain
-(TK-INV).  So we do not form (a Int); instead we form
+(INV-TK).  So we do not form (a Int); instead we form
     (a |> co) Int
 and typeKind has no problem with that.
 
@@ -1476,11 +1477,11 @@ nakedSubstTy subst ty
 
 nakedSubstMapper :: TyCoMapper TCvSubst Identity
 nakedSubstMapper
-  = TyCoMapper { tcm_smart    = False
-               , tcm_tyvar    = \subst tv -> return (substTyVar subst tv)
-               , tcm_covar    = \subst cv -> return (substCoVar subst cv)
-               , tcm_hole     = \_ hole   -> return (HoleCo hole)
-               , tcm_tybinder = \subst tv _ -> return (substTyVarBndr subst tv)
+  = TyCoMapper { tcm_smart      = False
+               , tcm_tyvar      = \subst tv -> return (substTyVar subst tv)
+               , tcm_covar      = \subst cv -> return (substCoVar subst cv)
+               , tcm_hole       = \_ hole   -> return (HoleCo hole)
+               , tcm_tycobinder = \subst tv _ -> return (substVarBndr subst tv)
                , tcm_tycon    = return }
 
 {-
@@ -1500,25 +1501,31 @@ variables.  It's up to you to make sure this doesn't matter.
 -- | Splits a forall type into a list of 'TyBinder's and the inner type.
 -- Always succeeds, even if it returns an empty list.
 tcSplitPiTys :: Type -> ([TyBinder], Type)
-tcSplitPiTys = splitPiTys
+tcSplitPiTys ty = ASSERT( all isTyBinder (fst sty) ) sty
+  where sty = splitPiTys ty
 
 -- | Splits a type into a TyBinder and a body, if possible. Panics otherwise
 tcSplitPiTy_maybe :: Type -> Maybe (TyBinder, Type)
-tcSplitPiTy_maybe = splitPiTy_maybe
+tcSplitPiTy_maybe ty = ASSERT( isMaybeTyBinder sty ) sty
+  where sty = splitPiTy_maybe ty
+        isMaybeTyBinder (Just (t,_)) = isTyBinder t
+        isMaybeTyBinder _ = True
 
 tcSplitForAllTy_maybe :: Type -> Maybe (TyVarBinder, Type)
 tcSplitForAllTy_maybe ty | Just ty' <- tcView ty = tcSplitForAllTy_maybe ty'
-tcSplitForAllTy_maybe (ForAllTy tv ty) = Just (tv, ty)
+tcSplitForAllTy_maybe (ForAllTy tv ty) = ASSERT( isTyVarBinder tv ) Just (tv, ty)
 tcSplitForAllTy_maybe _                = Nothing
 
 -- | Like 'tcSplitPiTys', but splits off only named binders, returning
 -- just the tycovars.
 tcSplitForAllTys :: Type -> ([TyVar], Type)
-tcSplitForAllTys = splitForAllTys
+tcSplitForAllTys ty = ASSERT( all isTyVar (fst sty) ) sty
+  where sty = splitForAllTys ty
 
 -- | Like 'tcSplitForAllTys', but splits off only named binders.
-tcSplitForAllTyVarBndrs :: Type -> ([TyVarBinder], Type)
-tcSplitForAllTyVarBndrs = splitForAllTyVarBndrs
+tcSplitForAllVarBndrs :: Type -> ([TyVarBinder], Type)
+tcSplitForAllVarBndrs ty = ASSERT( all isTyVarBinder (fst sty)) sty
+  where sty = splitForAllVarBndrs ty
 
 -- | Is this a ForAllTy with a named binder?
 tcIsForAllTy :: Type -> Bool
@@ -1664,7 +1671,7 @@ tcSplitFunTy_maybe _                                    = Nothing
         --
         --      g = f () ()
 
-tcSplitFunTysN :: Arity                      -- N: Number of desired args
+tcSplitFunTysN :: Arity                      -- n: Number of desired args
                -> TcRhoType
                -> Either Arity               -- Number of missing arrows
                         ([TcSigmaType],      -- Arg types (always N types)
@@ -1854,9 +1861,9 @@ tc_eq_type view_fun orig_ty1 orig_ty2 = go True orig_env orig_ty1 orig_ty2
     go vis _   (LitTy lit1)        (LitTy lit2)
       = check vis $ lit1 == lit2
 
-    go vis env (ForAllTy (TvBndr tv1 vis1) ty1)
-               (ForAllTy (TvBndr tv2 vis2) ty2)
-      = go (isVisibleArgFlag vis1) env (tyVarKind tv1) (tyVarKind tv2)
+    go vis env (ForAllTy (Bndr tv1 vis1) ty1)
+               (ForAllTy (Bndr tv2 vis2) ty2)
+      = go (isVisibleArgFlag vis1) env (varType tv1) (varType tv2)
           <!> go vis (rnBndr2 env tv1 tv2) ty1 ty2
           <!> check vis (vis1 == vis2)
     -- Make sure we handle all FunTy cases since falling through to the
@@ -2161,9 +2168,9 @@ isInsolubleOccursCheck eq_rel tv ty
                          NomEq  -> go t1 || go t2
                          ReprEq -> go t1
     go (FunTy t1 t2) = go t1 || go t2
-    go (ForAllTy (TvBndr tv' _) inner_ty)
+    go (ForAllTy (Bndr tv' _) inner_ty)
       | tv' == tv = False
-      | otherwise = go (tyVarKind tv') || go inner_ty
+      | otherwise = go (varType tv') || go inner_ty
     go (CastTy ty _)  = go ty   -- ToDo: what about the coercion
     go (CoercionTy _) = False   -- ToDo: what about the coercion
     go (TyConApp tc tys)
@@ -2719,7 +2726,7 @@ sizeType = go
     go (LitTy {})                = 1
     go (FunTy arg res)           = go arg + go res + 1
     go (AppTy fun arg)           = go fun + go arg
-    go (ForAllTy (TvBndr tv vis) ty)
+    go (ForAllTy (Bndr tv vis) ty)
         | isVisibleArgFlag vis   = go (tyVarKind tv) + go ty + 1
         | otherwise              = go ty + 1
     go (CastTy ty _)             = go ty
index ad266f6..05d49ae 100644 (file)
@@ -36,7 +36,7 @@ import Module
 import HsSyn
 import DynFlags
 import Bag
-import Var ( TyVarBndr(..) )
+import Var ( VarBndr(..) )
 import CoreMap
 import Constants
 import Fingerprint(Fingerprint(..), fingerprintString, fingerprintFingerprints)
@@ -401,7 +401,7 @@ mkTyConRepBinds :: TypeableStuff -> TypeRepTodo
                 -> TypeableTyCon -> KindRepM (LHsBinds GhcTc)
 mkTyConRepBinds stuff@(Stuff {..}) todo (TypeableTyCon {..})
   = do -- Make a KindRep
-       let (bndrs, kind) = splitForAllTyVarBndrs (tyConKind tycon)
+       let (bndrs, kind) = splitForAllVarBndrs (tyConKind tycon)
        liftTc $ traceTc "mkTyConKindRepBinds"
                         (ppr tycon $$ ppr (tyConKind tycon) $$ ppr kind)
        let ctx = mkDeBruijnContext (map binderVar bndrs)
@@ -579,7 +579,7 @@ mkKindRepRhs stuff@(Stuff {..}) in_scope = new_kind_rep
       | otherwise
       = pprPanic "mkTyConKindRepBinds(TyConApp)" (ppr tc $$ ppr k)
 
-    new_kind_rep (ForAllTy (TvBndr var _) ty)
+    new_kind_rep (ForAllTy (Bndr var _) ty)
       = pprPanic "mkTyConKindRepBinds(ForAllTy)" (ppr var $$ ppr ty)
 
     new_kind_rep (FunTy t1 t2)
index 045132e..05a30fd 100644 (file)
@@ -2196,7 +2196,7 @@ preCheck dflags ty_fam_ok tv ty
     fast_check (AppTy fun arg) = fast_check fun >> fast_check arg
     fast_check (CastTy ty co)  = fast_check ty  >> fast_check_co co
     fast_check (CoercionTy co) = fast_check_co co
-    fast_check (ForAllTy (TvBndr tv' _) ty)
+    fast_check (ForAllTy (Bndr tv' _) ty)
        | not impredicative_ok = OC_Bad
        | tv == tv'            = ok
        | otherwise = do { fast_check_occ (tyVarKind tv')
index df54dc2..dab9f2c 100644 (file)
@@ -50,7 +50,7 @@ import Name
 import VarEnv
 import VarSet
 import Id          ( idType, idName )
-import Var         ( TyVarBndr(..), mkTyVar )
+import Var         ( VarBndr(..), mkTyVar )
 import ErrUtils
 import DynFlags
 import Util
@@ -481,11 +481,11 @@ check_type env ctxt rank ty
                    (forAllEscapeErr env' ty tau_kind)
         }
   where
-    (tvbs, phi)  = tcSplitForAllTyVarBndrs ty
+    (tvbs, phi)  = tcSplitForAllVarBndrs ty
     (theta, tau) = tcSplitPhiTy phi
 
     tvs          = binderVars tvbs
-    (env', _)    = tidyTyCoVarBndrs env tvs
+    (env', _)    = tidyVarBndrs env tvs
 
     tau_kind              = typeKind tau
     phi_kind | null theta = tau_kind
@@ -2079,7 +2079,7 @@ checkValidTelescope :: [TyConBinder]   -- explicit vars (zonked)
 checkValidTelescope tvbs user_tyvars extra
   = do { let tvs      = binderVars tvbs
 
-             (_, sorted_tidied_tvs) = tidyTyCoVarBndrs emptyTidyEnv $
+             (_, sorted_tidied_tvs) = tidyVarBndrs emptyTidyEnv $
                                       toposortTyVars tvs
        ; unless (go [] emptyVarSet (binderVars tvbs)) $
          addErr $
@@ -2118,7 +2118,7 @@ fvType (TyConApp _ tys)      = fvTypes tys
 fvType (LitTy {})            = []
 fvType (AppTy fun arg)       = fvType fun ++ fvType arg
 fvType (FunTy arg res)       = fvType arg ++ fvType res
-fvType (ForAllTy (TvBndr tv _) ty)
+fvType (ForAllTy (Bndr tv _) ty)
   = fvType (tyVarKind tv) ++
     filter (/= tv) (fvType ty)
 fvType (CastTy ty _)         = fvType ty
index 3c81935..c766046 100644 (file)
@@ -29,10 +29,10 @@ module Coercion (
         mkAxInstRHS, mkUnbranchedAxInstRHS,
         mkAxInstLHS, mkUnbranchedAxInstLHS,
         mkPiCo, mkPiCos, mkCoCast,
-        mkSymCo, mkTransCo, mkTransAppCo,
+        mkSymCo, mkTransCo,
         mkNthCo, nthCoRole, mkLRCo,
         mkInstCo, mkAppCo, mkAppCos, mkTyConAppCo, mkFunCo,
-        mkForAllCo, mkForAllCos, mkHomoForAllCos, mkHomoForAllCos_NoRefl,
+        mkForAllCo, mkForAllCos, mkHomoForAllCos,
         mkPhantomCo,
         mkUnsafeCo, mkHoleCo, mkUnivCo, mkSubCo,
         mkAxiomInstCo, mkProofIrrelCo,
@@ -54,6 +54,7 @@ module Coercion (
         splitAppCo_maybe,
         splitFunCo_maybe,
         splitForAllCo_maybe,
+        splitForAllCo_ty_maybe, splitForAllCo_co_maybe,
 
         nthRole, tyConRolesX, tyConRolesRepresentational, setNominalRole_maybe,
 
@@ -198,7 +199,7 @@ ppr_co_ax_branch ppr_rhs
                           , cab_rhs = rhs
                           , cab_loc = loc })
   = foldr1 (flip hangNotEmpty 2)
-        [ pprUserForAll (mkTyVarBinders Inferred (ee_tvs ++ cvs))
+        [ pprUserForAll (mkTyCoVarBinders Inferred (ee_tvs ++ cvs))
         , pprTypeApp fam_tc ee_lhs <+> ppr_rhs fam_tc rhs
         , text "-- Defined" <+> pprLoc loc ]
   where
@@ -401,10 +402,22 @@ splitFunCo_maybe :: Coercion -> Maybe (Coercion, Coercion)
 splitFunCo_maybe (FunCo _ arg res) = Just (arg, res)
 splitFunCo_maybe _ = Nothing
 
-splitForAllCo_maybe :: Coercion -> Maybe (TyVar, Coercion, Coercion)
+splitForAllCo_maybe :: Coercion -> Maybe (TyCoVar, Coercion, Coercion)
 splitForAllCo_maybe (ForAllCo tv k_co co) = Just (tv, k_co, co)
 splitForAllCo_maybe _                     = Nothing
 
+-- | Like 'splitForAllCo_maybe', but only returns Just for tyvar binder
+splitForAllCo_ty_maybe :: Coercion -> Maybe (TyVar, Coercion, Coercion)
+splitForAllCo_ty_maybe (ForAllCo tv k_co co)
+  | isTyVar tv = Just (tv, k_co, co)
+splitForAllCo_ty_maybe _ = Nothing
+
+-- | Like 'splitForAllCo_maybe', but only returns Just for covar binder
+splitForAllCo_co_maybe :: Coercion -> Maybe (CoVar, Coercion, Coercion)
+splitForAllCo_co_maybe (ForAllCo cv k_co co)
+  | isCoVar cv = Just (cv, k_co, co)
+splitForAllCo_co_maybe _ = Nothing
+
 -------------------------------------------------------
 -- and some coercion kind stuff
 
@@ -685,104 +698,81 @@ mkAppCos :: Coercion
          -> Coercion
 mkAppCos co1 cos = foldl' mkAppCo co1 cos
 
--- | Like 'mkAppCo', but allows the second coercion to be other than
--- nominal. See Note [mkTransAppCo]. Role r3 cannot be more stringent
--- than either r1 or r2.
-mkTransAppCo :: Role         -- ^ r1
-             -> Coercion     -- ^ co1 :: ty1a ~r1 ty1b
-             -> Type         -- ^ ty1a
-             -> Type         -- ^ ty1b
-             -> Role         -- ^ r2
-             -> Coercion     -- ^ co2 :: ty2a ~r2 ty2b
-             -> Type         -- ^ ty2a
-             -> Type         -- ^ ty2b
-             -> Role         -- ^ r3
-             -> Coercion     -- ^ :: ty1a ty2a ~r3 ty1b ty2b
-mkTransAppCo r1 co1 ty1a ty1b r2 co2 ty2a ty2b r3
--- How incredibly fiddly! Is there a better way??
-  = case (r1, r2, r3) of
-      (_,                _,                Phantom)
-        -> mkPhantomCo kind_co (mkAppTy ty1a ty2a) (mkAppTy ty1b ty2b)
-        where -- ty1a :: k1a -> k2a
-              -- ty1b :: k1b -> k2b
-              -- ty2a :: k1a
-              -- ty2b :: k1b
-              -- ty1a ty2a :: k2a
-              -- ty1b ty2b :: k2b
-              kind_co1 = mkKindCo co1        -- :: k1a -> k2a ~N k1b -> k2b
-              kind_co  = mkNthCo Nominal 1 kind_co1  -- :: k2a ~N k2b
-
-      (_,                _,                Nominal)
-        -> ASSERT( r1 == Nominal && r2 == Nominal )
-           mkAppCo co1 co2
-      (Nominal,          Nominal,          Representational)
-        -> mkSubCo (mkAppCo co1 co2)
-      (_,                Nominal,          Representational)
-        -> ASSERT( r1 == Representational )
-           mkAppCo co1 co2
-      (Nominal,          Representational, Representational)
-        -> go (mkSubCo co1)
-      (_               , _,                Representational)
-        -> ASSERT( r1 == Representational && r2 == Representational )
-           go co1
-  where
-    go co1_repr
-      | Just (tc1b, tys1b) <- splitTyConApp_maybe ty1b
-      , nextRole ty1b == r2
-      = (mkAppCo co1_repr (mkNomReflCo ty2a)) `mkTransCo`
-        (mkTyConAppCo Representational tc1b
-           (zipWith mkReflCo (tyConRolesRepresentational tc1b) tys1b
-            ++ [co2]))
-
-      | Just (tc1a, tys1a) <- splitTyConApp_maybe ty1a
-      , nextRole ty1a == r2
-      = (mkTyConAppCo Representational tc1a
-           (zipWith mkReflCo (tyConRolesRepresentational tc1a) tys1a
-            ++ [co2]))
-        `mkTransCo`
-        (mkAppCo co1_repr (mkNomReflCo ty2b))
+{- Note [Unused coercion variable in ForAllCo]
 
-      | otherwise
-      = pprPanic "mkTransAppCo" (vcat [ ppr r1, ppr co1, ppr ty1a, ppr ty1b
-                                      , ppr r2, ppr co2, ppr ty2a, ppr ty2b
-                                      , ppr r3 ])
+See Note [Unused coercion variable in ForAllTy] in TyCoRep for the motivation for
+checking coercion variable in types.
+To lift the design choice to (ForAllCo cv kind_co body_co), we have two options:
+
+(1) In mkForAllCo, we check whether cv is a coercion variable
+    and whether it is not used in body_co. If so we construct a FunCo.
+(2) We don't do this check in mkForAllCo.
+    In coercionKind, we use mkTyCoForAllTy to perform the check and construct
+    a FunTy when necessary.
+
+We chose (2) for two reasons:
+
+* for a coercion, all that matters is its kind, So ForAllCo or FunCo does not
+  make a difference.
+* even if cv occurs in body_co, it is possible that cv does not occur in the kind
+  of body_co. Therefore the check in coercionKind is inevitable.
 
--- | Make a Coercion from a tyvar, a kind coercion, and a body coercion.
--- The kind of the tyvar should be the left-hand kind of the kind coercion.
-mkForAllCo :: TyVar -> Coercion -> Coercion -> Coercion
+-}
+
+
+-- | Make a Coercion from a tycovar, a kind coercion, and a body coercion.
+-- The kind of the tycovar should be the left-hand kind of the kind coercion.
+-- See Note [Unused coercion variable in ForAllCo]
+mkForAllCo :: TyCoVar -> CoercionN -> Coercion -> Coercion
 mkForAllCo tv kind_co co
-  | Just (ty, r) <- isReflCo_maybe co
+  | ASSERT( varType tv `eqType` (pFst $ coercionKind kind_co)) True
+  , Just (ty, r) <- isReflCo_maybe co
   , isGReflCo kind_co
-  = mkReflCo r (mkInvForAllTy tv ty)
+  = mkReflCo r (mkTyCoInvForAllTy tv ty)
+  | otherwise
+  = ForAllCo tv kind_co co
+
+-- | Like 'mkForAllCo', but the inner coercion shouldn't be an obvious
+-- reflexive coercion. For example, it is guaranteed in 'mkForAllCos'.
+-- The kind of the tycovar should be the left-hand kind of the kind coercion.
+mkForAllCo_NoRefl :: TyCoVar -> CoercionN -> Coercion -> Coercion
+mkForAllCo_NoRefl tv kind_co co
+  | ASSERT( varType tv `eqType` (pFst $ coercionKind kind_co)) True
+  , ASSERT( not (isReflCo co)) True
+  , isCoVar tv
+  , not (tv `elemVarSet` tyCoVarsOfCo co)
+  = FunCo (coercionRole co) kind_co co
   | otherwise
   = ForAllCo tv kind_co co
 
 -- | Make nested ForAllCos
-mkForAllCos :: [(TyVar, Coercion)] -> Coercion -> Coercion
+mkForAllCos :: [(TyCoVar, CoercionN)] -> Coercion -> Coercion
 mkForAllCos bndrs co
   | Just (ty, r ) <- isReflCo_maybe co
   = let (refls_rev'd, non_refls_rev'd) = span (isReflCo . snd) (reverse bndrs) in
-    foldl' (flip $ uncurry ForAllCo)
-           (mkReflCo r (mkInvForAllTys (reverse (map fst refls_rev'd)) ty))
+    foldl' (flip $ uncurry mkForAllCo_NoRefl)
+           (mkReflCo r (mkTyCoInvForAllTys (reverse (map fst refls_rev'd)) ty))
            non_refls_rev'd
   | otherwise
-  = foldr (uncurry ForAllCo) co bndrs
+  = foldr (uncurry mkForAllCo_NoRefl) co bndrs
 
--- | Make a Coercion quantified over a type variable;
+-- | Make a Coercion quantified over a type/coercion variable;
 -- the variable has the same type in both sides of the coercion
-mkHomoForAllCos :: [TyVar] -> Coercion -> Coercion
+mkHomoForAllCos :: [TyCoVar] -> Coercion -> Coercion
 mkHomoForAllCos tvs co
   | Just (ty, r) <- isReflCo_maybe co
-  = mkReflCo r (mkInvForAllTys tvs ty)
+  = mkReflCo r (mkTyCoInvForAllTys tvs ty)
   | otherwise
   = mkHomoForAllCos_NoRefl tvs co
 
--- | Like 'mkHomoForAllCos', but doesn't check if the inner coercion
--- is reflexive.
-mkHomoForAllCos_NoRefl :: [TyVar] -> Coercion -> Coercion
-mkHomoForAllCos_NoRefl tvs orig_co = foldr go orig_co tvs
+-- | Like 'mkHomoForAllCos', but the inner coercion shouldn't be an obvious
+-- reflexive coercion. For example, it is guaranteed in 'mkHomoForAllCos'.
+mkHomoForAllCos_NoRefl :: [TyCoVar] -> Coercion -> Coercion
+mkHomoForAllCos_NoRefl tvs orig_co
+  = ASSERT( not (isReflCo orig_co))
+    foldr go orig_co tvs
   where
-    go tv co = ForAllCo tv (mkNomReflCo (tyVarKind tv)) co
+    go tv co = mkForAllCo_NoRefl tv (mkNomReflCo (varType tv)) co
 
 mkCoVarCo :: CoVar -> Coercion
 -- cv :: s ~# t
@@ -831,7 +821,7 @@ mkAxInstCo role ax index tys cos
                   = splitAt arity rtys
     ax_role       = coAxiomRole ax
 
--- worker function; just checks to see if it should produce Refl
+-- worker function
 mkAxiomInstCo :: CoAxiom Branched -> BranchIndex -> [Coercion] -> Coercion
 mkAxiomInstCo ax index args
   = ASSERT( args `lengthIs` coAxiomArity ax index )
@@ -940,8 +930,9 @@ mkNthCo r n co
     go r 0 co
       | Just (ty, _) <- isReflCo_maybe co
       , Just (tv, _) <- splitForAllTy_maybe ty
-      = ASSERT( r == Nominal )
-        mkReflCo r (tyVarKind tv)
+      = -- works for both tyvar and covar
+        ASSERT( r == Nominal )
+        mkNomReflCo (varType tv)
 
     go r n co
       | Just (ty, r0) <- isReflCo_maybe co
@@ -963,6 +954,8 @@ mkNthCo r n co
         kind_co
       -- If co :: (forall a1:k1. t1) ~ (forall a2:k2. t2)
       -- then (nth 0 co :: k1 ~N k2)
+      -- If co :: (forall a1:t1 ~ t2. t1) ~ (forall a2:t3 ~ t4. t2)
+      -- then (nth 0 co :: (t1 ~ t2) ~N (t3 ~ t4))
 
     go r n co@(FunCo r0 arg res)
       -- See Note [Function coercions]
@@ -1058,9 +1051,10 @@ mkLRCo lr co
 
 -- | Instantiates a 'Coercion'.
 mkInstCo :: Coercion -> Coercion -> Coercion
-mkInstCo (ForAllCo tv _kind_co body_co) co
+mkInstCo (ForAllCo tcv _kind_co body_co) co
   | Just (arg, _) <- isReflCo_maybe co
-  = substCoWithUnchecked [tv] [arg] body_co
+      -- works for both tyvar and covar
+  = substCoUnchecked (zipTCvSubst [tcv] [arg]) body_co
 mkInstCo co arg = InstCo co arg
 
 -- | Given @ty :: k1@, @co :: k1 ~ k2@,
@@ -1081,7 +1075,7 @@ mkGReflLeftCo r ty co
     -- instead of @isReflCo@
   | otherwise    = mkSymCo $ GRefl r ty (MCo co)
 
--- | Given @ty :: k2@, @co :: k1 ~ k2@, @co2:: ty ~ ty'@,
+-- | Given @ty :: k1@, @co :: k1 ~ k2@, @co2:: ty ~ ty'@,
 -- produces @co' :: (ty |> co) ~r ty'
 -- It is not only a utility function, but it saves allocation when co
 -- is a GRefl coercion.
@@ -1090,7 +1084,7 @@ mkCoherenceLeftCo r ty co co2
   | isGReflCo co = co2
   | otherwise = (mkSymCo $ GRefl r ty (MCo co)) `mkTransCo` co2
 
--- | Given @ty :: k2@, @co :: k1 ~ k2@, @co2:: ty' ~ ty@,
+-- | Given @ty :: k1@, @co :: k1 ~ k2@, @co2:: ty' ~ ty@,
 -- produces @co' :: ty' ~r (ty |> co)
 -- It is not only a utility function, but it saves allocation when co
 -- is a GRefl coercion.
@@ -1310,11 +1304,18 @@ promoteCoercion co = case co of
       | otherwise
       -> mkKindCo co
 
-    ForAllCo _ _ g
+    ForAllCo tv _ g
+      | isTyVar tv
       -> promoteCoercion g
 
+    ForAllCo _ _ _
+      -> ASSERT( False )
+         mkNomReflCo liftedTypeKind
+      -- See Note [Weird typing rule for ForAllTy] in Type
+
     FunCo _ _ _
-      -> mkNomReflCo liftedTypeKind
+      -> ASSERT( False )
+         mkNomReflCo liftedTypeKind
 
     CoVarCo {}     -> mkKindCo co
     HoleCo {}      -> mkKindCo co
@@ -1354,7 +1355,13 @@ promoteCoercion co = case co of
       -> mkKindCo co
 
     InstCo g _
-      -> promoteCoercion g
+      | isForAllTy_ty ty1
+      -> ASSERT( isForAllTy_ty ty2 )
+         promoteCoercion g
+      | otherwise
+      -> ASSERT( False)
+         mkNomReflCo liftedTypeKind
+           -- See Note [Weird typing rule for ForAllTy] in Type
 
     KindCo _
       -> ASSERT( False )
@@ -1373,15 +1380,21 @@ promoteCoercion co = case co of
 -- fails if this is not possible, if @g@ coerces between a forall and an ->
 -- or if second parameter has a representational role and can't be used
 -- with an InstCo.
-instCoercion :: Pair Type -- type of the first coercion
-             -> CoercionN  -- ^ must be nominal
+instCoercion :: Pair Type -- g :: lty ~ rty
+             -> CoercionN  -- ^  must be nominal
              -> Coercion
              -> Maybe CoercionN
 instCoercion (Pair lty rty) g w
-  | isForAllTy lty && isForAllTy rty
+  | (isForAllTy_ty lty && isForAllTy_ty rty)
+  || (isForAllTy_co lty && isForAllTy_co rty)
   , Just w' <- setNominalRole_maybe (coercionRole w) w
+    -- g :: (forall t1. t2) ~ (forall t1. t3)
+    -- w :: s1 ~ s2
+    -- returns mkInstCo g w' :: t2 [t1 |-> s1 ] ~ t3 [t1 |-> s2]
   = Just $ mkInstCo g w'
   | isFunTy lty && isFunTy rty
+    -- g :: (t1 -> t2) ~ (t3 -> t4)
+    -- returns t2 ~ t4
   = Just $ mkNthCo Nominal 3 g -- extract result type, which is the 4th argument to (->)
   | otherwise -- one forall, one funty...
   = Nothing
@@ -1424,9 +1437,16 @@ mkPiCos :: Role -> [Var] -> Coercion -> Coercion
 mkPiCos r vs co = foldr (mkPiCo r) co vs
 
 -- | Make a forall 'Coercion', where both types related by the coercion
--- are quantified over the same type variable.
+-- are quantified over the same variable.
 mkPiCo  :: Role -> Var -> Coercion -> Coercion
 mkPiCo r v co | isTyVar v = mkHomoForAllCos [v] co
+              | isCoVar v = ASSERT( not (v `elemVarSet` tyCoVarsOfCo co) )
+                  -- We didn't call mkForAllCo here because if v does not appear
+                  -- in co, the argement coercion will be nominal. But here we
+                  -- want it to be r. It is only called in 'mkPiCos', which is
+                  -- only used in SimplUtils, where we are sure for
+                  -- now (Aug 2018) v won't occur in co.
+                            mkFunCo r (mkReflCo r (varType v)) co
               | otherwise = mkFunCo r (mkReflCo r (varType v)) co
 
 -- mkCoCast (c :: s1 ~?r t1) (g :: (s1 ~?r t1) ~#R (s2 ~?r t2)) :: s2 ~?r t2
@@ -1626,6 +1646,40 @@ thus giving *coercion*.  This is what liftCoSubst does.
 In the presence of kind coercions, this is a bit
 of a hairy operation. So, we refer you to the paper introducing kind coercions,
 available at www.cis.upenn.edu/~sweirich/papers/fckinds-extended.pdf
+
+Note [extendLiftingContextEx]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Consider we have datatype
+  K :: \/k. \/a::k. P -> T k  -- P be some type
+  g :: T k1 ~ T k2
+
+  case (K @k1 @t1 x) |> g of
+    K y -> rhs
+
+We want to push the coercion inside the constructor application.
+We first get the coercion mapped by the universal type variable k:
+   lc = k |-> Nth 0 g :: k1~k2
+
+Here, the important point is that the kind of a is coerced, and P might be
+dependent on the existential type variable a.
+Thus we first get the coercion of a's kind
+   g2 = liftCoSubst lc k :: k1 ~ k2
+
+Then we store a new mapping into the lifting context
+   lc2 = a |-> (t1 ~ t1 |> g2), lc
+
+So later when we can correctly deal with the argument type P
+   liftCoSubst lc2 P :: P [k|->k1][a|->t1] ~ P[k|->k2][a |-> (t1|>g2)]
+
+This is exactly what extendLiftingContextEx does.
+* For each (tyvar:k, ty) pair, we product the mapping
+    tyvar |-> (ty ~ ty |> (liftCoSubst lc k))
+* For each (covar:s1~s2, ty) pair, we produce the mapping
+    covar |-> (co ~ co')
+    co' = Sym (liftCoSubst lc s1) ;; covar ;; liftCoSubst lc s2 :: s1'~s2'
+
+This follows the lifting context extension definition in the
+"FC with Explicit Kind Equality" paper.
 -}
 
 -- ----------------------------------------------------
@@ -1643,21 +1697,21 @@ instance Outputable LiftingContext where
 type LiftCoEnv = VarEnv Coercion
      -- Maps *type variables* to *coercions*.
      -- That's the whole point of this function!
+     -- Also maps coercion variables to ProofIrrelCos.
 
 -- like liftCoSubstWith, but allows for existentially-bound types as well
 liftCoSubstWithEx :: Role          -- desired role for output coercion
                   -> [TyVar]       -- universally quantified tyvars
                   -> [Coercion]    -- coercions to substitute for those
-                  -> [TyVar]       -- existentially quantified tyvars
-                  -> [Type]        -- types to be bound to ex vars
+                  -> [TyCoVar]     -- existentially quantified tycovars
+                  -> [Type]        -- types and coercions to be bound to ex vars
                   -> (Type -> Coercion, [Type]) -- (lifting function, converted ex args)
 liftCoSubstWithEx role univs omegas exs rhos
   = let theta = mkLiftingContext (zipEqual "liftCoSubstWithExU" univs omegas)
         psi   = extendLiftingContextEx theta (zipEqual "liftCoSubstWithExX" exs rhos)
-    in (ty_co_subst psi role, substTyVars (lcSubstRight psi) exs)
+    in (ty_co_subst psi role, substTys (lcSubstRight psi) (mkTyCoVarTys exs))
 
 liftCoSubstWith :: Role -> [TyCoVar] -> [Coercion] -> Type -> Coercion
--- NB: This really can be called with CoVars, when optimising axioms.
 liftCoSubstWith r tvs cos ty
   = liftCoSubst r (mkLiftingContext $ zipEqual "liftCoSubstWith" tvs cos) ty
 
@@ -1681,32 +1735,30 @@ mkLiftingContext pairs
 mkSubstLiftingContext :: TCvSubst -> LiftingContext
 mkSubstLiftingContext subst = LC subst emptyVarEnv
 
--- | Extend a lifting context with a new /type/ mapping.
+-- | Extend a lifting context with a new mapping.
 extendLiftingContext :: LiftingContext  -- ^ original LC
-                     -> TyVar           -- ^ new variable to map...
+                     -> TyCoVar         -- ^ new variable to map...
                      -> Coercion        -- ^ ...to this lifted version
                      -> LiftingContext
     -- mappings to reflexive coercions are just substitutions
 extendLiftingContext (LC subst env) tv arg
   | Just (ty, _) <- isReflCo_maybe arg
-  = LC (extendTvSubst subst tv ty) env
+  = LC (extendTCvSubst subst tv ty) env
   | otherwise
-  = ASSERT( isTyVar tv )
-    LC subst (extendVarEnv env tv arg)
+  = LC subst (extendVarEnv env tv arg)
 
 -- | Extend a lifting context with a new mapping, and extend the in-scope set
 extendLiftingContextAndInScope :: LiftingContext  -- ^ Original LC
-                               -> TyVar           -- ^ new variable to map...
+                               -> TyCoVar         -- ^ new variable to map...
                                -> Coercion        -- ^ to this coercion
                                -> LiftingContext
 extendLiftingContextAndInScope (LC subst env) tv co
   = extendLiftingContext (LC (extendTCvInScopeSet subst (tyCoVarsOfCo co)) env) tv co
 
 -- | Extend a lifting context with existential-variable bindings.
--- This follows the lifting context extension definition in the
--- "FC with Explicit Kind Equality" paper.
+-- See Note [extendLiftingContextEx]
 extendLiftingContextEx :: LiftingContext    -- ^ original lifting context
-                       -> [(TyVar,Type)]    -- ^ ex. var / value pairs
+                       -> [(TyCoVar,Type)]  -- ^ ex. var / value pairs
                        -> LiftingContext
 -- Note that this is more involved than extendLiftingContext. That function
 -- takes a coercion to extend with, so it's assumed that the caller has taken
@@ -1716,12 +1768,33 @@ extendLiftingContextEx lc@(LC subst env) ((v,ty):rest)
 -- This function adds bindings for *Nominal* coercions. Why? Because it
 -- works with existentially bound variables, which are considered to have
 -- nominal roles.
+  | isTyVar v
   = let lc' = LC (subst `extendTCvInScopeSet` tyCoVarsOfType ty)
                  (extendVarEnv env v $
                   mkGReflRightCo Nominal
                                  ty
                                  (ty_co_subst lc Nominal (tyVarKind v)))
     in extendLiftingContextEx lc' rest
+  | CoercionTy co <- ty
+  = -- co      :: s1 ~r s2
+    -- lift_s1 :: s1 ~r s1'
+    -- lift_s2 :: s2 ~r s2'
+    -- kco     :: (s1 ~r s2) ~N (s1' ~r s2')
+    ASSERT( isCoVar v )
+    let (_, _, s1, s2, r) = coVarKindsTypesRole v
+        lift_s1 = ty_co_subst lc r s1
+        lift_s2 = ty_co_subst lc r s2
+        kco     = mkTyConAppCo Nominal (equalityTyCon r)
+                               [ mkKindCo lift_s1, mkKindCo lift_s2
+                               , lift_s1         , lift_s2          ]
+        lc'     = LC (subst `extendTCvInScopeSet` tyCoVarsOfCo co)
+                     (extendVarEnv env v
+                        (mkProofIrrelCo Nominal kco co $
+                          (mkSymCo lift_s1) `mkTransCo` co `mkTransCo` lift_s2))
+    in extendLiftingContextEx lc' rest
+  | otherwise
+  = pprPanic "extendLiftingContextEx" (ppr v <+> text "|->" <+> ppr ty)
+
 
 -- | Erase the environments in a lifting context
 zapLiftingContext :: LiftingContext -> LiftingContext
@@ -1730,8 +1803,8 @@ zapLiftingContext (LC subst _) = LC (zapTCvSubst subst) emptyVarEnv
 -- | Like 'substForAllCoBndr', but works on a lifting context
 substForAllCoBndrUsingLC :: Bool
                             -> (Coercion -> Coercion)
-                            -> LiftingContext -> TyVar -> Coercion
-                            -> (LiftingContext, TyVar, Coercion)
+                            -> LiftingContext -> TyCoVar -> Coercion
+                            -> (LiftingContext, TyCoVar, Coercion)
 substForAllCoBndrUsingLC sym sco (LC subst lc_env) tv co
   = (LC subst' lc_env, tv', co')
   where
@@ -1754,7 +1827,7 @@ ty_co_subst lc role ty
     go r (AppTy ty1 ty2)   = mkAppCo (go r ty1) (go Nominal ty2)
     go r (TyConApp tc tys) = mkTyConAppCo r tc (zipWith go (tyConRolesX r tc) tys)
     go r (FunTy ty1 ty2)   = mkFunCo r (go r ty1) (go r ty2)
-    go r (ForAllTy (TvBndr v _) ty)
+    go r (ForAllTy (Bndr v _) ty)
                            = let (lc', v', h) = liftCoSubstVarBndr lc v in
                              mkForAllCo v' h $! ty_co_subst lc' r ty
     go r ty@(LitTy {})     = ASSERT( r == Nominal )
@@ -1791,8 +1864,46 @@ liftCoSubstTyVar (LC subst env) r v
   | otherwise
   = Just $ mkReflCo r (substTyVar subst v)
 
-liftCoSubstVarBndr :: LiftingContext -> TyVar
-                   -> (LiftingContext, TyVar, Coercion)
+{- Note [liftCoSubstVarBndr]
+
+callback:
+  We want 'liftCoSubstVarBndrUsing' to be general enough to be reused in
+  FamInstEnv, therefore the input arg 'fun' returns a pair with polymophic type
+  in snd.
+  However in 'liftCoSubstVarBndr', we don't need the snd, so we use unit and
+  ignore the fourth componenet of the return value.
+
+liftCoSubstTyVarBndrUsing:
+  Given
+    forall tv:k. t
+  We want to get
+    forall (tv:k1) (kind_co :: k1 ~ k2) body_co
+
+  We lift the kind k to get the kind_co
+    kind_co = ty_co_subst k :: k1 ~ k2
+
+  Now in the LiftingContext, we add the new mapping
+    tv |-> (tv :: k1) ~ ((tv |> kind_co) :: k2)
+
+liftCoSubstCoVarBndrUsing:
+  Given
+    forall cv:(s1 ~ s2). t
+  We want to get
+    forall (cv:s1'~s2') (kind_co :: (s1'~s2') ~ (t1 ~ t2)) body_co
+
+  We lift s1 and s2 respectively to get
+    eta1 :: s1' ~ t1
+    eta2 :: s2' ~ t2
+  And
+    kind_co = TyConAppCo Nominal (~#) eta1 eta2
+
+  Now in the liftingContext, we add the new mapping
+    cv |-> (cv :: s1' ~ s2') ~ ((sym eta1;cv;eta2) :: t1 ~ t2)
+-}
+
+-- See Note [liftCoSubstVarBndr]
+liftCoSubstVarBndr :: LiftingContext -> TyCoVar
+                   -> (LiftingContext, TyCoVar, Coercion)
 liftCoSubstVarBndr lc tv
   = let (lc', tv', h, _) = liftCoSubstVarBndrUsing callback lc tv in
     (lc', tv', h)
@@ -1800,11 +1911,22 @@ liftCoSubstVarBndr lc tv
     callback lc' ty' = (ty_co_subst lc' Nominal ty', ())
 
 -- the callback must produce a nominal coercion
-liftCoSubstVarBndrUsing :: (LiftingContext -> Type -> (Coercion, a))
+liftCoSubstVarBndrUsing :: (LiftingContext -> Type -> (CoercionN, a))
+                           -> LiftingContext -> TyCoVar
+                           -> (LiftingContext, TyCoVar, CoercionN, a)
+liftCoSubstVarBndrUsing fun lc old_var
+  | isTyVar old_var
+  = liftCoSubstTyVarBndrUsing fun lc old_var
+  | otherwise
+  = liftCoSubstCoVarBndrUsing fun lc old_var
+
+-- Works for tyvar binder
+liftCoSubstTyVarBndrUsing :: (LiftingContext -> Type -> (CoercionN, a))
                            -> LiftingContext -> TyVar
-                           -> (LiftingContext, TyVar, Coercion, a)
-liftCoSubstVarBndrUsing fun lc@(LC subst cenv) old_var
-  = ( LC (subst `extendTCvInScope` new_var) new_cenv
+                           -> (LiftingContext, TyVar, CoercionN, a)
+liftCoSubstTyVarBndrUsing fun lc@(LC subst cenv) old_var
+  = ASSERT( isTyVar old_var )
+    ( LC (subst `extendTCvInScope` new_var) new_cenv
     , new_var, eta, stuff )
   where
     old_kind     = tyVarKind old_var
@@ -1812,7 +1934,45 @@ liftCoSubstVarBndrUsing fun lc@(LC subst cenv) old_var
     Pair k1 _    = coercionKind eta
     new_var      = uniqAway (getTCvInScope subst) (setVarType old_var k1)
 
-    lifted   = GRefl Nominal (TyVarTy new_var) (MCo eta)
+    lifted   = mkGReflRightCo Nominal (TyVarTy new_var) eta
+               -- :: new_var ~ new_var |> eta
+    new_cenv = extendVarEnv cenv old_var lifted
+
+-- Works for covar binder
+liftCoSubstCoVarBndrUsing :: (LiftingContext -> Type -> (CoercionN, a))
+                           -> LiftingContext -> CoVar
+                           -> (LiftingContext, CoVar, CoercionN, a)
+liftCoSubstCoVarBndrUsing fun lc@(LC subst cenv) old_var
+  = ASSERT( isCoVar old_var )
+    ( LC (subst `extendTCvInScope` new_var) new_cenv
+    , new_var, kind_co, stuff )
+  where
+    old_kind     = coVarKind old_var
+    (eta, stuff) = fun lc old_kind
+    Pair k1 _    = coercionKind eta
+    new_var      = uniqAway (getTCvInScope subst) (setVarType old_var k1)
+
+    -- old_var :: s1  ~r s2
+    -- eta     :: (s1' ~r s2') ~N (t1 ~r t2)
+    -- eta1    :: s1' ~r t1
+    -- eta2    :: s2' ~r t2
+    -- co1     :: s1' ~r s2'
+    -- co2     :: t1  ~r t2
+    -- kind_co :: (s1' ~r s2') ~N (t1 ~r t2)
+    -- lifted  :: co1 ~N co2
+
+    role   = coVarRole old_var
+    eta'   = downgradeRole role Nominal eta
+    eta1   = mkNthCo role 2 eta'
+    eta2   = mkNthCo role 3 eta'
+
+    co1     = mkCoVarCo new_var
+    co2     = mkSymCo eta1 `mkTransCo` co1 `mkTransCo` eta2
+    kind_co = mkTyConAppCo Nominal (equalityTyCon role)
+                           [ mkKindCo co1, mkKindCo co2
+                           , co1         , co2          ]
+    lifted  = mkProofIrrelCo Nominal kind_co co1 co2
+
     new_cenv = extendVarEnv cenv old_var lifted
 
 -- | Is a var in the domain of a lifting context?
@@ -1892,8 +2052,8 @@ seqCo (Refl ty)                 = seqType ty
 seqCo (GRefl r ty mco)          = r `seq` seqType ty `seq` seqMCo mco
 seqCo (TyConAppCo r tc cos)     = r `seq` tc `seq` seqCos cos
 seqCo (AppCo co1 co2)           = seqCo co1 `seq` seqCo co2
-seqCo (ForAllCo tv k co)        = seqType (tyVarKind tv) `seq` seqCo k
-                                                         `seq` seqCo co
+seqCo (ForAllCo tv k co)        = seqType (varType tv) `seq` seqCo k
+                                                       `seq` seqCo co
 seqCo (FunCo r co1 co2)         = r `seq` seqCo co1 `seq` seqCo co2
 seqCo (CoVarCo cv)              = cv `seq` ()
 seqCo (HoleCo h)                = coHoleCoVar h `seq` ()
@@ -1925,19 +2085,6 @@ seqCos (co:cos) = seqCo co `seq` seqCos cos
              The kind of a type, and of a coercion
 %*                                                                      *
 %************************************************************************
-
-Note [Computing a coercion kind and role]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-To compute a coercion's kind is straightforward: see coercionKind.
-But to compute a coercion's role, in the case for NthCo we need
-its kind as well.  So if we have two separate functions (one for kinds
-and one for roles) we can get exponentially bad behaviour, since each
-NthCo node makes a separate call to coercionKind, which traverses the
-sub-tree again.  This was part of the problem in Trac #9233.
-
-Solution: compute both together; hence coercionKindRole.  We keep a
-separate coercionKind function because it's a bit more efficient if
-the kind is all you want.
 -}
 
 coercionType :: Coercion -> Type
@@ -1960,8 +2107,8 @@ coercionKind co =
     go (GRefl _ ty (MCo co1)) = Pair ty (mkCastTy ty co1)
     go (TyConAppCo _ tc cos)= mkTyConApp tc <$> (sequenceA $ map go cos)
     go (AppCo co1 co2)      = mkAppTy <$> go co1 <*> go co2
-    go co@(ForAllCo tv1 k_co co1)
-       | isGReflCo k_co           = mkInvForAllTy tv1 <$> go co1
+    go co@(ForAllCo tv1 k_co co1) -- works for both tyvar and covar
+       | isGReflCo k_co           = mkTyCoInvForAllTy tv1 <$> go co1
          -- kind_co always has kind @Type@, thus @isGReflCo@
        | otherwise                = go_forall empty_subst co
        where
@@ -2016,6 +2163,7 @@ coercionKind co =
 
     go_forall subst (ForAllCo tv1 k_co co)
       -- See Note [Nested ForAllCos]
+      | isTyVar tv1
       = mkInvForAllTy <$> Pair tv1 tv2 <*> go_forall subst' co
       where
         Pair _ k2 = go k_co
@@ -2024,7 +2172,32 @@ coercionKind co =
                  -- kind_co always has kind @Type@, thus @isGReflCo@
                | otherwise      = extendTvSubst (extendTCvInScope subst tv2) tv1 $
                                   TyVarTy tv2 `mkCastTy` mkSymCo k_co
+    go_forall subst (ForAllCo cv1 k_co co)
+      | isCoVar cv1
+      = mkTyCoInvForAllTy <$> Pair cv1 cv2 <*> go_forall subst' co
+      where
+        Pair _ k2 = go k_co
+        r         = coVarRole cv1
+        eta1      = mkNthCo r 2 (downgradeRole r Nominal k_co)
+        eta2      = mkNthCo r 3 (downgradeRole r Nominal k_co)
+
+        -- k_co :: (t1 ~r t2) ~N (s1 ~r s2)
+        -- k1    = t1 ~r t2
+        -- k2    = s1 ~r s2
+        -- cv1  :: t1 ~r t2
+        -- cv2  :: s1 ~r s2
+        -- eta1 :: t1 ~r s1
+        -- eta2 :: t2 ~r s2
+        -- n_subst  = (eta1 ; cv2 ; sym eta2) :: t1 ~r t2
+
+        cv2     = setVarType cv1 (substTy subst k2)
+        n_subst = eta1 `mkTransCo` (mkCoVarCo cv2) `mkTransCo` (mkSymCo eta2)
+        subst'  | isReflCo k_co = extendTCvInScope subst cv1
+                | otherwise     = extendCvSubst (extendTCvInScope subst cv2)
+                                                cv1 n_subst
+
     go_forall subst other_co
+      -- when other_co is not a ForAllCo
       = substTy subst `pLiftSnd` go other_co
 
 {-
@@ -2049,7 +2222,6 @@ coercionKinds :: [Coercion] -> Pair [Type]
 coercionKinds tys = sequenceA $ map coercionKind tys
 
 -- | Get a coercion's kind and role.
--- Why both at once?  See Note [Computing a coercion kind and role]
 coercionKindRole :: Coercion -> (Pair Type, Role)
 coercionKindRole co = (coercionKind co, coercionRole co)
 
@@ -2134,14 +2306,40 @@ buildCoercion orig_ty1 orig_ty2 = go orig_ty1 orig_ty2
       | Just (ty1a, ty1b) <- repSplitAppTy_maybe ty1
       = mkAppCo (go ty1a ty2a) (go ty1b ty2b)
 
-    go (ForAllTy (TvBndr tv1 _flag1) ty1) (ForAllTy (TvBndr tv2 _flag2) ty2)
-      = let kind_co  = go (tyVarKind tv1) (tyVarKind tv2)
+    go (ForAllTy (Bndr tv1 _flag1) ty1) (ForAllTy (Bndr tv2 _flag2) ty2)
+      | isTyVar tv1
+      = ASSERT( isTyVar tv2 )
+        mkForAllCo tv1 kind_co (go ty1 ty2')
+      where kind_co  = go (tyVarKind tv1) (tyVarKind tv2)
             in_scope = mkInScopeSet $ tyCoVarsOfType ty2 `unionVarSet` tyCoVarsOfCo kind_co
             ty2'     = substTyWithInScope in_scope [tv2]
-                                                   [mkTyVarTy tv1 `mkCastTy` kind_co]
-                                                   ty2
-        in
-        mkForAllCo tv1 kind_co (go ty1 ty2')
+                         [mkTyVarTy tv1 `mkCastTy` kind_co]
+                         ty2
+
+    go (ForAllTy (Bndr cv1 _flag1) ty1) (ForAllTy (Bndr cv2 _flag2) ty2)
+      = ASSERT( isCoVar cv1 && isCoVar cv2 )
+        mkForAllCo cv1 kind_co (go ty1 ty2')
+      where s1 = varType cv1
+            s2 = varType cv2
+            kind_co = go s1 s2
+
+            -- s1 = t1 ~r t2
+            -- s2 = t3 ~r t4
+            -- kind_co :: (t1 ~r t2) ~N (t3 ~r t4)
+            -- eta1 :: t1 ~r t3
+            -- eta2 :: t2 ~r t4
+
+            r    = coVarRole cv1
+            kind_co' = downgradeRole r Nominal kind_co
+            eta1 = mkNthCo r 2 kind_co'
+            eta2 = mkNthCo r 3 kind_co'
+
+            subst = mkEmptyTCvSubst $ mkInScopeSet $
+                      tyCoVarsOfType ty2 `unionVarSet` tyCoVarsOfCo kind_co
+            ty2'  = substTy (extendCvSubst subst cv2 $ mkSymCo eta1 `mkTransCo`
+                                                       mkCoVarCo cv1 `mkTransCo`
+                                                       eta2)
+                            ty2
 
     go ty1@(LitTy lit1) _lit2
       = ASSERT( case _lit2 of
index 636c0da..a5cfba1 100644 (file)
@@ -655,8 +655,8 @@ mkCoAxBranch tvs cvs lhs rhs roles loc
                , cab_loc     = loc
                , cab_incomps = placeHolderIncomps }
   where
-    (env1, tvs1) = tidyTyCoVarBndrs emptyTidyEnv tvs
-    (env,  cvs1) = tidyTyCoVarBndrs env1         cvs
+    (env1, tvs1) = tidyVarBndrs emptyTidyEnv tvs
+    (env,  cvs1) = tidyVarBndrs env1         cvs
     -- See Note [Tidy axioms when we build them]
 
 -- all of the following code is here to avoid mutual dependencies with
@@ -1369,11 +1369,11 @@ normalise_type ty
            ; (co2, nty2) <- go ty2
            ; r <- getRole
            ; return (mkFunCo r co1 co2, mkFunTy nty1 nty2) }
-    go (ForAllTy (TvBndr tyvar vis) ty)
-      = do { (lc', tv', h, ki') <- normalise_tyvar_bndr tyvar
+    go (ForAllTy (Bndr tcvar vis) ty)
+      = do { (lc', tv', h, ki') <- normalise_var_bndr tcvar
            ; (co, nty)          <- withLC lc' $ normalise_type ty
            ; let tv2 = setTyVarKind tv' ki'
-           ; return (mkForAllCo tv' h co, ForAllTy (TvBndr tv2 vis) nty) }
+           ; return (mkForAllCo tv' h co, ForAllTy (Bndr tv2 vis) nty) }
     go (TyVarTy tv)    = normalise_tyvar tv
     go (CastTy ty co)
       = do { (nco, nty) <- go ty
@@ -1400,12 +1400,13 @@ normalise_tyvar tv
            Nothing -> (mkReflCo r ty, ty) }
   where ty = mkTyVarTy tv
 
-normalise_tyvar_bndr :: TyVar -> NormM (LiftingContext, TyVar, Coercion, Kind)
-normalise_tyvar_bndr tv
+normalise_var_bndr :: TyCoVar -> NormM (LiftingContext, TyCoVar, Coercion, Kind)
+normalise_var_bndr tcvar
+  -- works for both tvar and covar
   = do { lc1 <- getLC
        ; env <- getEnv
        ; let callback lc ki = runNormM (normalise_type ki) env lc Nominal
-       ; return $ liftCoSubstVarBndrUsing callback lc1 tv }
+       ; return $ liftCoSubstVarBndrUsing callback lc1 tcvar }
 
 -- | a monad for the normalisation functions, reading 'FamInstEnvs',
 -- a 'LiftingContext', and a 'Role'.
@@ -1504,7 +1505,7 @@ flattenTys in_scope tys = snd $ coreFlattenTys env tys
     -- *anywhere* in the types we're flattening, even if locally-bound in
     -- a forall. That way, we can ensure consistency both within and outside
     -- of that forall.
-    all_in_scope = in_scope `extendInScopeSetSet` allTyVarsInTys tys
+    all_in_scope = in_scope `extendInScopeSetSet` allTyCoVarsInTys tys
     env          = emptyFlattenEnv all_in_scope
 
 coreFlattenTys :: FlattenEnv -> [Type] -> (FlattenEnv, [Type])
@@ -1539,10 +1540,10 @@ coreFlattenTy = go
                                  (env2, ty2') = go env1 ty2 in
                              (env2, mkFunTy ty1' ty2')
 
-    go env (ForAllTy (TvBndr tv vis) ty)
+    go env (ForAllTy (Bndr tv vis) ty)
       = let (env1, tv') = coreFlattenVarBndr env tv
             (env2, ty') = go env1 ty in
-        (env2, ForAllTy (TvBndr tv' vis) ty')
+        (env2, ForAllTy (Bndr tv' vis) ty')
 
     go env ty@(LitTy {}) = (env, ty)
 
@@ -1566,20 +1567,20 @@ coreFlattenCo env co
     covar         = uniqAway in_scope (mkCoVar fresh_name kind')
     env2          = env1 { fe_subst = subst1 `extendTCvInScope` covar }
 
-coreFlattenVarBndr :: FlattenEnv -> TyVar -> (FlattenEnv, TyVar)
+coreFlattenVarBndr :: FlattenEnv -> TyCoVar -> (FlattenEnv, TyCoVar)
 coreFlattenVarBndr env tv
   | kind' `eqType` kind
-  = ( env { fe_subst = extendTvSubst old_subst tv (mkTyVarTy tv) }
+  = ( env { fe_subst = extendTCvSubst old_subst tv (mkTyCoVarTy tv) }
              -- override any previous binding for tv
     , tv)
 
   | otherwise
-  = let new_tv    = uniqAway (getTCvInScope old_subst) (setTyVarKind tv kind')
-        new_subst = extendTvSubstWithClone old_subst tv new_tv
+  = let new_tv    = uniqAway (getTCvInScope old_subst) (setVarType tv kind')
+        new_subst = extendTCvSubstWithClone old_subst tv new_tv
     in
     (env' { fe_subst = new_subst }, new_tv)
   where
-    kind          = tyVarKind tv
+    kind          = varType tv
     (env', kind') = coreFlattenTy env kind
     old_subst     = fe_subst env
 
@@ -1605,24 +1606,24 @@ coreFlattenTyFamApp env fam_tc fam_args
         FlattenEnv { fe_type_map = type_map
                    , fe_subst = subst } = env
 
--- | Get the set of all type variables mentioned anywhere in the list
+-- | Get the set of all type/coercion variables mentioned anywhere in the list
 -- of types. These variables are not necessarily free.
-allTyVarsInTys :: [Type] -> VarSet
-allTyVarsInTys []       = emptyVarSet
-allTyVarsInTys (ty:tys) = allTyVarsInTy ty `unionVarSet` allTyVarsInTys tys
+allTyCoVarsInTys :: [Type] -> VarSet
+allTyCoVarsInTys []       = emptyVarSet
+allTyCoVarsInTys (ty:tys) = allTyCoVarsInTy ty `unionVarSet` allTyCoVarsInTys tys
 
--- | Get the set of all type variables mentioned anywhere in a type.
-allTyVarsInTy :: Type -> VarSet
-allTyVarsInTy = go
+-- | Get the set of all type/coercion variables mentioned anywhere in a type.
+allTyCoVarsInTy :: Type -> VarSet
+allTyCoVarsInTy = go
   where
     go (TyVarTy tv)      = unitVarSet tv
-    go (TyConApp _ tys)  = allTyVarsInTys tys
+    go (TyConApp _ tys)  = allTyCoVarsInTys tys
     go (AppTy ty1 ty2)   = (go ty1) `unionVarSet` (go ty2)
     go (FunTy ty1 ty2)   = (go ty1) `unionVarSet` (go ty2)
-    go (ForAllTy (TvBndr tv _) ty) = unitVarSet tv     `unionVarSet`
-                                     go (tyVarKind tv) `unionVarSet`
-                                     go ty
-                                     -- Don't remove the tv from the set!
+    go (ForAllTy (Bndr tv _) ty) = unitVarSet tv     `unionVarSet`
+                                   go (tyVarKind tv) `unionVarSet`
+                                   go ty
+                                   -- Don't remove the tv from the set!
     go (LitTy {})        = emptyVarSet
     go (CastTy ty co)    = go ty `unionVarSet` go_co co
     go (CoercionTy co)   = go_co co
index 5dd7c0c..8a44b86 100644 (file)
@@ -55,6 +55,7 @@ opt_co2.
 
 Note [Optimising InstCo]
 ~~~~~~~~~~~~~~~~~~~~~~~~
+(1) tv is a type variable
 When we have (InstCo (ForAllCo tv h g) g2), we want to optimise.
 
 Let's look at the typing rules.
@@ -81,6 +82,30 @@ this operation already exists: it's called *lifting*, and defined in Coercion.
 We just need to enhance the lifting operation to be able to deal with
 an ambient substitution, which is why a LiftingContext stores a TCvSubst.
 
+(2) cv is a coercion variable
+Now consider we have (InstCo (ForAllCo cv h g) g2), we want to optimise.
+
+h : (t1 ~r t2) ~N (t3 ~r t4)
+cv : t1 ~r t2 |- g : t1' ~r2 t2'
+n1 = nth r 2 (downgradeRole r N h) :: t1 ~r t3
+n2 = nth r 3 (downgradeRole r N h) :: t2 ~r t4
+------------------------------------------------
+ForAllCo cv h g : (all cv:t1 ~r t2. t1') ~r2
+                  (all cv:t3 ~r t4. t2'[cv |-> n1 ; cv ; sym n2])
+
+g1 : (all cv:t1 ~r t2. t1') ~ (all cv: t3 ~r t4. t2')
+g2 : h1 ~N h2
+h1 : t1 ~r t2
+h2 : t3 ~r t4
+------------------------------------------------
+InstCo g1 g2 : t1'[cv |-> h1] ~ t2'[cv |-> h2]
+
+We thus want some coercion proving this:
+
+  t1'[cv |-> h1] ~ t2'[cv |-> n1 ; h2; sym n2]
+
+So we substitute the coercion variable c for the coercion
+(h1 ~N (n1; h2; sym n2)) in g.
 -}
 
 optCoercion :: DynFlags -> TCvSubst -> Coercion -> NormalCo
@@ -299,13 +324,15 @@ opt_co4 env _sym rep r (NthCo _r n co)
   | Just (ty, _) <- isReflCo_maybe co
   , n == 0
   , Just (tv, _) <- splitForAllTy_maybe ty
-  = liftCoSubst (chooseRole rep r) env (tyVarKind tv)
+      -- works for both tyvar and covar
+  = liftCoSubst (chooseRole rep r) env (varType tv)
 
 opt_co4 env sym rep r (NthCo r1 n (TyConAppCo _ _ cos))
   = ASSERT( r == r1 )
     opt_co4_wrap env sym rep r (cos `getNth` n)
 
 opt_co4 env sym rep r (NthCo _r n (ForAllCo _ eta _))
+      -- works for both tyvar and covar
   = ASSERT( r == _r )
     ASSERT( n == 0 )
     opt_co4_wrap env sym rep Nominal eta
@@ -348,26 +375,58 @@ opt_co4 env sym rep r (LRCo lr co)
 -- See Note [Optimising InstCo]
 opt_co4 env sym rep r (InstCo co1 arg)
     -- forall over type...
-  | Just (tv, kind_co, co_body) <- splitForAllCo_maybe co1
+  | Just (tv, kind_co, co_body) <- splitForAllCo_ty_maybe co1
   = opt_co4_wrap (extendLiftingContext env tv
                     (mkCoherenceRightCo Nominal t2 (mkSymCo kind_co) arg'))
+                   -- kind_co :: k1 ~ k2
+                   -- arg' :: (t1 :: k1) ~ (t2 :: k2)
+                   -- tv |-> (t1 :: k1) ~ (((t2 :: k2) |> (sym kind_co)) :: k1)
                  sym rep r co_body
 
+    -- forall over coercion...
+  | Just (cv, kind_co, co_body) <- splitForAllCo_co_maybe co1
+  , CoercionTy h1 <- t1
+  , CoercionTy h2 <- t2
+  = let new_co = mk_new_co cv (opt_co4_wrap env sym False Nominal kind_co) h1 h2
+    in opt_co4_wrap (extendLiftingContext env cv new_co) sym rep r co_body
+
     -- See if it is a forall after optimization
     -- If so, do an inefficient one-variable substitution, then re-optimize
 
     -- forall over type...
-  | Just (tv', kind_co', co_body') <- splitForAllCo_maybe co1'
+  | Just (tv', kind_co', co_body') <- splitForAllCo_ty_maybe co1'
   = opt_co4_wrap (extendLiftingContext (zapLiftingContext env) tv'
                     (mkCoherenceRightCo Nominal t2 (mkSymCo kind_co') arg'))
             False False r' co_body'
 
+    -- forall over coercion...
+  | Just (cv', kind_co', co_body') <- splitForAllCo_co_maybe co1'
+  , CoercionTy h1 <- t1
+  , CoercionTy h2 <- t2
+  = let new_co = mk_new_co cv' kind_co' h1 h2
+    in opt_co4_wrap (extendLiftingContext (zapLiftingContext env) cv' new_co)
+                    False False r' co_body'
+
   | otherwise = InstCo co1' arg'
   where
     co1' = opt_co4_wrap env sym rep r co1
     r'   = chooseRole rep r
     arg' = opt_co4_wrap env sym False Nominal arg
-    Pair _ t2 = coercionKind arg'
+    Pair t1 t2 = coercionKind arg'
+
+    mk_new_co cv kind_co h1 h2
+      = let -- h1 :: (t1 ~ t2)
+            -- h2 :: (t3 ~ t4)
+            -- kind_co :: (t1 ~ t2) ~ (t3 ~ t4)
+            -- n1 :: t1 ~ t3
+            -- n2 :: t2 ~ t4
+            -- new_co = (h1 :: t1 ~ t2) ~ ((n1;h2;sym n2) :: t1 ~ t2)
+            r2  = coVarRole cv
+            kind_co' = downgradeRole r2 Nominal kind_co
+            n1 = mkNthCo r2 2 kind_co'
+            n2 = mkNthCo r2 3 kind_co'
+         in mkProofIrrelCo Nominal (Refl (coercionType h1)) h1
+                           (n1 `mkTransCo` h2 `mkTransCo` (mkSymCo n2))
 
 opt_co4 env sym _rep r (KindCo co)
   = ASSERT( r == Nominal )
@@ -446,8 +505,8 @@ opt_univ env sym prov role oty1 oty2
 
   -- can't optimize the AppTy case because we can't build the kind coercions.
 
-  | Just (tv1, ty1) <- splitForAllTy_maybe oty1
-  , Just (tv2, ty2) <- splitForAllTy_maybe oty2
+  | Just (tv1, ty1) <- splitForAllTy_ty_maybe oty1
+  , Just (tv2, ty2) <- splitForAllTy_ty_maybe oty2
       -- NB: prov isn't interesting here either
   = let k1   = tyVarKind tv1
         k2   = tyVarKind tv2
@@ -459,6 +518,24 @@ opt_univ env sym prov role oty1 oty2
     in
     mkForAllCo tv1' eta' (opt_univ env' sym prov' role ty1 ty2')
 
+  | Just (cv1, ty1) <- splitForAllTy_co_maybe oty1
+  , Just (cv2, ty2) <- splitForAllTy_co_maybe oty2
+      -- NB: prov isn't interesting here either
+  = let k1    = varType cv1
+        k2    = varType cv2
+        r'    = coVarRole cv1
+        eta   = mkUnivCo prov' Nominal k1 k2
+        eta_d = downgradeRole r' Nominal eta
+          -- eta gets opt'ed soon, but not yet.
+        n_co  = (mkSymCo $ mkNthCo r' 2 eta_d) `mkTransCo`
+                (mkCoVarCo cv1) `mkTransCo`
+                (mkNthCo r' 3 eta_d)
+        ty2'  = substTyWithCoVars [cv2] [n_co] ty2
+
+        (env', cv1', eta') = optForAllCoBndr env sym cv1 eta
+    in
+    mkForAllCo cv1' eta' (opt_univ env' sym prov' role ty1 ty2')
+
   | otherwise
   = let ty1 = substTyUnchecked (lcSubstLeft  env) oty1
         ty2 = substTyUnchecked (lcSubstRight env) oty2
@@ -595,28 +672,61 @@ opt_trans_rule is co1 co2@(AppCo co2a co2b)
   = opt_trans_rule_app is co1 co2 co1a [co1b] co2a [co2b]
 
 -- Push transitivity inside forall
+-- forall over types.
 opt_trans_rule is co1 co2
-  | ForAllCo tv1 eta1 r1 <- co1
-  , Just (tv2,eta2,r2) <- etaForAllCo_maybe co2
+  | Just (tv1, eta1, r1) <- splitForAllCo_ty_maybe co1
+  , Just (tv2, eta2, r2) <- etaForAllCo_ty_maybe co2
   = push_trans tv1 eta1 r1 tv2 eta2 r2
 
-  | ForAllCo tv2 eta2 r2 <- co2
-  , Just (tv1,eta1,r1) <- etaForAllCo_maybe co1
+  | Just (tv2, eta2, r2) <- splitForAllCo_ty_maybe co2
+  , Just (tv1, eta1, r1) <- etaForAllCo_ty_maybe co1
   = push_trans tv1 eta1 r1 tv2 eta2 r2
 
   where
   push_trans tv1 eta1 r1 tv2 eta2 r2
     -- Given:
-    --   co1 = \/ tv1 : eta1. r1
-    --   co2 = \/ tv2 : eta2. r2
+    --   co1 = /\ tv1 : eta1. r1
+    --   co2 = /\ tv2 : eta2. r2
     -- Wanted:
-    --   \/tv1 : (eta1;eta2).  (r1; r2[tv2 |-> tv1 |> eta1])
-    = fireTransRule "EtaAllTy" co1 co2 $
+    --   /\tv1 : (eta1;eta2).  (r1; r2[tv2 |-> tv1 |> eta1])
+    = fireTransRule "EtaAllTy_ty" co1 co2 $
       mkForAllCo tv1 (opt_trans is eta1 eta2) (opt_trans is' r1 r2')
     where
       is' = is `extendInScopeSet` tv1
       r2' = substCoWithUnchecked [tv2] [mkCastTy (TyVarTy tv1) eta1] r2
 
+-- Push transitivity inside forall
+-- forall over coercions.
+opt_trans_rule is co1 co2
+  | Just (cv1, eta1, r1) <- splitForAllCo_co_maybe co1
+  , Just (cv2, eta2, r2) <- etaForAllCo_co_maybe co2
+  = push_trans cv1 eta1 r1 cv2 eta2 r2
+
+  | Just (cv2, eta2, r2) <- splitForAllCo_co_maybe co2
+  , Just (cv1, eta1, r1) <- etaForAllCo_co_maybe co1
+  = push_trans cv1 eta1 r1 cv2 eta2 r2
+
+  where
+  push_trans cv1 eta1 r1 cv2 eta2 r2
+    -- Given:
+    --   co1 = /\ cv1 : eta1. r1
+    --   co2 = /\ cv2 : eta2. r2
+    -- Wanted:
+    --   n1 = nth 2 eta1
+    --   n2 = nth 3 eta1
+    --   nco = /\ cv1 : (eta1;eta2). (r1; r2[cv2 |-> (sym n1);cv1;n2])
+    = fireTransRule "EtaAllTy_co" co1 co2 $
+      mkForAllCo cv1 (opt_trans is eta1 eta2) (opt_trans is' r1 r2')
+    where
+      is'  = is `extendInScopeSet` cv1
+      role = coVarRole cv1
+      eta1' = downgradeRole role Nominal eta1
+      n1   = mkNthCo role 2 eta1'
+      n2   = mkNthCo role 3 eta1'
+      r2'  = substCo (zipCvSubst [cv2] [(mkSymCo n1) `mkTransCo`
+                                        (mkCoVarCo cv1) `mkTransCo` n2])
+                    r2
+
 -- Push transitivity inside axioms
 opt_trans_rule is co1 co2
 
@@ -932,8 +1042,9 @@ compatible_co co1 co2
 
 -------------
 {-
-etaForAllCo_maybe
+etaForAllCo
 ~~~~~~~~~~~~~~~~~
+(1) etaForAllCo_ty_maybe
 Suppose we have
 
   g : all a1:k1.t1  ~  all a2:k2.t2
@@ -955,16 +1066,34 @@ or
   g' : all a1:k1.t1  ~  all a1:k2.(t2[a2 |-> a1])
 
 as desired.
+
+(2) etaForAllCo_co_maybe
+Suppose we have
+
+  g : all c1:(s1~s2). t1 ~ all c2:(s3~s4). t2
+
+Similarly, we do this
+
+  g' = all c1:h1. h2
+     : all c1:(s1~s2). t1 ~ all c1:(s3~s4). t2[c2 |-> (sym eta1;c1;eta2)]
+                                              [c1 |-> eta1;c1;sym eta2]
+
+Here,
+
+  h1   = mkNthCo Nominal 0 g :: (s1~s2)~(s3~s4)
+  eta1 = mkNthCo r 2 h1      :: (s1 ~ s3)
+  eta2 = mkNthCo r 3 h1      :: (s2 ~ s4)
+  h2   = mkInstCo g (cv1 ~ (sym eta1;c1;eta2))
 -}
-etaForAllCo_maybe :: Coercion -> Maybe (TyVar, Coercion, Coercion)
+etaForAllCo_ty_maybe :: Coercion -> Maybe (TyVar, Coercion, Coercion)
 -- Try to make the coercion be of form (forall tv:kind_co. co)
-etaForAllCo_maybe co
-  | ForAllCo tv kind_co r <- co
+etaForAllCo_ty_maybe co
+  | Just (tv, kind_co, r) <- splitForAllCo_ty_maybe co
   = Just (tv, kind_co, r)
 
   | Pair ty1 ty2  <- coercionKind co
-  , Just (tv1, _) <- splitForAllTy_maybe ty1
-  , isForAllTy ty2
+  , Just (tv1, _) <- splitForAllTy_ty_maybe ty1
+  , isForAllTy_ty ty2
   , let kind_co = mkNthCo Nominal 0 co
   = Just ( tv1, kind_co
          , mkInstCo co (mkGReflRightCo Nominal (TyVarTy tv1) kind_co))
@@ -972,6 +1101,28 @@ etaForAllCo_maybe co
   | otherwise
   = Nothing
 
+etaForAllCo_co_maybe :: Coercion -> Maybe (CoVar, Coercion, Coercion)
+-- Try to make the coercion be of form (forall cv:kind_co. co)
+etaForAllCo_co_maybe co
+  | Just (cv, kind_co, r) <- splitForAllCo_co_maybe co
+  = Just (cv, kind_co, r)
+
+  | Pair ty1 ty2  <- coercionKind co
+  , Just (cv1, _) <- splitForAllTy_co_maybe ty1
+  , isForAllTy_co ty2
+  = let kind_co  = mkNthCo Nominal 0 co
+        r        = coVarRole cv1
+        l_co     = mkCoVarCo cv1
+        kind_co' = downgradeRole r Nominal kind_co
+        r_co     = (mkSymCo (mkNthCo r 2 kind_co')) `mkTransCo`
+                   l_co `mkTransCo`
+                   (mkNthCo r 3 kind_co')
+    in Just ( cv1, kind_co
+            , mkInstCo co (mkProofIrrelCo Nominal kind_co l_co r_co))
+
+  | otherwise
+  = Nothing
+
 etaAppCo_maybe :: Coercion -> Maybe (Coercion,Coercion)
 -- If possible, split a coercion
 --   g :: t1a t1b ~ t2a t2b
@@ -1041,6 +1192,6 @@ and these two imply
 -}
 
 optForAllCoBndr :: LiftingContext -> Bool
-                -> TyVar -> Coercion -> (LiftingContext, TyVar, Coercion)
+                -> TyCoVar -> Coercion -> (LiftingContext, TyCoVar, Coercion)
 optForAllCoBndr env sym
   = substForAllCoBndrUsingLC sym (opt_co4_wrap env sym False Nominal) env
index 81cd2b0..b50327f 100644 (file)
@@ -39,26 +39,30 @@ module TyCoRep (
 
         -- * Functions over types
         mkTyConTy, mkTyVarTy, mkTyVarTys,
-        mkFunTy, mkFunTys, mkForAllTy, mkForAllTys,
-        mkPiTy, mkPiTys,
+        mkTyCoVarTy, mkTyCoVarTys,
+        mkFunTy, mkFunTys, mkTyCoForAllTy, mkForAllTys,
+        mkForAllTy,
+        mkTyCoPiTy, mkTyCoPiTys,
+        mkPiTys,
         isTYPE,
         isLiftedTypeKind, isUnliftedTypeKind,
         isCoercionType, isRuntimeRepTy, isRuntimeRepVar,
         sameVis,
 
         -- * Functions over binders
-        TyBinder(..), TyVarBinder,
-        binderVar, binderVars, binderKind, binderArgFlag,
+        TyCoBinder(..), TyCoVarBinder, TyBinder,
+        binderVar, binderVars, binderType, binderArgFlag,
         delBinderVar,
         isInvisibleArgFlag, isVisibleArgFlag,
         isInvisibleBinder, isVisibleBinder,
+        isTyBinder,
 
         -- * Functions over coercions
         pickLR,
 
         -- * Pretty-printing
         pprType, pprParendType, pprPrecType,
-        pprTypeApp, pprTvBndr, pprTvBndrs,
+        pprTypeApp, pprTCvBndr, pprTCvBndrs,
         pprSigmaType,
         pprTheta, pprParendTheta, pprForAll, pprUserForAll,
         pprTyVar, pprTyVars,
@@ -91,18 +95,20 @@ module TyCoRep (
         TCvSubst(..), TvSubstEnv, CvSubstEnv,
         emptyTvSubstEnv, emptyCvSubstEnv, composeTCvSubstEnv, composeTCvSubst,
         emptyTCvSubst, mkEmptyTCvSubst, isEmptyTCvSubst,
-        mkTCvSubst, mkTvSubst,
+        mkTCvSubst, mkTvSubst, mkCvSubst,
         getTvSubstEnv,
         getCvSubstEnv, getTCvInScope, getTCvSubstRangeFVs,
         isInScope, notElemTCvSubst,
         setTvSubstEnv, setCvSubstEnv, zapTCvSubst,
         extendTCvInScope, extendTCvInScopeList, extendTCvInScopeSet,
-        extendTCvSubst,
+        extendTCvSubst, extendTCvSubstWithClone,
         extendCvSubst, extendCvSubstWithClone,
         extendTvSubst, extendTvSubstBinderAndInScope, extendTvSubstWithClone,
         extendTvSubstList, extendTvSubstAndInScope,
+        extendTCvSubstList,
         unionTCvSubst, zipTyEnv, zipCoEnv, mkTyCoInScopeSet,
         zipTvSubst, zipCvSubst,
+        zipTCvSubst,
         mkTvSubstPrs,
 
         substTyWith, substTyWithCoVars, substTysWith, substTysWithCoVars,
@@ -113,25 +119,28 @@ module TyCoRep (
         substCoUnchecked, substCoWithUnchecked,
         substTyWithInScope,
         substTys, substTheta,
-        lookupTyVar, substTyVarBndr, substTyVarBndrs,
+        lookupTyVar,
         substCo, substCos, substCoVar, substCoVars, lookupCoVar,
-        substCoVarBndr, cloneTyVarBndr, cloneTyVarBndrs,
-        substTyVar, substTyVars,
+        cloneTyVarBndr, cloneTyVarBndrs,
+        substVarBndr, substVarBndrs,
+        substTyVarBndr, substTyVarBndrs,
+        substCoVarBndr,
+        substTyVar, substTyVars, substTyCoVars,
         substForAllCoBndr,
-        substTyVarBndrUsing, substForAllCoBndrUsing,
+        substVarBndrUsing, substForAllCoBndrUsing,
         checkValidSubst, isValidTCvSubst,
 
         -- * Tidying type related things up for printing
         tidyType,      tidyTypes,
         tidyOpenType,  tidyOpenTypes,
         tidyOpenKind,
-        tidyTyCoVarBndr, tidyTyCoVarBndrs, tidyFreeTyCoVars,
+        tidyVarBndr, tidyVarBndrs, tidyFreeTyCoVars,
         tidyOpenTyCoVar, tidyOpenTyCoVars,
-        tidyTyVarOcc,
+        tidyTyCoVarOcc,
         tidyTopType,
         tidyKind,
         tidyCo, tidyCos,
-        tidyTyVarBinder, tidyTyVarBinders,
+        tidyTyCoVarBinder, tidyTyCoVarBinders,
 
         -- * Sizes
         typeSize, coercionSize, provSize
@@ -293,7 +302,7 @@ data Type
                         --    can appear as the right hand side of a type synonym.
 
   | ForAllTy
-        {-# UNPACK #-} !TyVarBinder
+        {-# UNPACK #-} !TyCoVarBinder
         Type            -- ^ A Π type.
 
   | FunTy Type Type     -- ^ t1 -> t2   Very common, so an important special case
@@ -362,11 +371,11 @@ appropriate for the implementation of eqType?
 Anything smaller than ~ and homogeneous is an appropriate definition for
 equality. The type safety of FC depends only on ~. Let's say η : τ ~ σ. Any
 expression of type τ can be transmuted to one of type σ at any point by
-casting. The same is true of types of type τ. So in some sense, τ and σ are
-interchangeable.
+casting. The same is true of expressions of type σ. So in some sense, τ and σ
+are interchangeable.
 
 But let's be more precise. If we examine the typing rules of FC (say, those in
-http://www.cis.upenn.edu/~eir/papers/2015/equalities/equalities-extended.pdf)
+https://cs.brynmawr.edu/~rae/papers/2015/equalities/equalities.pdf)
 there are several places where the same metavariable is used in two different
 premises to a rule. (For example, see Ty_App.) There is an implicit equality
 check here. What definition of equality should we use? By convention, we use
@@ -464,9 +473,35 @@ In sum, in order to uphold (EQ), we need the following three invariants:
         ForAllTy to a ForAllTy.
   (EQ2) No reflexive casts in CastTy.
   (EQ3) No nested CastTys.
+  (EQ4) No CastTy over (ForAllTy (Bndr tyvar vis) body).
+        See Note [Weird typing rule for ForAllTy] in Type.
 
 These invariants are all documented above, in the declaration for Type.
 
+Note [Unused coercion variable in ForAllTy]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Suppose we have
+  \(co:t1 ~ t2). e
+
+What type should we give to this expression?
+  (1) forall (co:t1 ~ t2) -> t
+  (2) (t1 ~ t2) -> t
+
+If co is used in t, (1) should be the right choice.
+if co is not used in t, we would like to have (1) and (2) equivalent.
+
+However, we want to keep eqType simple and don't want eqType (1) (2) to return
+True in any case.
+
+We decide to always construct (2) if co is not used in t.
+
+Thus in mkTyCoForAllTy, we check whether the variable is a coercion
+variable and whether it is used in the body. If so, it returns a FunTy
+instead of a ForAllTy.
+
+There are cases we want to skip the check. For example, the check is unnecessary
+when it is known from the context that the input variable is a type variable.
+In those cases, we use mkForAllTy.
 -}
 
 -- | A type labeled 'KnotTied' might have knot-tied tycons in it. See
@@ -476,40 +511,49 @@ type KnotTied ty = ty
 
 {- **********************************************************************
 *                                                                       *
-                  TyBinder and ArgFlag
+                  TyCoBinder and ArgFlag
 *                                                                       *
 ********************************************************************** -}
 
--- | A 'TyBinder' represents an argument to a function. TyBinders can be dependent
--- ('Named') or nondependent ('Anon'). They may also be visible or not.
--- See Note [TyBinders]
-data TyBinder
-  = Named TyVarBinder   -- A type-lambda binder
-  | Anon Type           -- A term-lambda binder
+-- | A 'TyCoBinder' represents an argument to a function. TyCoBinders can be
+-- dependent ('Named') or nondependent ('Anon'). They may also be visible or
+-- not. See Note [TyCoBinders]
+data TyCoBinder
+  = Named TyCoVarBinder -- A type-lambda binder
+  | Anon Type           -- A term-lambda binder. Type here can be CoercionTy.
                         -- Visibility is determined by the type (Constraint vs. *)
   deriving Data.Data
 
+-- | 'TyBinder' is like 'TyCoBinder', but there can only be 'TyVarBinder'
+-- in the 'Named' field.
+type TyBinder = TyCoBinder
+
 -- | Remove the binder's variable from the set, if the binder has
 -- a variable.
-delBinderVar :: VarSet -> TyVarBinder -> VarSet
-delBinderVar vars (TvBndr tv _) = vars `delVarSet` tv
+delBinderVar :: VarSet -> TyCoVarBinder -> VarSet
+delBinderVar vars (Bndr tv _) = vars `delVarSet` tv
 
 -- | Does this binder bind an invisible argument?
-isInvisibleBinder :: TyBinder -> Bool
-isInvisibleBinder (Named (TvBndr _ vis)) = isInvisibleArgFlag vis
-isInvisibleBinder (Anon ty)              = isPredTy ty
+isInvisibleBinder :: TyCoBinder -> Bool
+isInvisibleBinder (Named (Bndr _ vis)) = isInvisibleArgFlag vis
+isInvisibleBinder (Anon ty)            = isPredTy ty
 
 -- | Does this binder bind a visible argument?
-isVisibleBinder :: TyBinder -> Bool
+isVisibleBinder :: TyCoBinder -> Bool
 isVisibleBinder = not . isInvisibleBinder
 
+-- | If its a named binder, is the binder a tyvar?
+-- Returns True for nondependent binder.
+isTyBinder :: TyCoBinder -> Bool
+isTyBinder (Named bnd) = isTyVarBinder bnd
+isTyBinder _ = True
 
-{- Note [TyBinders]
+{- Note [TyCoBinders]
 ~~~~~~~~~~~~~~~~~~~
-A ForAllTy contains a TyVarBinder.  But a type can be decomposed
-to a telescope consisting of a [TyBinder]
+A ForAllTy contains a TyCoVarBinder.  But a type can be decomposed
+to a telescope consisting of a [TyCoBinder]
 
-A TyBinder represents the type of binders -- that is, the type of an
+A TyCoBinder represents the type of binders -- that is, the type of an
 argument to a Pi-type. GHC Core currently supports two different
 Pi-types:
 
@@ -527,16 +571,16 @@ words, if `x` is either a function or a polytype, `x arg` makes sense
 (for an appropriate `arg`).
 
 
-Note [TyVarBndrs, TyVarBinders, TyConBinders, and visibility]
+Note [VarBndrs, TyCoVarBinders, TyConBinders, and visibility]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-* A ForAllTy (used for both types and kinds) contains a TyVarBinder.
-  Each TyVarBinder
-      TvBndr a tvis
+* A ForAllTy (used for both types and kinds) contains a TyCoVarBinder.
+  Each TyCoVarBinder
+      Bndr a tvis
   is equipped with tvis::ArgFlag, which says whether or not arguments
   for this binder should be visible (explicit) in source Haskell.
 
 * A TyCon contains a list of TyConBinders.  Each TyConBinder
-      TvBndr a cvis
+      Bndr a cvis
   is equipped with cvis::TyConBndrVis, which says whether or not type
   and kind arguments for this TyCon should be visible (explicit) in
   source Haskell.
@@ -545,18 +589,20 @@ This table summarises the visibility rules:
 ---------------------------------------------------------------------------------------
 |                                                      Occurrences look like this
 |                             GHC displays type as     in Haskell source code
-|-----------------------------------------------------------------------
-| TvBndr a tvis :: TyVarBinder, in the binder of ForAllTy for a term
+|--------------------------------------------------------------------------------------
+| Bndr a tvis :: TyCoVarBinder, in the binder of ForAllTy for a term
 |  tvis :: ArgFlag
 |  tvis = Inferred:            f :: forall {a}. type    Arg not allowed:  f
+                               f :: forall {co}. type   Arg not allowed:  f
 |  tvis = Specified:           f :: forall a. type      Arg optional:     f  or  f @Int
 |  tvis = Required:            T :: forall k -> type    Arg required:     T *
-|    This last form is illegal in terms: See Note [No Required TyBinder in terms]
+|    This last form is illegal in terms: See Note [No Required TyCoBinder in terms]
 |
-| TvBndr k cvis :: TyConBinder, in the TyConBinders of a TyCon
+| Bndr k cvis :: TyConBinder, in the TyConBinders of a TyCon
 |  cvis :: TyConBndrVis
 |  cvis = AnonTCB:             T :: kind -> kind        Required:            T *
 |  cvis = NamedTCB Inferred:   T :: forall {k}. kind    Arg not allowed:     T
+|                              T :: forall {co}. kind   Arg not allowed:     T
 |  cvis = NamedTCB Specified:  T :: forall k. kind      Arg not allowed[1]:  T
 |  cvis = NamedTCB Required:   T :: forall k -> kind    Required:            T *
 ---------------------------------------------------------------------------------------
@@ -574,12 +620,12 @@ This table summarises the visibility rules:
 
 * Specified.  Function defn, with signature (implicit forall):
      f2 :: a -> a; f2 x = x
-  So f2 gets the type f2 :: forall a. a->a, with 'a' Specified
+  So f2 gets the type f2 :: forall a. a -> a, with 'a' Specified
   even though 'a' is not bound in the source code by an explicit forall
 
 * Specified.  Function defn, with signature (explicit forall):
      f3 :: forall a. a -> a; f3 x = x
-  So f3 gets the type f3 :: forall a. a->a, with 'a' Specified
+  So f3 gets the type f3 :: forall a. a -> a, with 'a' Specified
 
 * Inferred/Specified.  Function signature with inferred kind polymorphism.
      f4 :: a b -> Int
@@ -603,7 +649,7 @@ This table summarises the visibility rules:
   Here T1's kind is  T1 :: forall {k:*}. (k->*) -> k -> *
   The kind variable 'k' is Inferred, since it is not mentioned
 
-  Note that 'a' and 'b' correspond to /Anon/ TyBinders in T1's kind,
+  Note that 'a' and 'b' correspond to /Anon/ TyCoBinders in T1's kind,
   and Anon binders don't have a visibility flag. (Or you could think
   of Anon having an implicit Required flag.)
 
@@ -663,14 +709,14 @@ and its kind prints as
 * Inferred variables correspond to "generalized" variables from the
   Visible Type Applications paper (ESOP'16).
 
-Note [No Required TyBinder in terms]
+Note [No Required TyCoBinder in terms]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 We don't allow Required foralls for term variables, including pattern
 synonyms and data constructors.  Why?  Because then an application
 would need a /compulsory/ type argument (possibly without an "@"?),
 thus (f Int); and we don't have concrete syntax for that.
 
-We could change this decision, but Required, Named TyBinders are rare
+We could change this decision, but Required, Named TyCoBinders are rare
 anyway.  (Most are Anons.)
 -}
 
@@ -731,14 +777,23 @@ These functions are here so that they can be used by TysPrim,
 which in turn is imported by Type
 -}
 
--- named with "Only" to prevent naive use of mkTyVarTy
 mkTyVarTy  :: TyVar   -> Type
 mkTyVarTy v = ASSERT2( isTyVar v, ppr v <+> dcolon <+> ppr (tyVarKind v) )
-                  TyVarTy v
+              TyVarTy v
 
 mkTyVarTys :: [TyVar] -> [Type]
 mkTyVarTys = map mkTyVarTy -- a common use of mkTyVarTy
 
+mkTyCoVarTy :: TyCoVar -> Type
+mkTyCoVarTy v
+  | isTyVar v
+  = TyVarTy v
+  | otherwise
+  = CoercionTy (CoVarCo v)
+
+mkTyCoVarTys :: [TyCoVar] -> [Type]
+mkTyCoVarTys = map mkTyCoVarTy
+
 infixr 3 `mkFunTy`      -- Associates to the right
 -- | Make an arrow type
 mkFunTy :: Type -> Type -> Type
@@ -748,18 +803,41 @@ mkFunTy arg res = FunTy arg res
 mkFunTys :: [Type] -> Type -> Type
 mkFunTys tys ty = foldr mkFunTy ty tys
 
-mkForAllTy :: TyVar -> ArgFlag -> Type -> Type
-mkForAllTy tv vis ty = ForAllTy (TvBndr tv vis) ty
+-- | If tv is a coercion variable and it is not used in the body, returns
+-- a FunTy, otherwise makes a forall type.
+-- See Note [Unused coercion variable in ForAllTy]
+mkTyCoForAllTy :: TyCoVar -> ArgFlag -> Type -> Type
+mkTyCoForAllTy tv vis ty
+  | isCoVar tv
+  , not (tv `elemVarSet` tyCoVarsOfType ty)
+  = ASSERT( vis == Inferred )
+    mkFunTy (varType tv) ty
+  | otherwise
+  = ForAllTy (Bndr tv vis) ty
+
+-- | Like 'mkTyCoForAllTy', but does not check the occurrence of the binder
+-- See Note [Unused coercion variable in ForAllTy]
+mkForAllTy :: TyCoVar -> ArgFlag -> Type -> Type
+mkForAllTy tv vis ty = ForAllTy (Bndr tv vis) ty
 
--- | Wraps foralls over the type using the provided 'TyVar's from left to right
-mkForAllTys :: [TyVarBinder] -> Type -> Type
+-- | Wraps foralls over the type using the provided 'TyCoVar's from left to right
+mkForAllTys :: [TyCoVarBinder] -> Type -> Type
 mkForAllTys tyvars ty = foldr ForAllTy ty tyvars
 
-mkPiTy :: TyBinder -> Type -> Type
-mkPiTy (Anon ty1) ty2 = FunTy ty1 ty2
-mkPiTy (Named tvb) ty = ForAllTy tvb ty
+mkTyCoPiTy :: TyCoBinder -> Type -> Type
+mkTyCoPiTy (Anon ty1) ty2           = FunTy ty1 ty2
+mkTyCoPiTy (Named (Bndr tv vis)) ty = mkTyCoForAllTy tv vis ty
 
-mkPiTys :: [TyBinder] -> Type -> Type
+-- | Like 'mkTyCoPiTy', but does not check the occurrence of the binder
+mkPiTy:: TyCoBinder -> Type -> Type
+mkPiTy (Anon ty1) ty2           = FunTy ty1 ty2
+mkPiTy (Named (Bndr tv vis)) ty = mkForAllTy tv vis ty
+
+mkTyCoPiTys :: [TyCoBinder] -> Type -> Type
+mkTyCoPiTys tbs ty = foldr mkTyCoPiTy ty tbs
+
+-- | Like 'mkTyCoPiTys', but does not check the occurrence of the binder
+mkPiTys :: [TyCoBinder] -> Type -> Type
 mkPiTys tbs ty = foldr mkPiTy ty tbs
 
 -- | Does this type classify a core (unlifted) Coercion?
@@ -883,7 +961,7 @@ data Coercion
           -- AppCo :: e -> N -> e
 
   -- See Note [Forall coercions]
-  | ForAllCo TyVar KindCoercion Coercion
+  | ForAllCo TyCoVar KindCoercion Coercion
          -- ForAllCo :: _ -> N -> e -> e
 
   | FunCo Role Coercion Coercion         -- lift FunTy
@@ -1080,9 +1158,10 @@ The typing rule is:
   ForAllCo tv1 kind_co co : all tv1:k1. t1  ~
                             all tv1:k2. (t2[tv1 |-> tv1 |> sym kind_co])
 
-First, the TyVar stored in a ForAllCo is really an optimisation: this field
+First, the TyCoVar stored in a ForAllCo is really an optimisation: this field
 should be a Name, as its kind is redundant. Thinking of the field as a Name
 is helpful in understanding what a ForAllCo means.
+The kind of TyCoVar always matches the left-hand kind of the coercion.
 
 The idea is that kind_co gives the two kinds of the tyvar. See how, in the
 conclusion, tv1 is assigned kind k1 on the left but kind k2 on the right.
@@ -1479,7 +1558,7 @@ In core, we get
   MkG :: forall (a :: *). (a ~ Bool) -> G a
 
 Now, consider 'MkG -- that is, MkG used in a type -- and suppose we want
-a proof that ('MkG co1 a1) ~ ('MkG co2 a2). This will have to be
+a proof that ('MkG a1 co1) ~ ('MkG a2 co2). This will have to be
 
   TyConAppCo Nominal MkG [co3, co4]
   where
@@ -1494,7 +1573,7 @@ Here,
   co3 = UnivCo (ProofIrrelProv co5) Nominal (CoercionTy co1) (CoercionTy co2)
   where
     co5 :: (a1 ~ Bool) ~ (a2 ~ Bool)
-    co5 = TyConAppCo Nominal (~) [<*>, <*>, co4, <Bool>]
+    co5 = TyConAppCo Nominal (~#) [<*>, <*>, co4, <Bool>]
 
 
 %************************************************************************
@@ -1561,10 +1640,10 @@ tyCoFVsOfType (ForAllTy bndr ty) a b c = tyCoFVsBndr bndr (tyCoFVsOfType ty)  a
 tyCoFVsOfType (CastTy ty co)     a b c = (tyCoFVsOfType ty `unionFV` tyCoFVsOfCo co) a b c
 tyCoFVsOfType (CoercionTy co)    a b c = tyCoFVsOfCo co a b c
 
-tyCoFVsBndr :: TyVarBinder -> FV -> FV
+tyCoFVsBndr :: TyCoVarBinder -> FV -> FV
 -- Free vars of (forall b. <thing with fvs>)
-tyCoFVsBndr (TvBndr tv _) fvs = (delFV tv fvs)
-                                `unionFV` tyCoFVsOfType (tyVarKind tv)
+tyCoFVsBndr (Bndr tv _) fvs = (delFV tv fvs)
+                              `unionFV` tyCoFVsOfType (varType tv)
 
 -- | Returns free variables of types, including kind variables as
 -- a non-deterministic set. For type synonyms it does /not/ expand the
@@ -1681,9 +1760,9 @@ coVarsOfType (TyConApp _ tys)    = coVarsOfTypes tys
 coVarsOfType (LitTy {})          = emptyVarSet
 coVarsOfType (AppTy fun arg)     = coVarsOfType fun `unionVarSet` coVarsOfType arg
 coVarsOfType (FunTy arg res)     = coVarsOfType arg `unionVarSet` coVarsOfType res
-coVarsOfType (ForAllTy (TvBndr tv _) ty)
+coVarsOfType (ForAllTy (Bndr tv _) ty)
   = (coVarsOfType ty `delVarSet` tv)
-    `unionVarSet` coVarsOfType (tyVarKind tv)
+    `unionVarSet` coVarsOfType (varType tv)
 coVarsOfType (CastTy ty co)      = coVarsOfType ty `unionVarSet` coVarsOfCo co
 coVarsOfType (CoercionTy co)     = coVarsOfCo co
 
@@ -1757,11 +1836,11 @@ closeOverKindsDSet = fvDVarSet . closeOverKindsFV . dVarSetElems
 -- positions. (See @Note [Kind annotations on TyConApps]@ in "TcSplice" for an
 -- explanation of what an injective position is.)
 injectiveVarsOfBinder :: TyConBinder -> FV
-injectiveVarsOfBinder (TvBndr tv vis) =
+injectiveVarsOfBinder (Bndr tv vis) =
   case vis of
-    AnonTCB           -> injectiveVarsOfType (tyVarKind tv)
+    AnonTCB           -> injectiveVarsOfType (varType tv)
     NamedTCB Required -> unitFV tv `unionFV`
-                         injectiveVarsOfType (tyVarKind tv)
+                         injectiveVarsOfType (varType tv)
     NamedTCB _        -> emptyFV
 
 -- | Returns the free variables of a 'Type' that are in injective positions.
@@ -1782,7 +1861,7 @@ injectiveVarsOfType = go
                          filterByList (inj ++ repeat True) tys
                          -- Oversaturated arguments to a tycon are
                          -- always injective, hence the repeat True
-    go (ForAllTy tvb ty) = tyCoFVsBndr tvb $ go (tyVarKind (binderVar tvb))
+    go (ForAllTy tvb ty) = tyCoFVsBndr tvb $ go (binderType tvb)
                                              `unionFV` go ty
     go LitTy{}           = emptyFV
     go (CastTy ty _)     = go ty
@@ -1804,6 +1883,9 @@ noFreeVarsOfMCo :: MCoercion -> Bool
 noFreeVarsOfMCo MRefl    = True
 noFreeVarsOfMCo (MCo co) = noFreeVarsOfCo co
 
+noFreeVarsOfTypes :: [Type] -> Bool
+noFreeVarsOfTypes = all noFreeVarsOfType
+
 -- | Returns True if this coercion has no free variables. Should be the same as
 -- isEmptyVarSet . tyCoVarsOfCo, but faster in the non-forall case.
 noFreeVarsOfCo :: Coercion -> Bool
@@ -1903,7 +1985,7 @@ The same rules apply to other substitutions (notably CoreSubst.Subst)
   Then if we use the in-scope set {b}, satisfying (SIa), there is
   a danger we will rename the forall'd variable to 'x' by mistake,
   getting this:
-      forall x. (List b, x, x)
+      forall x. (Maybe b, x, x)
   Breaking (SIb) caused the bug from #11371.
 
 Note: if the free vars of the range of the substitution are freshly created,
@@ -1944,7 +2026,7 @@ nevertheless we add 'b' to the TvSubstEnv, because b's kind does change
 
 This invariant has several crucial consequences:
 
-* In substTyVarBndr, we need extend the TvSubstEnv
+* In substVarBndr, we need extend the TvSubstEnv
         - if the unique has changed
         - or if the kind has changed
 
@@ -2018,6 +2100,10 @@ mkTvSubst :: InScopeSet -> TvSubstEnv -> TCvSubst
 -- ^ Make a TCvSubst with specified tyvar subst and empty covar subst
 mkTvSubst in_scope tenv = TCvSubst in_scope tenv emptyCvSubstEnv
 
+mkCvSubst :: InScopeSet -> CvSubstEnv -> TCvSubst
+-- ^ Make a TCvSubst with specified covar subst and empty tyvar subst
+mkCvSubst in_scope cenv = TCvSubst in_scope emptyTvSubstEnv cenv
+
 getTvSubstEnv :: TCvSubst -> TvSubstEnv
 getTvSubstEnv (TCvSubst _ env _) = env
 
@@ -2076,13 +2162,19 @@ extendTCvSubst subst v ty
   | otherwise
   = pprPanic "extendTCvSubst" (ppr v <+> text "|->" <+> ppr ty)
 
+extendTCvSubstWithClone :: TCvSubst -> TyCoVar -> TyCoVar -> TCvSubst
+extendTCvSubstWithClone subst tcv
+  | isTyVar tcv = extendTvSubstWithClone subst tcv
+  | otherwise   = extendCvSubstWithClone subst tcv
+
 extendTvSubst :: TCvSubst -> TyVar -> Type -> TCvSubst
 extendTvSubst (TCvSubst in_scope tenv cenv) tv ty
   = TCvSubst in_scope (extendVarEnv tenv tv ty) cenv
 
-extendTvSubstBinderAndInScope :: TCvSubst -> TyBinder -> Type -> TCvSubst
-extendTvSubstBinderAndInScope subst (Named bndr) ty
-  = extendTvSubstAndInScope subst (binderVar bndr) ty
+extendTvSubstBinderAndInScope :: TCvSubst -> TyCoBinder -> Type -> TCvSubst
+extendTvSubstBinderAndInScope subst (Named (Bndr v _)) ty
+  = ASSERT( isTyVar v )
+    extendTvSubstAndInScope subst v ty
 extendTvSubstBinderAndInScope subst (Anon _)     _
   = subst
 
@@ -2118,6 +2210,10 @@ extendTvSubstList :: TCvSubst -> [Var] -> [Type] -> TCvSubst
 extendTvSubstList subst tvs tys
   = foldl2 extendTvSubst subst tvs tys
 
+extendTCvSubstList :: TCvSubst -> [Var] -> [Type] -> TCvSubst
+extendTCvSubstList subst tvs tys
+  = foldl2 extendTCvSubst subst tvs tys
+
 unionTCvSubst :: TCvSubst -> TCvSubst -> TCvSubst
 -- Works when the ranges are disjoint
 unionTCvSubst (TCvSubst in_scope1 tenv1 cenv1) (TCvSubst in_scope2 tenv2 cenv2)
@@ -2161,6 +2257,18 @@ zipCvSubst cvs cos
   where
     cenv = zipCoEnv cvs cos
 
+zipTCvSubst :: [TyCoVar] -> [Type] -> TCvSubst
+zipTCvSubst tcvs tys
+  | debugIsOn
+  , neLength tcvs tys
+  = pprTrace "zipTCvSubst" (ppr tcvs $$ ppr tys) emptyTCvSubst
+  | otherwise
+  = zip_tcvsubst tcvs tys (mkEmptyTCvSubst $ mkInScopeSet (tyCoVarsOfTypes tys))
+  where zip_tcvsubst :: [TyCoVar] -> [Type] -> TCvSubst -> TCvSubst
+        zip_tcvsubst (tv:tvs) (ty:tys) subst
+          = zip_tcvsubst tvs tys (extendTCvSubst subst tv ty)
+        zip_tcvsubst _ _ subst = subst -- empty case
+
 -- | Generates the in-scope set for the 'TCvSubst' from the types in the
 -- incoming environment. No CoVars, please!
 mkTvSubstPrs :: [(TyVar, Type)] -> TCvSubst
@@ -2454,10 +2562,10 @@ subst_ty subst ty
     go (TyConApp tc tys) = let args = map go tys
                            in  args `seqList` TyConApp tc args
     go (FunTy arg res)   = (FunTy $! go arg) $! go res
-    go (ForAllTy (TvBndr tv vis) ty)
-                         = case substTyVarBndrUnchecked subst tv of
+    go (ForAllTy (Bndr tv vis) ty)
+                         = case substVarBndrUnchecked subst tv of
                              (subst', tv') ->
-                               (ForAllTy $! ((TvBndr $! tv') vis)) $!
+                               (ForAllTy $! ((Bndr $! tv') vis)) $!
                                             (subst_ty subst' ty)
     go (LitTy n)         = LitTy $! n
     go (CastTy ty co)    = (mkCastTy $! (go ty)) $! (subst_co subst co)
@@ -2473,6 +2581,14 @@ substTyVar (TCvSubst _ tenv _) tv
 substTyVars :: TCvSubst -> [TyVar] -> [Type]
 substTyVars subst = map $ substTyVar subst
 
+substTyCoVars :: TCvSubst -> [TyCoVar] -> [Type]
+substTyCoVars subst = map $ substTyCoVar subst
+
+substTyCoVar :: TCvSubst -> TyCoVar -> Type
+substTyCoVar subst tv
+  | isTyVar tv = substTyVar subst tv
+  | otherwise = CoercionTy $ substCoVar subst tv
+
 lookupTyVar :: TCvSubst -> TyVar  -> Maybe Type
         -- See Note [Extending the TCvSubst]
 lookupTyVar (TCvSubst _ tenv _) tv
@@ -2523,8 +2639,9 @@ subst_co subst co
                                in  args' `seqList` mkTyConAppCo r tc args'
     go (AppCo co arg)        = (mkAppCo $! go co) $! go arg
     go (ForAllCo tv kind_co co)
-      = case substForAllCoBndrUnchecked subst tv kind_co of { (subst', tv', kind_co') ->
-          ((mkForAllCo $! tv') $! kind_co') $! subst_co subst' co }
+      = case substForAllCoBndrUnchecked subst tv kind_co of
+         (subst', tv', kind_co') ->
+          ((mkForAllCo $! tv') $! kind_co') $! subst_co subst' co
     go (FunCo r co1 co2)     = (mkFunCo r $! go co1) $! go co2
     go (CoVarCo cv)          = substCoVar subst cv
     go (AxiomInstCo con ind cos) = mkAxiomInstCo con ind $! map go cos
@@ -2550,7 +2667,8 @@ subst_co subst co
     go_hole h@(CoercionHole { ch_co_var = cv })
       = h { ch_co_var = updateVarType go_ty cv }
 
-substForAllCoBndr :: TCvSubst -> TyVar -> Coercion -> (TCvSubst, TyVar, Coercion)
+substForAllCoBndr :: TCvSubst -> TyCoVar -> KindCoercion
+                  -> (TCvSubst, TyCoVar, Coercion)
 substForAllCoBndr subst
   = substForAllCoBndrUsing False (substCo subst) subst
 
@@ -2559,18 +2677,27 @@ substForAllCoBndr subst
 -- Note [The substitution invariant].
 -- The goal of #11371 is to migrate all the calls of substCoUnchecked to
 -- substCo and remove this function. Please don't use in new code.
-substForAllCoBndrUnchecked :: TCvSubst -> TyVar -> Coercion -> (TCvSubst, TyVar, Coercion)
+substForAllCoBndrUnchecked :: TCvSubst -> TyCoVar -> KindCoercion
+                           -> (TCvSubst, TyCoVar, Coercion)
 substForAllCoBndrUnchecked subst
   = substForAllCoBndrUsing False (substCoUnchecked subst) subst
 
 -- See Note [Sym and ForAllCo]
 substForAllCoBndrUsing :: Bool  -- apply sym to binder?
-                          -> (Coercion -> Coercion)  -- transformation to kind co
-                          -> TCvSubst -> TyVar -> Coercion
-                          -> (TCvSubst, TyVar, Coercion)
-substForAllCoBndrUsing sym sco (TCvSubst in_scope tenv cenv)
-                          old_var old_kind_co
-  = ( TCvSubst (in_scope `extendInScopeSet` new_var) new_env cenv
+                       -> (Coercion -> Coercion)  -- transformation to kind co
+                       -> TCvSubst -> TyCoVar -> KindCoercion
+                       -> (TCvSubst, TyCoVar, KindCoercion)
+substForAllCoBndrUsing sym sco subst old_var
+  | isTyVar old_var = substForAllCoTyVarBndrUsing sym sco subst old_var
+  | otherwise       = substForAllCoCoVarBndrUsing sym sco subst old_var
+
+substForAllCoTyVarBndrUsing :: Bool  -- apply sym to binder?
+                            -> (Coercion -> Coercion)  -- transformation to kind co
+                            -> TCvSubst -> TyVar -> KindCoercion
+                            -> (TCvSubst, TyVar, KindCoercion)
+substForAllCoTyVarBndrUsing sym sco (TCvSubst in_scope tenv cenv) old_var old_kind_co
+  = ASSERT( isTyVar old_var )
+    ( TCvSubst (in_scope `extendInScopeSet` new_var) new_env cenv
     , new_var, new_kind_co )
   where
     new_env | no_change && not sym = delVarEnv tenv old_var
@@ -2585,9 +2712,38 @@ substForAllCoBndrUsing sym sco (TCvSubst in_scope tenv cenv)
                 | otherwise      = sco old_kind_co
 
     Pair new_ki1 _ = coercionKind new_kind_co
+    -- We could do substitution to (tyVarKind old_var). We don't do so because
+    -- we already substituted new_kind_co, which contains the kind information
+    -- we want. We don't want to do substitution once more. Also, in most cases,
+    -- new_kind_co is a Refl, in which case coercionKind is really fast.
 
     new_var  = uniqAway in_scope (setTyVarKind old_var new_ki1)
 
+substForAllCoCoVarBndrUsing :: Bool  -- apply sym to binder?
+                            -> (Coercion -> Coercion)  -- transformation to kind co
+                            -> TCvSubst -> CoVar -> KindCoercion
+                            -> (TCvSubst, CoVar, KindCoercion)
+substForAllCoCoVarBndrUsing sym sco (TCvSubst in_scope tenv cenv)
+                            old_var old_kind_co
+  = ASSERT( isCoVar old_var )
+    ( TCvSubst (in_scope `extendInScopeSet` new_var) tenv new_cenv
+    , new_var, new_kind_co )
+  where
+    new_cenv | no_change && not sym = delVarEnv cenv old_var
+             | otherwise = extendVarEnv cenv old_var (mkCoVarCo new_var)
+
+    no_kind_change = noFreeVarsOfCo old_kind_co
+    no_change = no_kind_change && (new_var == old_var)
+
+    new_kind_co | no_kind_change = old_kind_co
+                | otherwise      = sco old_kind_co
+
+    Pair h1 h2 = coercionKind new_kind_co
+
+    new_var       = uniqAway in_scope $ mkCoVar (varName old_var) new_var_type
+    new_var_type  | sym       = h2
+                  | otherwise = h1
+
 substCoVar :: TCvSubst -> CoVar -> Coercion
 substCoVar (TCvSubst _ _ cenv) cv
   = case lookupVarEnv cenv cv of
@@ -2597,7 +2753,7 @@ substCoVar (TCvSubst _ _ cenv) cv
 substCoVars :: TCvSubst -> [CoVar] -> [Coercion]
 substCoVars subst cvs = map (substCoVar subst) cvs
 
-lookupCoVar :: TCvSubst -> Var  -> Maybe Coercion
+lookupCoVar :: TCvSubst -> Var -> Maybe Coercion
 lookupCoVar (TCvSubst _ _ cenv) v = lookupVarEnv cenv v
 
 substTyVarBndr :: HasCallStack => TCvSubst -> TyVar -> (TCvSubst, TyVar)
@@ -2606,13 +2762,28 @@ substTyVarBndr = substTyVarBndrUsing substTy
 substTyVarBndrs :: HasCallStack => TCvSubst -> [TyVar] -> (TCvSubst, [TyVar])
 substTyVarBndrs = mapAccumL substTyVarBndr
 
--- | Like 'substTyVarBndr' but disables sanity checks.
+substVarBndr :: HasCallStack => TCvSubst -> TyCoVar -> (TCvSubst, TyCoVar)
+substVarBndr = substVarBndrUsing substTy
+
+substVarBndrs :: HasCallStack => TCvSubst -> [TyCoVar] -> (TCvSubst, [TyCoVar])
+substVarBndrs = mapAccumL substVarBndr
+
+substCoVarBndr :: HasCallStack => TCvSubst -> CoVar -> (TCvSubst, CoVar)
+substCoVarBndr = substCoVarBndrUsing substTy
+
+-- | Like 'substVarBndr', but disables sanity checks.
 -- The problems that the sanity checks in substTy catch are described in
 -- Note [The substitution invariant].
 -- The goal of #11371 is to migrate all the calls of substTyUnchecked to
 -- substTy and remove this function. Please don't use in new code.
-substTyVarBndrUnchecked :: TCvSubst -> TyVar -> (TCvSubst, TyVar)
-substTyVarBndrUnchecked = substTyVarBndrUsing substTyUnchecked
+substVarBndrUnchecked :: TCvSubst -> TyCoVar -> (TCvSubst, TyCoVar)
+substVarBndrUnchecked = substVarBndrUsing substTyUnchecked
+
+substVarBndrUsing :: (TCvSubst -> Type -> Type)
+                  -> TCvSubst -> TyCoVar -> (TCvSubst, TyCoVar)
+substVarBndrUsing subst_fn subst v
+  | isTyVar v = substTyVarBndrUsing subst_fn subst v
+  | otherwise = substCoVarBndrUsing subst_fn subst v
 
 -- | Substitute a tyvar in a binding position, returning an
 -- extended subst and a new tyvar.
@@ -2649,13 +2820,18 @@ substTyVarBndrUsing subst_fn subst@(TCvSubst in_scope tenv cenv) old_var
                           setTyVarKind old_var (subst_fn subst old_ki)
         -- The uniqAway part makes sure the new variable is not already in scope
 
-substCoVarBndr :: TCvSubst -> CoVar -> (TCvSubst, CoVar)
-substCoVarBndr subst@(TCvSubst in_scope tenv cenv) old_var
+-- | Substitute a covar in a binding position, returning an
+-- extended subst and a new covar.
+-- Use the supplied function to substitute in the kind
+substCoVarBndrUsing
+  :: (TCvSubst -> Type -> Type)
+  -> TCvSubst -> CoVar -> (TCvSubst, CoVar)
+substCoVarBndrUsing subst_fn subst@(TCvSubst in_scope tenv cenv) old_var
   = ASSERT( isCoVar old_var )
     (TCvSubst (in_scope `extendInScopeSet` new_var) tenv new_cenv, new_var)
   where
     new_co         = mkCoVarCo new_var
-    no_kind_change = all noFreeVarsOfType [t1, t2]
+    no_kind_change = noFreeVarsOfTypes [t1, t2]
     no_change      = new_var == old_var && no_kind_change
 
     new_cenv | no_change = delVarEnv cenv old_var
@@ -2665,8 +2841,8 @@ substCoVarBndr subst@(TCvSubst in_scope tenv cenv) old_var
     subst_old_var = mkCoVar (varName old_var) new_var_type
 
     (_, _, t1, t2, role) = coVarKindsTypesRole old_var
-    t1' = substTy subst t1
-    t2' = substTy subst t2
+    t1' = subst_fn subst t1
+    t2' = subst_fn subst t2
     new_var_type = mkCoercionType role t1' t2'
                   -- It's important to do the substitution for coercions,
                   -- because they can have free type variables
@@ -2803,18 +2979,18 @@ instance Outputable TyLit where
 pprSigmaType :: Type -> SDoc
 pprSigmaType = pprIfaceSigmaType ShowForAllWhen . tidyToIfaceType
 
-pprForAll :: [TyVarBinder] -> SDoc
+pprForAll :: [TyCoVarBinder] -> SDoc
 pprForAll tvs = pprIfaceForAll (map toIfaceForAllBndr tvs)
 
 -- | Print a user-level forall; see Note [When to print foralls]
-pprUserForAll :: [TyVarBinder] -> SDoc
+pprUserForAll :: [TyCoVarBinder] -> SDoc
 pprUserForAll = pprUserIfaceForAll . map toIfaceForAllBndr
 
-pprTvBndrs :: [TyVarBinder] -> SDoc
-pprTvBndrs tvs = sep (map pprTvBndr tvs)
+pprTCvBndrs :: [TyCoVarBinder] -> SDoc
+pprTCvBndrs tvs = sep (map pprTCvBndr tvs)
 
-pprTvBndr :: TyVarBinder -> SDoc
-pprTvBndr = pprTyVar . binderVar
+pprTCvBndr :: TyCoVarBinder -> SDoc
+pprTCvBndr = pprTyVar . binderVar
 
 pprTyVars :: [TyVar] -> SDoc
 pprTyVars tvs = sep (map pprTyVar tvs)
@@ -2830,11 +3006,11 @@ pprTyVar tv
   where
     kind = tyVarKind tv
 
-instance Outputable TyBinder where
+instance Outputable TyCoBinder where
   ppr (Anon ty) = text "[anon]" <+> ppr ty
-  ppr (Named (TvBndr v Required))  = ppr v
-  ppr (Named (TvBndr v Specified)) = char '@' <> ppr v
-  ppr (Named (TvBndr v Inferred))  = braces (ppr v)
+  ppr (Named (Bndr v Required))  = ppr v
+  ppr (Named (Bndr v Specified)) = char '@' <> ppr v
+  ppr (Named (Bndr v Inferred))  = braces (ppr v)
 
 -----------------
 instance Outputable Coercion where -- defined here to avoid orphans
@@ -2908,7 +3084,7 @@ This catches common situations, such as a type siguature
 which means
       f :: forall k. forall (m :: k->*) (a :: k). m a
 We really want to see both the "forall k" and the kind signatures
-on m and a.  The latter comes from pprTvBndr.
+on m and a.  The latter comes from pprTCvBndr.
 
 Note [Infix type variables]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -2972,32 +3148,32 @@ ppSuggestExplicitKinds
 -- an interface file.
 --
 -- It doesn't change the uniques at all, just the print names.
-tidyTyCoVarBndrs :: TidyEnv -> [TyCoVar] -> (TidyEnv, [TyCoVar])
-tidyTyCoVarBndrs (occ_env, subst) tvs
-    = mapAccumL tidyTyCoVarBndr tidy_env' tvs
+tidyVarBndrs :: TidyEnv -> [TyCoVar] -> (TidyEnv, [TyCoVar])
+tidyVarBndrs (occ_env, subst) tvs
+    = mapAccumL tidyVarBndr tidy_env' tvs
   where
     -- Seed the occ_env with clashes among the names, see
     -- Node [Tidying multiple names at once] in OccName
-    -- Se still go through tidyTyCoVarBndr so that each kind variable is tidied
+    -- Se still go through tidyVarBndr so that each kind variable is tidied
     -- with the correct tidy_env
     occs = map getHelpfulOccName tvs
     tidy_env' = (avoidClashesOccEnv occ_env occs, subst)
 
-tidyTyCoVarBndr :: TidyEnv -> TyCoVar -> (TidyEnv, TyCoVar)
-tidyTyCoVarBndr tidy_env@(occ_env, subst) tyvar
-  = case tidyOccName occ_env (getHelpfulOccName tyvar) of
-      (occ_env', occ') -> ((occ_env', subst'), tyvar')
+tidyVarBndr :: TidyEnv -> TyCoVar -> (TidyEnv, TyCoVar)
+tidyVarBndr tidy_env@(occ_env, subst) var
+  = case tidyOccName occ_env (getHelpfulOccName var) of
+      (occ_env', occ') -> ((occ_env', subst'), var')
         where
-          subst' = extendVarEnv subst tyvar tyvar'
-          tyvar' = setTyVarKind (setTyVarName tyvar name') kind'
-          kind'  = tidyKind tidy_env (tyVarKind tyvar)
+          subst' = extendVarEnv subst var var'
+          var'   = setVarType (setVarName var name') type'
+          type'  = tidyType tidy_env (varType var)
           name'  = tidyNameOcc name occ'
-          name   = tyVarName tyvar
+          name   = varName var
 
 getHelpfulOccName :: TyCoVar -> OccName
-getHelpfulOccName tyvar = occ1
+getHelpfulOccName var = occ1
   where
-    name = tyVarName tyvar
+    name = varName var
     occ  = getOccName name
     -- A TcTyVar with a System Name is probably a unification variable;
     -- when we tidy them we give them a trailing "0" (or 1 etc)
@@ -3005,21 +3181,21 @@ getHelpfulOccName tyvar = occ1
     -- Plus, indicating a unification variable in this way is a
     -- helpful clue for users
     occ1 | isSystemName name
-         , isTcTyVar tyvar
+         , isTcTyVar var
          = mkTyVarOcc (occNameString occ ++ "0")
          | otherwise
          = occ
 
-tidyTyVarBinder :: TidyEnv -> TyVarBndr TyVar vis
-                -> (TidyEnv, TyVarBndr TyVar vis)
-tidyTyVarBinder tidy_env (TvBndr tv vis)
-  = (tidy_env', TvBndr tv' vis)
+tidyTyCoVarBinder :: TidyEnv -> VarBndr TyCoVar vis
+                  -> (TidyEnv, VarBndr TyCoVar vis)
+tidyTyCoVarBinder tidy_env (Bndr tv vis)
+  = (tidy_env', Bndr tv' vis)
   where
-    (tidy_env', tv') = tidyTyCoVarBndr tidy_env tv
+    (tidy_env', tv') = tidyVarBndr tidy_env tv
 
-tidyTyVarBinders :: TidyEnv -> [TyVarBndr TyVar vis]
-                 -> (TidyEnv, [TyVarBndr TyVar vis])
-tidyTyVarBinders = mapAccumL tidyTyVarBinder
+tidyTyCoVarBinders :: TidyEnv -> [VarBndr TyCoVar vis]
+                   -> (TidyEnv, [VarBndr TyCoVar vis])
+tidyTyCoVarBinders = mapAccumL tidyTyCoVarBinder
 
 ---------------
 tidyFreeTyCoVars :: TidyEnv -> [TyCoVar] -> TidyEnv
@@ -3028,7 +3204,7 @@ tidyFreeTyCoVars :: TidyEnv -> [TyCoVar] -> TidyEnv
 tidyFreeTyCoVars (full_occ_env, var_env) tyvars
   = fst (tidyOpenTyCoVars (full_occ_env, var_env) tyvars)
 
-        ---------------
+---------------
 tidyOpenTyCoVars :: TidyEnv -> [TyCoVar] -> (TidyEnv, [TyCoVar])
 tidyOpenTyCoVars env tyvars = mapAccumL tidyOpenTyCoVar env tyvars
 
@@ -3036,19 +3212,19 @@ tidyOpenTyCoVars env tyvars = mapAccumL tidyOpenTyCoVar env tyvars
 tidyOpenTyCoVar :: TidyEnv -> TyCoVar -> (TidyEnv, TyCoVar)
 -- ^ Treat a new 'TyCoVar' as a binder, and give it a fresh tidy name
 -- using the environment if one has not already been allocated. See
--- also 'tidyTyCoVarBndr'
+-- also 'tidyVarBndr'
 tidyOpenTyCoVar env@(_, subst) tyvar
   = case lookupVarEnv subst tyvar of
         Just tyvar' -> (env, tyvar')              -- Already substituted
         Nothing     ->
           let env' = tidyFreeTyCoVars env (tyCoVarsOfTypeList (tyVarKind tyvar))
-          in tidyTyCoVarBndr env' tyvar  -- Treat it as a binder
+          in tidyVarBndr env' tyvar  -- Treat it as a binder
 
 ---------------
-tidyTyVarOcc :: TidyEnv -> TyVar -> TyVar
-tidyTyVarOcc env@(_, subst) tv
+tidyTyCoVarOcc :: TidyEnv -> TyCoVar -> TyCoVar
+tidyTyCoVarOcc env@(_, subst) tv
   = case lookupVarEnv subst tv of
-        Nothing  -> updateTyVarKind (tidyType env) tv
+        Nothing  -> updateVarType (tidyType env) tv
         Just tv' -> tv'
 
 ---------------
@@ -3058,7 +3234,7 @@ tidyTypes env tys = map (tidyType env) tys
 ---------------
 tidyType :: TidyEnv -> Type -> Type
 tidyType _   (LitTy n)            = LitTy n
-tidyType env (TyVarTy tv)         = TyVarTy (tidyTyVarOcc env tv)
+tidyType env (TyVarTy tv)         = TyVarTy (tidyTyCoVarOcc env tv)
 tidyType env (TyConApp tycon tys) = let args = tidyTypes env tys
                                     in args `seqList` TyConApp tycon args
 tidyType env (AppTy fun arg)      = (AppTy $! (tidyType env fun)) $! (tidyType env arg)
@@ -3066,7 +3242,7 @@ tidyType env (FunTy fun arg)      = (FunTy $! (tidyType env fun)) $! (tidyType e
 tidyType env (ty@(ForAllTy{}))    = mkForAllTys' (zip tvs' vis) $! tidyType env' body_ty
   where
     (tvs, vis, body_ty) = splitForAllTys' ty
-    (env', tvs') = tidyTyCoVarBndrs env tvs
+    (env', tvs') = tidyVarBndrs env tvs
 tidyType env (CastTy ty co)       = (CastTy $! tidyType env ty) $! (tidyCo env co)
 tidyType env (CoercionTy co)      = CoercionTy $! (tidyCo env co)
 
@@ -3074,16 +3250,16 @@ tidyType env (CoercionTy co)      = CoercionTy $! (tidyCo env co)
 -- The following two functions differ from mkForAllTys and splitForAllTys in that
 -- they expect/preserve the ArgFlag argument. Thes belong to types/Type.hs, but
 -- how should they be named?
-mkForAllTys' :: [(TyVar, ArgFlag)] -> Type -> Type
+mkForAllTys' :: [(TyCoVar, ArgFlag)] -> Type -> Type
 mkForAllTys' tvvs ty = foldr strictMkForAllTy ty tvvs
   where
-    strictMkForAllTy (tv,vis) ty = (ForAllTy $! ((TvBndr $! tv) $! vis)) $! ty
+    strictMkForAllTy (tv,vis) ty = (ForAllTy $! ((Bndr $! tv) $! vis)) $! ty
 
-splitForAllTys' :: Type -> ([TyVar], [ArgFlag], Type)
+splitForAllTys' :: Type -> ([TyCoVar], [ArgFlag], Type)
 splitForAllTys' ty = go ty [] []
   where
-    go (ForAllTy (TvBndr tv vis) ty) tvs viss = go ty (tv:tvs) (vis:viss)
-    go ty                            tvs viss = (reverse tvs, reverse viss, ty)
+    go (ForAllTy (Bndr tv vis) ty) tvs viss = go ty (tv:tvs) (vis:viss)
+    go ty                          tvs viss = (reverse tvs, reverse viss, ty)
 
 
 ---------------
@@ -3131,7 +3307,7 @@ tidyCo env@(_, subst) co
                                in args `seqList` TyConAppCo r tc args
     go (AppCo co1 co2)       = (AppCo $! go co1) $! go co2
     go (ForAllCo tv h co)    = ((ForAllCo $! tvp) $! (go h)) $! (tidyCo envp co)
-                               where (envp, tvp) = tidyTyCoVarBndr env tv
+                               where (envp, tvp) = tidyVarBndr env tv
             -- the case above duplicates a bit of work in tidying h and the kind
             -- of tv. But the alternative is to use coercionKind, which seems worse.
     go (FunCo r co1 co2)     = (FunCo r $! go co1) $! go co2
@@ -3186,7 +3362,7 @@ typeSize (LitTy {})                 = 1
 typeSize (TyVarTy {})               = 1
 typeSize (AppTy t1 t2)              = typeSize t1 + typeSize t2
 typeSize (FunTy t1 t2)              = typeSize t1 + typeSize t2
-typeSize (ForAllTy (TvBndr tv _) t) = typeSize (tyVarKind tv) + typeSize t
+typeSize (ForAllTy (Bndr tv _) t)   = typeSize (varType tv) + typeSize t
 typeSize (TyConApp _ ts)            = 1 + sum (map typeSize ts)
 typeSize (CastTy ty co)             = typeSize ty + coercionSize co
 typeSize (CoercionTy co)            = coercionSize co
index 9f886dc..5af8c1d 100644 (file)
@@ -11,7 +11,7 @@ data Coercion
 data UnivCoProvenance
 data TCvSubst
 data TyLit
-data TyBinder
+data TyCoBinder
 data MCoercion
 
 type PredType = Type
index d5347fc..0acde99 100644 (file)
@@ -17,7 +17,7 @@ module TyCon(
         RuntimeRepInfo(..), TyConFlavour(..),
 
         -- * TyConBinder
-        TyConBinder, TyConBndrVis(..),
+        TyConBinder, TyConBndrVis(..), TyConTyCoBinder,
         mkNamedTyConBinder, mkNamedTyConBinders,
         mkAnonTyConBinder, mkAnonTyConBinders,
         tyConBinderArgFlag, tyConBndrVisArgFlag, isNamedTyConBinder,
@@ -134,7 +134,7 @@ import {-# SOURCE #-} TyCoRep    ( Kind, Type, PredType, pprType )
 import {-# SOURCE #-} TysWiredIn ( runtimeRepTyCon, constraintKind
                                  , vecCountTyCon, vecElemTyCon, liftedTypeKind
                                  , mkFunKind, mkForAllKind )
-import {-# SOURCE #-} DataCon    ( DataCon, dataConExTyVars, dataConFieldLabels
+import {-# SOURCE #-} DataCon    ( DataCon, dataConExTyCoVars, dataConFieldLabels
                                  , dataConTyCon, dataConFullSig )
 
 import Binary
@@ -248,7 +248,7 @@ See also Note [Wrappers for data instance tycons] in MkId.hs
 
   Here's the FC version of the above declaration:
 
-        data R:TPair a where
+        data R:TPair a where
           X1 :: R:TPair Int Bool
           X2 :: a -> b -> R:TPair a b
         axiom ax_pr :: T (a,b)  ~R  R:TPair a b
@@ -266,7 +266,7 @@ See also Note [Wrappers for data instance tycons] in MkId.hs
         DataFamInstTyCon T [(a,b)] ax_pr
 
 * Notice that T is NOT translated to a FC type function; it just
-  becomes a "data type" with no constructors, which can be coerced inot
+  becomes a "data type" with no constructors, which can be coerced
   into R:TInt, R:TPair by the axioms.  These axioms
   axioms come into play when (and *only* when) you
         - use a data constructor
@@ -312,7 +312,7 @@ parent class.
 
 However there is an important sharing relationship between
   * the tyConTyVars of the parent Class
-  * the tyConTyvars of the associated TyCon
+  * the tyConTyVars of the associated TyCon
 
    class C a b where
      data T p a
@@ -386,13 +386,16 @@ See also:
 
 ************************************************************************
 *                                                                      *
-                    TyConBinder
+                    TyConBinder, TyConTyCoBinder
 *                                                                      *
 ************************************************************************
 -}
 
-type TyConBinder = TyVarBndr TyVar TyConBndrVis
-                   -- See also Note [TyBinders] in TyCoRep
+type TyConBinder = VarBndr TyVar TyConBndrVis
+
+-- In the whole definition of @data TyCon@, only @PromotedDataCon@ will really
+-- contain CoVar.
+type TyConTyCoBinder = VarBndr TyCoVar TyConBndrVis
 
 data TyConBndrVis
   = NamedTCB ArgFlag
@@ -403,21 +406,23 @@ instance Outputable TyConBndrVis where
   ppr AnonTCB         = text "AnonTCB"
 
 mkAnonTyConBinder :: TyVar -> TyConBinder
-mkAnonTyConBinder tv = TvBndr tv AnonTCB
+mkAnonTyConBinder tv = ASSERT( isTyVar tv)
+                       Bndr tv AnonTCB
 
 mkAnonTyConBinders :: [TyVar] -> [TyConBinder]
 mkAnonTyConBinders tvs = map mkAnonTyConBinder tvs
 
 mkNamedTyConBinder :: ArgFlag -> TyVar -> TyConBinder
 -- The odd argument order supports currying
-mkNamedTyConBinder vis tv = TvBndr tv (NamedTCB vis)
+mkNamedTyConBinder vis tv = ASSERT( isTyVar tv )
+                            Bndr tv (NamedTCB vis)
 
 mkNamedTyConBinders :: ArgFlag -> [TyVar] -> [TyConBinder]
 -- The odd argument order supports currying
 mkNamedTyConBinders vis tvs = map (mkNamedTyConBinder vis) tvs
 
 tyConBinderArgFlag :: TyConBinder -> ArgFlag
-tyConBinderArgFlag (TvBndr _ vis) = tyConBndrVisArgFlag vis
+tyConBinderArgFlag (Bndr _ vis) = tyConBndrVisArgFlag vis
 
 tyConBndrVisArgFlag :: TyConBndrVis -> ArgFlag
 tyConBndrVisArgFlag (NamedTCB vis) = vis
@@ -427,18 +432,18 @@ isNamedTyConBinder :: TyConBinder -> Bool
 -- Identifies kind variables
 -- E.g. data T k (a:k) = blah
 -- Here 'k' is a NamedTCB, a variable used in the kind of other binders
-isNamedTyConBinder (TvBndr _ (NamedTCB {})) = True
-isNamedTyConBinder _                        = False
+isNamedTyConBinder (Bndr _ (NamedTCB {})) = True
+isNamedTyConBinder _                      = False
 
-isVisibleTyConBinder :: TyVarBndr tv TyConBndrVis -> Bool
+isVisibleTyConBinder :: VarBndr tv TyConBndrVis -> Bool
 -- Works for IfaceTyConBinder too
-isVisibleTyConBinder (TvBndr _ tcb_vis) = isVisibleTcbVis tcb_vis
+isVisibleTyConBinder (Bndr _ tcb_vis) = isVisibleTcbVis tcb_vis
 
 isVisibleTcbVis :: TyConBndrVis -> Bool
 isVisibleTcbVis (NamedTCB vis) = isVisibleArgFlag vis
 isVisibleTcbVis AnonTCB        = True
 
-isInvisibleTyConBinder :: TyVarBndr tv TyConBndrVis -> Bool
+isInvisibleTyConBinder :: VarBndr tv TyConBndrVis -> Bool
 -- Works for IfaceTyConBinder too
 isInvisibleTyConBinder tcb = not (isVisibleTyConBinder tcb)
 
@@ -446,8 +451,8 @@ mkTyConKind :: [TyConBinder] -> Kind -> Kind
 mkTyConKind bndrs res_kind = foldr mk res_kind bndrs
   where
     mk :: TyConBinder -> Kind -> Kind
-    mk (TvBndr tv AnonTCB)        k = mkFunKind (tyVarKind tv) k
-    mk (TvBndr tv (NamedTCB vis)) k = mkForAllKind tv vis k
+    mk (Bndr tv AnonTCB)        k = mkFunKind (varType tv) k
+    mk (Bndr tv (NamedTCB vis)) k = mkForAllKind tv vis k
 
 tyConTyVarBinders :: [TyConBinder]   -- From the TyCon
                   -> [TyVarBinder]   -- Suitable for the foralls of a term function
@@ -455,16 +460,17 @@ tyConTyVarBinders :: [TyConBinder]   -- From the TyCon
 tyConTyVarBinders tc_bndrs
  = map mk_binder tc_bndrs
  where
-   mk_binder (TvBndr tv tc_vis) = mkTyVarBinder vis tv
+   mk_binder (Bndr tv tc_vis) = mkTyVarBinder vis tv
       where
         vis = case tc_vis of
                 AnonTCB           -> Specified
                 NamedTCB Required -> Specified
                 NamedTCB vis      -> vis
 
+-- Returns only tyvars, as covars are always inferred
 tyConVisibleTyVars :: TyCon -> [TyVar]
 tyConVisibleTyVars tc
-  = [ tv | TvBndr tv vis <- tyConBinders tc
+  = [ tv | Bndr tv vis <- tyConBinders tc
          , isVisibleTcbVis vis ]
 
 {- Note [Building TyVarBinders from TyConBinders]
@@ -476,12 +482,12 @@ TyConBinders but TyVarBinders (used in forall-type)  E.g:
  *  From   data T a = MkT (Maybe a)
     we are going to make a data constructor with type
            MkT :: forall a. Maybe a -> T a
-    See the TyVarBinders passed to buildDataCon
+    See the TyCoVarBinders passed to buildDataCon
 
  * From    class C a where { op :: a -> Maybe a }
    we are going to make a default method
            $dmop :: forall a. C a => a -> Maybe a
-   See the TyVarBindres passed to mkSigmaTy in mkDefaultMethodType
+   See the TyCoVarBinders passed to mkSigmaTy in mkDefaultMethodType
 
 Both of these are user-callable.  (NB: default methods are not callable
 directly by the user but rather via the code generated by 'deriving',
@@ -495,18 +501,18 @@ Here is an example:
 
 The TyCon has
 
-  tyConTyBinders = [ Named (TvBndr (k :: *) Inferred), Anon (k->*), Anon k ]
+  tyConTyBinders = [ Named (Bndr (k :: *) Inferred), Anon (k->*), Anon k ]
 
 The TyConBinders for App line up with App's kind, given above.
 
 But the DataCon MkApp has the type
   MkApp :: forall {k} (a:k->*) (b:k). a b -> App k a b
 
-That is, its TyVarBinders should be
+That is, its TyCoVarBinders should be
 
-  dataConUnivTyVarBinders = [ TvBndr (k:*)    Inferred
-                            , TvBndr (a:k->*) Specified
-                            , TvBndr (b:k)    Specified ]
+  dataConUnivTyVarBinders = [ Bndr (k:*)    Inferred
+                            , Bndr (a:k->*) Specified
+                            , Bndr (b:k)    Specified ]
 
 So tyConTyVarBinders converts TyCon's TyConBinders into TyVarBinders:
   - variable names from the TyConBinders
@@ -515,43 +521,46 @@ So tyConTyVarBinders converts TyCon's TyConBinders into TyVarBinders:
 The last part about Required->Specified comes from this:
   data T k (a:k) b = MkT (a b)
 Here k is Required in T's kind, but we don't have Required binders in
-the TyBinders for a term (see Note [No Required TyBinder in terms]
-in TyCoRep), so we change it to Specified when making MkT's TyBinders
+the TyCoBinders for a term (see Note [No Required TyCoBinder in terms]
+in TyCoRep), so we change it to Specified when making MkT's TyCoBinders
 -}
 
 
 {- Note [The binders/kind/arity fields of a TyCon]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 All TyCons have this group of fields
-  tyConBinders :: [TyConBinder]
-  tyConResKind :: Kind
-  tyConTyVars  :: [TyVar] -- Cached = binderVars tyConBinders
-  tyConKind    :: Kind    -- Cached = mkTyConKind tyConBinders tyConResKind
-  tyConArity   :: Arity   -- Cached = length tyConBinders
+  tyConBinders   :: [TyConBinder/TyConTyCoBinder]
+  tyConResKind   :: Kind
+  tyConTyVars    :: [TyVar]   -- Cached = binderVars tyConBinders
+                              --   NB: Currently (Aug 2018), TyCons that own this
+                              --   field really only contain TyVars. So it is
+                              --   [TyVar] instead of [TyCoVar].
+  tyConKind      :: Kind      -- Cached = mkTyConKind tyConBinders tyConResKind
+  tyConArity     :: Arity     -- Cached = length tyConBinders
 
 They fit together like so:
 
-* tyConBinders gives the telescope of type variables on the LHS of the
+* tyConBinders gives the telescope of type/coercion variables on the LHS of the
   type declaration.  For example:
 
     type App a (b :: k) = a b
 
-  tyConBinders = [ TvBndr (k::*)   (NamedTCB Inferred)
-                 , TvBndr (a:k->*) AnonTCB
-                 , TvBndr (b:k)    AnonTCB ]
+  tyConBinders = [ Bndr (k::*)   (NamedTCB Inferred)
+                 , Bndr (a:k->*) AnonTCB
+                 , Bndr (b:k)    AnonTCB ]
 
   Note that that are three binders here, including the
   kind variable k.
 
-- See Note [TyVarBndrs, TyVarBinders, TyConBinders, and visibility] in TyCoRep
+- See Note [VarBndrs, TyCoVarBinders, TyConBinders, and visibility] in TyCoRep
   for what the visibility flag means.
 
-* Each TyConBinder tyConBinders has a TyVar, and that TyVar may
-  scope over some other part of the TyCon's definition. Eg
-      type T a = a->a
+* Each TyConBinder tyConBinders has a TyVar (sometimes it is TyCoVar), and
+  that TyVar may scope over some other part of the TyCon's definition. Eg
+      type T a = a -> a
   we have
-      tyConBinders = [ TvBndr (a:*) AnonTCB ]
-      synTcRhs     = a->a
+      tyConBinders = [ Bndr (a:*) AnonTCB ]
+      synTcRhs     = a -> a
   So the 'a' scopes over the synTcRhs
 
 * From the tyConBinders and tyConResKind we can get the tyConKind
@@ -569,11 +578,11 @@ They fit together like so:
   So it's just (length tyConBinders)
 -}
 
-instance Outputable tv => Outputable (TyVarBndr tv TyConBndrVis) where
-  ppr (TvBndr v AnonTCB)              = text "anon" <+> parens (ppr v)
-  ppr (TvBndr v (NamedTCB Required))  = text "req"  <+> parens (ppr v)
-  ppr (TvBndr v (NamedTCB Specified)) = text "spec" <+> parens (ppr v)
-  ppr (TvBndr v (NamedTCB Inferred))  = text "inf"  <+> parens (ppr v)
+instance Outputable tv => Outputable (VarBndr tv TyConBndrVis) where
+  ppr (Bndr v AnonTCB)              = text "anon" <+> parens (ppr v)
+  ppr (Bndr v (NamedTCB Required))  = text "req"  <+> parens (ppr v)
+  ppr (Bndr v (NamedTCB Specified)) = text "spec" <+> parens (ppr v)
+  ppr (Bndr v (NamedTCB Inferred))  = text "inf"  <+> parens (ppr v)
 
 instance Binary TyConBndrVis where
   put_ bh AnonTCB        = putByte bh 0
@@ -802,7 +811,7 @@ data TyCon
         tyConName    :: Name,       -- ^ Same Name as the data constructor
 
         -- See Note [The binders/kind/arity fields of a TyCon]
-        tyConBinders :: [TyConBinder], -- ^ Full binders
+        tyConBinders :: [TyConTyCoBinder], -- ^ Full binders
         tyConResKind :: Kind,             -- ^ Result kind
         tyConKind    :: Kind,             -- ^ Kind of this TyCon
         tyConArity   :: Arity,            -- ^ Arity
@@ -1648,7 +1657,7 @@ mkFamilyTyCon name binders res_kind resVar flav parent inj
 -- as the data constructor itself; when we pretty-print
 -- the TyCon we add a quote; see the Outputable TyCon instance
 mkPromotedDataCon :: DataCon -> Name -> TyConRepName
-                  -> [TyConBinder] -> Kind -> [Role]
+                  -> [TyConTyCoBinder] -> Kind -> [Role]
                   -> RuntimeRepInfo -> TyCon
 mkPromotedDataCon con name rep_name binders res_kind roles rep_info
   = PromotedDataCon {
@@ -1780,8 +1789,9 @@ isNewTyCon :: TyCon -> Bool
 isNewTyCon (AlgTyCon {algTcRhs = NewTyCon {}}) = True
 isNewTyCon _                                   = False
 
--- | Take a 'TyCon' apart into the 'TyVar's it scopes over, the 'Type' it expands
--- into, and (possibly) a coercion from the representation type to the @newtype@.
+-- | Take a 'TyCon' apart into the 'TyVar's it scopes over, the 'Type' it
+-- expands into, and (possibly) a coercion from the representation type to the
+-- @newtype@.
 -- Returns @Nothing@ if this is not possible.
 unwrapNewTyCon_maybe :: TyCon -> Maybe ([TyVar], Type, CoAxiom Unbranched)
 unwrapNewTyCon_maybe (AlgTyCon { tyConTyVars = tvs,
@@ -1804,7 +1814,7 @@ isProductTyCon tc@(AlgTyCon {})
   = case algTcRhs tc of
       TupleTyCon {} -> True
       DataTyCon{ data_cons = [data_con] }
-                    -> null (dataConExTyVars data_con)
+                    -> null (dataConExTyCoVars data_con)
       NewTyCon {}   -> True
       _             -> False
 isProductTyCon _ = False
@@ -1816,7 +1826,7 @@ isDataProductTyCon_maybe :: TyCon -> Maybe DataCon
 isDataProductTyCon_maybe (AlgTyCon { algTcRhs = rhs })
   = case rhs of
        DataTyCon { data_cons = [con] }
-         | null (dataConExTyVars con)  -- non-existential
+         | null (dataConExTyCoVars con)  -- non-existential
          -> Just con
        TupleTyCon { data_con = con }
          -> Just con
@@ -1828,10 +1838,10 @@ isDataSumTyCon_maybe (AlgTyCon { algTcRhs = rhs })
   = case rhs of
       DataTyCon { data_cons = cons }
         | cons `lengthExceeds` 1
-        , all (null . dataConExTyVars) cons -- FIXME(osa): Why do we need this?
+        , all (null . dataConExTyCoVars) cons -- FIXME(osa): Why do we need this?
         -> Just cons
       SumTyCon { data_cons = cons }
-        | all (null . dataConExTyVars) cons -- FIXME(osa): Why do we need this?
+        | all (null . dataConExTyCoVars) cons -- FIXME(osa): Why do we need this?
         -> Just cons
       _ -> Nothing
 isDataSumTyCon_maybe _ = Nothing
index 180af38..bda3602 100644 (file)
@@ -15,12 +15,12 @@ module Type (
 
         -- $representation_types
         TyThing(..), Type, ArgFlag(..), KindOrType, PredType, ThetaType,
-        Var, TyVar, isTyVar, TyCoVar, TyBinder, TyVarBinder,
+        Var, TyVar, isTyVar, TyCoVar, TyCoBinder, TyCoVarBinder, TyVarBinder,
         KnotTied,
 
         -- ** Constructing and deconstructing types
         mkTyVarTy, mkTyVarTys, getTyVar, getTyVar_maybe, repGetTyVar_maybe,
-        getCastedTyVar_maybe, tyVarKind,
+        getCastedTyVar_maybe, tyVarKind, varType,
 
         mkAppTy, mkAppTys, splitAppTy, splitAppTys, repSplitAppTys,
         splitAppTy_maybe, repSplitAppTy_maybe, tcRepSplitAppTy_maybe,
@@ -36,12 +36,15 @@ module Type (
         splitListTyConApp_maybe,
         repSplitTyConApp_maybe,
 
-        mkForAllTy, mkForAllTys, mkInvForAllTys, mkSpecForAllTys,
-        mkVisForAllTys, mkInvForAllTy,
-        splitForAllTys, splitForAllTyVarBndrs,
+        mkForAllTy, mkForAllTys, mkTyCoInvForAllTys, mkSpecForAllTys,
+        mkVisForAllTys, mkTyCoInvForAllTy,
+        mkInvForAllTy, mkInvForAllTys,
+        splitForAllTys, splitForAllVarBndrs,
         splitForAllTy_maybe, splitForAllTy,
+        splitForAllTy_ty_maybe, splitForAllTy_co_maybe,
         splitPiTy_maybe, splitPiTy, splitPiTys,
-        mkPiTy, mkPiTys, mkTyConBindersPreferAnon,
+        mkTyCoPiTy, mkTyCoPiTys, mkTyConBindersPreferAnon,
+        mkPiTys,
         mkLamType, mkLamTypes,
         piResultTy, piResultTys,
         applyTysX, dropForAlls,
@@ -90,14 +93,16 @@ module Type (
 
         -- ** Binders
         sameVis,
-        mkTyVarBinder, mkTyVarBinders,
+        mkTyCoVarBinder, mkTyCoVarBinders,
+        mkTyVarBinders,
         mkAnonBinder,
-        isAnonTyBinder, isNamedTyBinder,
-        binderVar, binderVars, binderKind, binderArgFlag,
-        tyBinderType, tyBinderVar_maybe,
+        isAnonTyCoBinder, isNamedTyCoBinder,
+        binderVar, binderVars, binderType, binderArgFlag,
+        tyCoBinderType, tyCoBinderVar_maybe,
+        tyBinderType,
         binderRelevantType_maybe, caseBinder,
         isVisibleArgFlag, isInvisibleArgFlag, isVisibleBinder, isInvisibleBinder,
-        tyConBindersTyBinders,
+        tyConBindersTyCoBinders,
 
         -- ** Common type constructors
         funTyCon,
@@ -105,6 +110,7 @@ module Type (
         -- ** Predicates on types
         isTyVarTy, isFunTy, isDictTy, isPredTy, isCoercionTy,
         isCoercionTy_maybe, isCoercionType, isForAllTy,
+        isForAllTy_ty, isForAllTy_co,
         isPiTy, isTauTy, isFamFreeTy,
 
         isValidJoinPointType,
@@ -163,6 +169,7 @@ module Type (
         emptyTvSubstEnv, emptyTCvSubst, mkEmptyTCvSubst,
 
         mkTCvSubst, zipTvSubst, mkTvSubstPrs,
+        zipTCvSubst,
         notElemTCvSubst,
         getTvSubstEnv, setTvSubstEnv,
         zapTCvSubst, getTCvInScope, getTCvSubstRangeFVs,
@@ -170,7 +177,9 @@ module Type (
         extendTCvSubst, extendCvSubst,
         extendTvSubst, extendTvSubstBinderAndInScope,
         extendTvSubstList, extendTvSubstAndInScope,
+        extendTCvSubstList,
         extendTvSubstWithClone,
+        extendTCvSubstWithClone,
         isInScope, composeTCvSubstEnv, composeTCvSubst, zipTyEnv, zipCoEnv,
         isEmptyTCvSubst, unionTCvSubst,
 
@@ -181,12 +190,13 @@ module Type (
         substTyWithUnchecked,
         substCoUnchecked, substCoWithUnchecked,
         substTyVarBndr, substTyVarBndrs, substTyVar, substTyVars,
+        substVarBndr, substVarBndrs,
         cloneTyVarBndr, cloneTyVarBndrs, lookupTyVar,
 
         -- * Pretty-printing
         pprType, pprParendType, pprPrecType,
         pprTypeApp, pprTyThingCategory, pprShortTyThing,
-        pprTvBndr, pprTvBndrs, pprForAll, pprUserForAll,
+        pprTCvBndr, pprTCvBndrs, pprForAll, pprUserForAll,
         pprSigmaType, ppSuggestExplicitKinds,
         pprTheta, pprThetaArrowTy, pprClassPred,
         pprKind, pprParendKind, pprSourceTyCon,
@@ -198,12 +208,12 @@ module Type (
         tidyType,      tidyTypes,
         tidyOpenType,  tidyOpenTypes,
         tidyOpenKind,
-        tidyTyCoVarBndr, tidyTyCoVarBndrs, tidyFreeTyCoVars,
+        tidyVarBndr, tidyVarBndrs, tidyFreeTyCoVars,
         tidyOpenTyCoVar, tidyOpenTyCoVars,
-        tidyTyVarOcc,
+        tidyTyCoVarOcc,
         tidyTopType,
         tidyKind,
-        tidyTyVarBinder, tidyTyVarBinders
+        tidyTyCoVarBinder, tidyTyCoVarBinders
     ) where
 
 #include "HsVersions.h"
@@ -307,7 +317,7 @@ import Control.Arrow    ( first, second )
 --
 -- You don't normally have to worry about this, as the utility functions in
 -- this module will automatically convert a source into a representation type
--- if they are spotted, to the best of it's abilities. If you don't want this
+-- if they are spotted, to the best of its abilities. If you don't want this
 -- to happen, use the equivalent functions from the "TcType" module.
 
 {-
@@ -404,9 +414,9 @@ expandTypeSynonyms ty
     go subst (AppTy t1 t2) = mkAppTy (go subst t1) (go subst t2)
     go subst (FunTy arg res)
       = mkFunTy (go subst arg) (go subst res)
-    go subst (ForAllTy (TvBndr tv vis) t)
-      = let (subst', tv') = substTyVarBndrUsing go subst tv in
-        ForAllTy (TvBndr tv' vis) (go subst' t)
+    go subst (ForAllTy (Bndr tv vis) t)
+      = let (subst', tv') = substVarBndrUsing go subst tv in
+        ForAllTy (Bndr tv' vis) (go subst' t)
     go subst (CastTy ty co)  = mkCastTy (go subst ty) (go_co subst co)
     go subst (CoercionTy co) = mkCoercionTy (go_co subst co)
 
@@ -476,11 +486,11 @@ on all variables and binding sites. Primarily used for zonking.
 Note [Efficiency for mapCoercion ForAllCo case]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 As noted in Note [Forall coercions] in TyCoRep, a ForAllCo is a bit redundant.
-It stores a TyVar and a Coercion, where the kind of the TyVar always matches
+It stores a TyCoVar and a Coercion, where the kind of the TyCoVar always matches
 the left-hand kind of the coercion. This is convenient lots of the time, but
 not when mapping a function over a coercion.
 
-The problem is that tcm_tybinder will affect the TyVar's kind and
+The problem is that tcm_tybinder will affect the TyCoVar's kind and
 mapCoercion will affect the Coercion, and we hope that the results will be
 the same. Even if they are the same (which should generally happen with
 correct algorithms), then there is an efficiency issue. In particular,
@@ -514,7 +524,7 @@ data TyCoMapper env m
           -- ^ What to do with coercion holes.
           -- See Note [Coercion holes] in TyCoRep.
 
-      , tcm_tybinder :: env -> TyVar -> ArgFlag -> m (env, TyVar)
+      , tcm_tycobinder :: env -> TyCoVar -> ArgFlag -> m (env, TyCoVar)
           -- ^ The returned env is used in the extended scope
 
       , tcm_tycon :: TyCon -> m TyCon
@@ -526,7 +536,7 @@ data TyCoMapper env m
 {-# INLINABLE mapType #-}  -- See Note [Specialising mappers]
 mapType :: Monad m => TyCoMapper env m -> env -> Type -> m Type
 mapType mapper@(TyCoMapper { tcm_smart = smart, tcm_tyvar = tyvar
-                           , tcm_tybinder = tybinder, tcm_tycon = tycon })
+                           , tcm_tycobinder = tycobinder, tcm_tycon = tycon })
         env ty
   = go ty
   where
@@ -539,10 +549,10 @@ mapType mapper@(TyCoMapper { tcm_smart = smart, tcm_tyvar = tyvar
       = do { tc' <- tycon tc
            ; mktyconapp tc' <$> mapM go tys }
     go (FunTy arg res)   = FunTy <$> go arg <*> go res
-    go (ForAllTy (TvBndr tv vis) inner)
-      = do { (env', tv') <- tybinder env tv vis
+    go (ForAllTy (Bndr tv vis) inner)
+      = do { (env', tv') <- tycobinder env tv vis
            ; inner' <- mapType mapper env' inner
-           ; return $ ForAllTy (TvBndr tv' vis) inner' }
+           ; return $ ForAllTy (Bndr tv' vis) inner' }
     go ty@(LitTy {})   = return ty
     go (CastTy ty co)  = mkcastty <$> go ty <*> mapCoercion mapper env co
     go (CoercionTy co) = CoercionTy <$> mapCoercion mapper env co
@@ -555,7 +565,7 @@ mapType mapper@(TyCoMapper { tcm_smart = smart, tcm_tyvar = tyvar
 mapCoercion :: Monad m
             => TyCoMapper env m -> env -> Coercion -> m Coercion
 mapCoercion mapper@(TyCoMapper { tcm_smart = smart, tcm_covar = covar
-                               , tcm_hole = cohole, tcm_tybinder = tybinder
+                               , tcm_hole = cohole, tcm_tycobinder = tycobinder
                                , tcm_tycon = tycon })
             env co
   = go co
@@ -571,7 +581,7 @@ mapCoercion mapper@(TyCoMapper { tcm_smart = smart, tcm_covar = covar
     go (AppCo c1 c2) = mkappco <$> go c1 <*> go c2
     go (ForAllCo tv kind_co co)
       = do { kind_co' <- go kind_co
-           ; (env', tv') <- tybinder env tv Inferred
+           ; (env', tv') <- tycobinder env tv Inferred
            ; co' <- mapCoercion mapper env' co
            ; return $ mkforallco tv' kind_co' co' }
         -- See Note [Efficiency for mapCoercion ForAllCo case]
@@ -638,7 +648,7 @@ getTyVar_maybe ty | Just ty' <- coreView ty = getTyVar_maybe ty'
                   | otherwise               = repGetTyVar_maybe ty
 
 -- | If the type is a tyvar, possibly under a cast, returns it, along
--- with the coercion. Thus, the co is :: kind tv ~N kind type
+-- with the coercion. Thus, the co is :: kind tv ~N kind ty
 getCastedTyVar_maybe :: Type -> Maybe (TyVar, CoercionN)
 getCastedTyVar_maybe ty | Just ty' <- coreView ty = getCastedTyVar_maybe ty'
 getCastedTyVar_maybe (CastTy (TyVarTy tv) co)     = Just (tv, co)
@@ -912,7 +922,7 @@ pprUserTypeErrorTy ty =
 Note [Representation of function types]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 
-Functions (e.g. Int -> Char) are can be thought of as being applications
+Functions (e.g. Int -> Char) can be thought of as being applications
 of funTyCon (known in Haskell surface syntax as (->)),
 
     (->) :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep)
@@ -973,26 +983,25 @@ funArgTy ty | Just ty' <- coreView ty = funArgTy ty'
 funArgTy (FunTy arg _res) = arg
 funArgTy ty               = pprPanic "funArgTy" (ppr ty)
 
+-- ^ Just like 'piResultTys' but for a single argument
+-- Try not to iterate 'piResultTy', because it's inefficient to substitute
+-- one variable at a time; instead use 'piResultTys"
 piResultTy :: HasDebugCallStack => Type -> Type ->  Type
 piResultTy ty arg = case piResultTy_maybe ty arg of
                       Just res -> res
                       Nothing  -> pprPanic "piResultTy" (ppr ty $$ ppr arg)
 
 piResultTy_maybe :: Type -> Type -> Maybe Type
-
--- ^ Just like 'piResultTys' but for a single argument
--- Try not to iterate 'piResultTy', because it's inefficient to substitute
--- one variable at a time; instead use 'piResultTys"
 piResultTy_maybe ty arg
   | Just ty' <- coreView ty = piResultTy_maybe ty' arg
 
   | FunTy _ res <- ty
   = Just res
 
-  | ForAllTy (TvBndr tv _) res <- ty
+  | ForAllTy (Bndr tv _) res <- ty
   = let empty_subst = mkEmptyTCvSubst $ mkInScopeSet $
                       tyCoVarsOfTypes [arg,res]
-    in Just (substTy (extendTvSubst empty_subst tv arg) res)
+    in Just (substTy (extendTCvSubst empty_subst tv arg) res)
 
   | otherwise
   = Nothing
@@ -1027,30 +1036,30 @@ piResultTys ty orig_args@(arg:args)
   | FunTy _ res <- ty
   = piResultTys res args
 
-  | ForAllTy (TvBndr tv _) res <- ty
-  = go (extendVarEnv emptyTvSubstEnv tv arg) res args
+  | ForAllTy (Bndr tv _) res <- ty
+  = go (extendTCvSubst init_subst tv arg) res args
 
   | otherwise
   = pprPanic "piResultTys1" (ppr ty $$ ppr orig_args)
   where
-    in_scope = mkInScopeSet (tyCoVarsOfTypes (ty:orig_args))
+    init_subst = mkEmptyTCvSubst $ mkInScopeSet (tyCoVarsOfTypes (ty:orig_args))
 
-    go :: TvSubstEnv -> Type -> [Type] -> Type
-    go tv_env ty [] = substTy (mkTvSubst in_scope tv_env) ty
+    go :: TCvSubst -> Type -> [Type] -> Type
+    go subst ty [] = substTy subst ty
 
-    go tv_env ty all_args@(arg:args)
+    go subst ty all_args@(arg:args)
       | Just ty' <- coreView ty
-      = go tv_env ty' all_args
+      = go subst ty' all_args
 
       | FunTy _ res <- ty
-      = go tv_env res args
+      = go subst res args
 
-      | ForAllTy (TvBndr tv _) res <- ty
-      = go (extendVarEnv tv_env tv arg) res args
+      | ForAllTy (Bndr tv _) res <- ty
+      = go (extendTCvSubst subst tv arg) res args
 
-      | not (isEmptyVarEnv tv_env)  -- See Note [Care with kind instantiation]
-      = go emptyTvSubstEnv
-          (substTy (mkTvSubst in_scope tv_env) ty)
+      | not (isEmptyTCvSubst subst)  -- See Note [Care with kind instantiation]
+      = go init_subst
+          (substTy subst ty)
           all_args
 
       | otherwise
@@ -1088,7 +1097,7 @@ So
   T (forall b. b->b) * :: (b -> b)[ b :-> *]
                        :: * -> *
 
-In other words wwe must intantiate the forall!
+In other words we must intantiate the forall!
 
 Similarly (Trac #15428)
    S :: forall k f. k -> f k
@@ -1217,6 +1226,21 @@ newTyConInstRhs tycon tys
                            ~~~~~~
 A casted type has its *kind* casted into something new.
 
+Note [Weird typing rule for ForAllTy]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Here is the (truncated) typing rule for the dependent ForAllTy:
+
+inner : kind
+------------------------------------
+ForAllTy (Bndr tyvar vis) inner : kind
+
+inner : TYPE r
+------------------------------------
+ForAllTy (Bndr covar vis) inner : TYPE
+
+Note that when inside the binder is a tyvar, neither the inner type nor for
+ForAllTy itself have to have kind *! But, it means that we should push any kind
+casts through the ForAllTy. The only trouble is avoiding capture.
 -}
 
 splitCastTy_maybe :: Type -> Maybe (Type, Coercion)
@@ -1235,16 +1259,30 @@ mkCastTy ty co | isReflexiveCo co = ty  -- (EQ2) from the Note
 -- fails under splitFunTy_maybe. This happened with the cheaper check
 -- in test dependent/should_compile/dynamic-paper.
 
-mkCastTy (CastTy ty co1) co2 = mkCastTy ty (co1 `mkTransCo` co2) -- (EQ3) from the Note
-                          -- call mkCastTy again for the reflexivity check
+mkCastTy (CastTy ty co1) co2
+  -- (EQ3) from the Note
+  = mkCastTy ty (co1 `mkTransCo` co2)
+      -- call mkCastTy again for the reflexivity check
+
+mkCastTy (ForAllTy (Bndr tv vis) inner_ty) co
+  -- (EQ4) from the Note
+  | isTyVar tv
+  , let fvs = tyCoVarsOfCo co
+  = -- have to make sure that pushing the co in doesn't capture the bound var!
+    if tv `elemVarSet` fvs
+    then let empty_subst = mkEmptyTCvSubst (mkInScopeSet fvs)
+             (subst, tv') = substVarBndr empty_subst tv
+         in ForAllTy (Bndr tv' vis) (substTy subst inner_ty `mkCastTy` co)
+    else ForAllTy (Bndr tv vis) (inner_ty `mkCastTy` co)
+
 mkCastTy ty co = CastTy ty co
 
-tyConBindersTyBinders :: [TyConBinder] -> [TyBinder]
--- Return the tyConBinders in TyBinder form
-tyConBindersTyBinders = map to_tyb
+tyConBindersTyCoBinders :: [TyConBinder] -> [TyCoBinder]
+-- Return the tyConBinders in TyCoBinder form
+tyConBindersTyCoBinders = map to_tyb
   where
-    to_tyb (TvBndr tv (NamedTCB vis)) = Named (TvBndr tv vis)
-    to_tyb (TvBndr tv AnonTCB)        = Anon (tyVarKind tv)
+    to_tyb (Bndr tv (NamedTCB vis)) = Named (Bndr tv vis)
+    to_tyb (Bndr tv AnonTCB)        = Anon (varType tv)
 
 {-
 --------------------------------------------------------------------
@@ -1296,26 +1334,40 @@ interfaces.  Notably this plays a role in tcTySigs in TcBinds.hs.
 
 -- | Make a dependent forall over an Inferred (as opposed to Specified)
 -- variable
+mkTyCoInvForAllTy :: TyCoVar -> Type -> Type
+mkTyCoInvForAllTy tv ty
+  | isCoVar tv
+  , not (tv `elemVarSet` tyCoVarsOfType ty)
+  = mkFunTy (varType tv) ty
+  | otherwise
+  = ForAllTy (Bndr tv Inferred) ty
+
+-- | Like mkTyCoInvForAllTy, but tv should be a tyvar
 mkInvForAllTy :: TyVar -> Type -> Type
 mkInvForAllTy tv ty = ASSERT( isTyVar tv )
-                      ForAllTy (TvBndr tv Inferred) ty
+                      ForAllTy (Bndr tv Inferred) ty
 
 -- | Like mkForAllTys, but assumes all variables are dependent and Inferred,
 -- a common case
+mkTyCoInvForAllTys :: [TyCoVar] -> Type -> Type
+mkTyCoInvForAllTys tvs ty = foldr mkTyCoInvForAllTy ty tvs
+
+-- | Like 'mkTyCoInvForAllTys', but tvs should be a list of tyvar
 mkInvForAllTys :: [TyVar] -> Type -> Type
-mkInvForAllTys tvs ty = ASSERT( all isTyVar tvs )
-                        foldr mkInvForAllTy ty tvs
+mkInvForAllTys tvs ty = foldr mkInvForAllTy ty tvs
 
 -- | Like mkForAllTys, but assumes all variables are dependent and specified,
 -- a common case
 mkSpecForAllTys :: [TyVar] -> Type -> Type
 mkSpecForAllTys tvs = ASSERT( all isTyVar tvs )
-                     mkForAllTys [ TvBndr tv Specified | tv <- tvs ]
+                      -- covar is always Inferred, so all inputs should be tyvar
+                      mkForAllTys [ Bndr tv Specified | tv <- tvs ]
 
 -- | Like mkForAllTys, but assumes all variables are dependent and visible
 mkVisForAllTys :: [TyVar] -> Type -> Type
 mkVisForAllTys tvs = ASSERT( all isTyVar tvs )
-                     mkForAllTys [ TvBndr tv Required | tv <- tvs ]
+                     -- covar is always Inferred, so all inputs should be tyvar
+                     mkForAllTys [ Bndr tv Required | tv <- tvs ]
 
 mkLamType  :: Var -> Type -> Type
 -- ^ Makes a @(->)@ type or an implicit forall type, depending
@@ -1326,51 +1378,67 @@ mkLamTypes :: [Var] -> Type -> Type
 -- ^ 'mkLamType' for multiple type or value arguments
 
 mkLamType v ty
-   | isTyVar v = ForAllTy (TvBndr v Inferred) ty
-   | otherwise = FunTy    (varType v)          ty
+   | isCoVar v
+   , v `elemVarSet` tyCoVarsOfType ty
+   = ForAllTy (Bndr v Inferred) ty
+   | isTyVar v
+   = ForAllTy (Bndr v Inferred) ty
+   | otherwise
+   = FunTy (varType v) ty
 
 mkLamTypes vs ty = foldr mkLamType ty vs
 
 -- | Given a list of type-level vars and a result kind,
--- makes TyBinders, preferring anonymous binders
+-- makes TyCoBinders, preferring anonymous binders
 -- if the variable is, in fact, not dependent.
 -- e.g.    mkTyConBindersPreferAnon [(k:*),(b:k),(c:k)] (k->k)
--- We want (k:*) Named, (a;k) Anon, (c:k) Anon
+-- We want (k:*) Named, (b:k) Anon, (c:k) Anon
 --
--- All binders are /visible/.
+-- All non-coercion binders are /visible/.
 mkTyConBindersPreferAnon :: [TyVar] -> Type -> [TyConBinder]
-mkTyConBindersPreferAnon vars inner_ty = fst (go vars)
+mkTyConBindersPreferAnon vars inner_ty = ASSERT( all isTyVar vars)
+                                               fst (go vars)
   where
     go :: [TyVar] -> ([TyConBinder], VarSet) -- also returns the free vars
     go [] = ([], tyCoVarsOfType inner_ty)
-    go (v:vs) |  v `elemVarSet` fvs
-              = ( TvBndr v (NamedTCB Required) : binders
+    go (v:vs) | v `elemVarSet` fvs
+              = ( Bndr v (NamedTCB Required) : binders
                 , fvs `delVarSet` v `unionVarSet` kind_vars )
               | otherwise
-              = ( TvBndr v AnonTCB : binders
+              = ( Bndr v AnonTCB : binders
                 , fvs `unionVarSet` kind_vars )
       where
         (binders, fvs) = go vs
         kind_vars      = tyCoVarsOfType $ tyVarKind v
 
--- | Take a ForAllTy apart, returning the list of tyvars and the result type.
+-- | Take a ForAllTy apart, returning the list of tycovars and the result type.
 -- This always succeeds, even if it returns only an empty list. Note that the
 -- result type returned may have free variables that were bound by a forall.
-splitForAllTys :: Type -> ([TyVar], Type)
+splitForAllTys :: Type -> ([TyCoVar], Type)
 splitForAllTys ty = split ty ty []
   where
     split orig_ty ty tvs | Just ty' <- coreView ty = split orig_ty ty' tvs
-    split _       (ForAllTy (TvBndr tv _) ty) tvs = split ty ty (tv:tvs)
-    split orig_ty _                           tvs = (reverse tvs, orig_ty)
+    split _       (ForAllTy (Bndr tv _) ty)    tvs = split ty ty (tv:tvs)
+    split orig_ty _                            tvs = (reverse tvs, orig_ty)
+
+-- | Like splitForAllTys, but split only for tyvars.
+-- This always succeeds, even if it returns only an empty list. Note that the
+-- result type returned may have free variables that were bound by a forall.
+splitTyVarForAllTys :: Type -> ([TyVar], Type)
+splitTyVarForAllTys ty = split ty ty []
+  where
+    split orig_ty ty tvs | Just ty' <- coreView ty     = split orig_ty ty' tvs
+    split _ (ForAllTy (Bndr tv _) ty) tvs | isTyVar tv = split ty ty (tv:tvs)
+    split orig_ty _                   tvs              = (reverse tvs, orig_ty)
 
 -- | Like 'splitPiTys' but split off only /named/ binders.
-splitForAllTyVarBndrs :: Type -> ([TyVarBinder], Type)
-splitForAllTyVarBndrs ty = split ty ty []
+splitForAllVarBndrs :: Type -> ([TyCoVarBinder], Type)
+splitForAllVarBndrs ty = split ty ty []
   where
     split orig_ty ty bs | Just ty' <- coreView ty = split orig_ty ty' bs
     split _       (ForAllTy b res) bs = split res res (b:bs)
     split orig_ty _                bs = (reverse bs, orig_ty)
-{-# INLINE splitForAllTyVarBndrs #-}
+{-# INLINE splitForAllVarBndrs #-}
 
 -- | Checks whether this is a proper forall (with a named binder)
 isForAllTy :: Type -> Bool
@@ -1378,6 +1446,18 @@ isForAllTy ty | Just ty' <- coreView ty = isForAllTy ty'
 isForAllTy (ForAllTy {}) = True
 isForAllTy _             = False
 
+-- | Like `isForAllTy`, but returns True only if it is a tyvar binder
+isForAllTy_ty :: Type -> Bool
+isForAllTy_ty ty | Just ty' <- coreView ty = isForAllTy_ty ty'
+isForAllTy_ty (ForAllTy (Bndr tv _) _) | isTyVar tv = True
+isForAllTy_ty _             = False
+
+-- | Like `isForAllTy`, but returns True only if it is a covar binder
+isForAllTy_co :: Type -> Bool
+isForAllTy_co ty | Just ty' <- coreView ty = isForAllTy_co ty'
+isForAllTy_co (ForAllTy (Bndr tv _) _) | isCoVar tv = True
+isForAllTy_co _             = False
+
 -- | Is this a function or forall?
 isPiTy :: Type -> Bool
 isPiTy ty | Just ty' <- coreView ty = isForAllTy ty'
@@ -1386,7 +1466,7 @@ isPiTy (FunTy {})    = True
 isPiTy _             = False
 
 -- | Take a forall type apart, or panics if that is not possible.
-splitForAllTy :: Type -> (TyVar, Type)
+splitForAllTy :: Type -> (TyCoVar, Type)
 splitForAllTy ty
   | Just answer <- splitForAllTy_maybe ty = answer
   | otherwise                             = pprPanic "splitForAllTy" (ppr ty)
@@ -1401,16 +1481,32 @@ dropForAlls ty = go ty
 
 -- | Attempts to take a forall type apart, but only if it's a proper forall,
 -- with a named binder
-splitForAllTy_maybe :: Type -> Maybe (TyVar, Type)
+splitForAllTy_maybe :: Type -> Maybe (TyCoVar, Type)
 splitForAllTy_maybe ty = go ty
   where
     go ty | Just ty' <- coreView ty = go ty'
-    go (ForAllTy (TvBndr tv _) ty) = Just (tv, ty)
-    go _                           = Nothing
+    go (ForAllTy (Bndr tv _) ty)    = Just (tv, ty)
+    go _                            = Nothing
+
+-- | Like splitForAllTy_maybe, but only returns Just if it is a tyvar binder.
+splitForAllTy_ty_maybe :: Type -> Maybe (TyCoVar, Type)
+splitForAllTy_ty_maybe ty = go ty
+  where
+    go ty | Just ty' <- coreView ty = go ty'
+    go (ForAllTy (Bndr tv _) ty) | isTyVar tv = Just (tv, ty)
+    go _                            = Nothing
+
+-- | Like splitForAllTy_maybe, but only returns Just if it is a covar binder.
+splitForAllTy_co_maybe :: Type -> Maybe (TyCoVar, Type)
+splitForAllTy_co_maybe ty = go ty
+  where
+    go ty | Just ty' <- coreView ty = go ty'
+    go (ForAllTy (Bndr tv _) ty) | isCoVar tv = Just (tv, ty)
+    go _                            = Nothing
 
 -- | Attempts to take a forall type apart; works with proper foralls and
 -- functions
-splitPiTy_maybe :: Type -> Maybe (TyBinder, Type)
+splitPiTy_maybe :: Type -> Maybe (TyCoBinder, Type)
 splitPiTy_maybe ty = go ty
   where
     go ty | Just ty' <- coreView ty = go ty'
@@ -1419,14 +1515,14 @@ splitPiTy_maybe ty = go ty
     go _                  = Nothing
 
 -- | Takes a forall type apart, or panics
-splitPiTy :: Type -> (TyBinder, Type)
+splitPiTy :: Type -> (TyCoBinder, Type)
 splitPiTy ty
   | Just answer <- splitPiTy_maybe ty = answer
   | otherwise                         = pprPanic "splitPiTy" (ppr ty)
 
--- | Split off all TyBinders to a type, splitting both proper foralls
+-- | Split off all TyCoBinders to a type, splitting both proper foralls
 -- and functions
-splitPiTys :: Type -> ([TyBinder], Type)
+splitPiTys :: Type -> ([TyCoBinder], Type)
 splitPiTys ty = split ty ty
   where
     split orig_ty ty | Just ty' <- coreView ty = split orig_ty ty'
@@ -1438,11 +1534,11 @@ splitPiTys ty = split ty ty
 
 -- Like splitPiTys, but returns only *invisible* binders, including constraints
 -- Stops at the first visible binder
-splitPiTysInvisible :: Type -> ([TyBinder], Type)
+splitPiTysInvisible :: Type -> ([TyCoBinder], Type)
 splitPiTysInvisible ty = split ty ty []
    where
     split orig_ty ty bs | Just ty' <- coreView ty = split orig_ty ty' bs
-    split _       (ForAllTy b@(TvBndr _ vis) res) bs
+    split _       (ForAllTy b@(Bndr _ vis) res) bs
       | isInvisibleArgFlag vis         = split res res (Named b  : bs)
     split _       (FunTy arg res)  bs
       | isPredTy arg                   = split res res (Anon arg : bs)
@@ -1480,11 +1576,11 @@ partitionInvisibles :: TyCon -> (a -> Type) -> [a] -> ([a], [a])
 partitionInvisibles tc get_ty = go emptyTCvSubst (tyConKind tc)
   where
     go _ _ [] = ([], [])
-    go subst (ForAllTy (TvBndr tv vis) res_ki) (x:xs)
+    go subst (ForAllTy (Bndr tv vis) res_ki) (x:xs)
       | isVisibleArgFlag vis = second (x :) (go subst' res_ki xs)
       | otherwise            = first  (x :) (go subst' res_ki xs)
       where
-        subst' = extendTvSubst subst tv (get_ty x)
+        subst' = extendTCvSubst subst tv (get_ty x)
     go subst (TyVarTy tv) xs
       | Just ki <- lookupTyVar subst tv = go subst ki xs
     go _ _ xs = ([], xs)  -- something is ill-kinded. But this can happen
@@ -1505,43 +1601,49 @@ isTauTy (CoercionTy _)        = False  -- Not sure about this
 {-
 %************************************************************************
 %*                                                                      *
-   TyBinders
+   TyCoBinders
 %*                                                                      *
 %************************************************************************
 -}
 
 -- | Make an anonymous binder
-mkAnonBinder :: Type -> TyBinder
+mkAnonBinder :: Type -> TyCoBinder
 mkAnonBinder = Anon
 
 -- | Does this binder bind a variable that is /not/ erased? Returns
 -- 'True' for anonymous binders.
-isAnonTyBinder :: TyBinder -> Bool
-isAnonTyBinder (Named {}) = False
-isAnonTyBinder (Anon {})  = True
+isAnonTyCoBinder :: TyCoBinder -> Bool
+isAnonTyCoBinder (Named {}) = False
+isAnonTyCoBinder (Anon {})  = True
 
-isNamedTyBinder :: TyBinder -> Bool
-isNamedTyBinder (Named {}) = True
-isNamedTyBinder (Anon {})  = False
+isNamedTyCoBinder :: TyCoBinder -> Bool
+isNamedTyCoBinder (Named {}) = True
+isNamedTyCoBinder (Anon {})  = False
 
-tyBinderVar_maybe :: TyBinder -> Maybe TyVar
-tyBinderVar_maybe (Named tv) = Just $ binderVar tv
-tyBinderVar_maybe _          = Nothing
+tyCoBinderVar_maybe :: TyCoBinder -> Maybe TyCoVar
+tyCoBinderVar_maybe (Named tv) = Just $ binderVar tv
+tyCoBinderVar_maybe _          = Nothing
 
-tyBinderType :: TyBinder -> Type
+tyCoBinderType :: TyCoBinder -> Type
 -- Barely used
-tyBinderType (Named tvb) = binderKind tvb
+tyCoBinderType (Named tvb) = binderType tvb
+tyCoBinderType (Anon ty)   = ty
+
+tyBinderType :: TyBinder -> Type
+tyBinderType (Named (Bndr tv _))
+  = ASSERT( isTyVar tv )
+    tyVarKind tv
 tyBinderType (Anon ty)   = ty
 
 -- | Extract a relevant type, if there is one.
-binderRelevantType_maybe :: TyBinder -> Maybe Type
+binderRelevantType_maybe :: TyCoBinder -> Maybe Type
 binderRelevantType_maybe (Named {}) = Nothing
 binderRelevantType_maybe (Anon ty)  = Just ty
 
 -- | Like 'maybe', but for binders.
-caseBinder :: TyBinder           -- ^ binder to scrutinize
-           -> (TyVarBinder -> a) -- ^ named case
-           -> (Type -> a)        -- ^ anonymous case
+caseBinder :: TyCoBinder           -- ^ binder to scrutinize
+           -> (TyCoVarBinder -> a) -- ^ named case
+           -> (Type -> a)          -- ^ anonymous case
            -> a
 caseBinder (Named v) f _ = f v
 caseBinder (Anon t)  _ d = d t
@@ -1834,7 +1936,7 @@ data PredTree
   = ClassPred Class [Type]
   | EqPred EqRel Type Type
   | IrredPred PredType
-  | ForAllPred [TyVarBinder] [PredType] PredType
+  | ForAllPred [TyCoVarBinder] [PredType] PredType
      -- ForAllPred: see Note [Quantified constraints] in TcCanonical
   -- NB: There is no TuplePred case
   --     Tuple predicates like (Eq a, Ord b) are just treated
@@ -1851,7 +1953,7 @@ classifyPredType ev_ty = case splitTyConApp_maybe ev_ty of
       | Just clas <- tyConClass_maybe tc
       -> ClassPred clas tys
 
-    _ | (tvs, rho) <- splitForAllTyVarBndrs ev_ty
+    _ | (tvs, rho) <- splitForAllVarBndrs ev_ty
       , (theta, pred) <- splitFunTys rho
       , not (null tvs && null theta)
       -> ForAllPred tvs theta pred
@@ -1997,7 +2099,6 @@ pprSourceTyCon tycon
   | otherwise
   = ppr tycon
 
--- @isTauTy@ tests if a type has no foralls
 isFamFreeTy :: Type -> Bool
 isFamFreeTy ty | Just ty' <- coreView ty = isFamFreeTy ty'
 isFamFreeTy (TyVarTy _)       = True
@@ -2217,7 +2318,7 @@ seqType (TyVarTy tv)                = tv `seq` ()
 seqType (AppTy t1 t2)               = seqType t1 `seq` seqType t2
 seqType (FunTy t1 t2)               = seqType t1 `seq` seqType t2
 seqType (TyConApp tc tys)           = tc `seq` seqTypes tys
-seqType (ForAllTy (TvBndr tv _) ty) = seqType (tyVarKind tv) `seq` seqType ty
+seqType (ForAllTy (Bndr tv _) ty)   = seqType (varType tv) `seq` seqType ty
 seqType (CastTy ty co)              = seqType ty `seq` seqCo co
 seqType (CoercionTy co)             = seqCo co
 
@@ -2278,7 +2379,7 @@ eqVarBndrs :: RnEnv2 -> [Var] -> [Var] -> Maybe RnEnv2
 eqVarBndrs env [] []
  = Just env
 eqVarBndrs env (tv1:tvs1) (tv2:tvs2)
- | eqTypeX env (tyVarKind tv1) (tyVarKind tv2)
+ | eqTypeX env (varType tv1) (varType tv2)
  = eqVarBndrs (rnBndr2 env tv1 tv2) tvs1 tvs2
 eqVarBndrs _ _ _= Nothing
 
@@ -2358,8 +2459,8 @@ nonDetCmpTypeX env orig_t1 orig_t2 =
 
     go env (TyVarTy tv1)       (TyVarTy tv2)
       = liftOrdering $ rnOccL env tv1 `nonDetCmpVar` rnOccR env tv2
-    go env (ForAllTy (TvBndr tv1 _) t1) (ForAllTy (TvBndr tv2 _) t2)
-      = go env (tyVarKind tv1) (tyVarKind tv2)
+    go env (ForAllTy (Bndr tv1 _) t1) (ForAllTy (Bndr tv2 _) t2)
+      = go env (varType tv1) (varType tv2)
         `thenCmpTy` go (rnBndr2 env tv1 tv2) t1 t2
         -- See Note [Equality on AppTys]
     go env (AppTy s1 t1) ty2
@@ -2437,13 +2538,16 @@ typeKind (FunTy {})        = liftedTypeKind
 typeKind (TyVarTy tyvar)   = tyVarKind tyvar
 typeKind (CastTy _ty co)   = pSnd $ coercionKind co
 typeKind (CoercionTy co)   = coercionType co
-typeKind ty@(ForAllTy {})  = case occCheckExpand tvs k of
-                               Just k' -> k'
-                               Nothing -> pprPanic "typeKind"
-                                            (ppr ty $$ ppr k $$ ppr tvs $$ ppr body)
-                           where
-                             (tvs, body) = splitForAllTys ty
-                             k           = typeKind body
+typeKind ty@(ForAllTy (Bndr tv _) _)
+  | isTyVar tv                     -- See Note [Weird typing rule for ForAllTy].
+  = case occCheckExpand tvs k of   -- We must make sure tv does not occur in kind
+      Just k' -> k'                -- As it is already out of scope!
+      Nothing -> pprPanic "typeKind"
+                  (ppr ty $$ ppr k $$ ppr tvs $$ ppr body)
+  where
+    (tvs, body) = splitTyVarForAllTys ty
+    k           = typeKind body
+typeKind (ForAllTy {})     = liftedTypeKind
 
 typeKind_apps :: HasDebugCallStack => Type -> [Type] -> Kind
 -- The sole purpose of the function is to accumulate
@@ -2524,7 +2628,7 @@ occCheckExpand :: [Var] -> Type -> Maybe Type
 occCheckExpand vs_to_avoid ty
   = go (mkVarSet vs_to_avoid, emptyVarEnv) ty
   where
-    go :: (VarSet, VarEnv TyVar) -> Type -> Maybe Type
+    go :: (VarSet, VarEnv TyCoVar) -> Type -> Maybe Type
           -- The VarSet is the set of variables we are trying to avoid
           -- The VarEnv carries mappings necessary
           -- because of kind expansion
@@ -2541,13 +2645,13 @@ occCheckExpand vs_to_avoid ty
     go cxt (FunTy ty1 ty2) = do { ty1' <- go cxt ty1
                                 ; ty2' <- go cxt ty2
                                 ; return (mkFunTy ty1' ty2') }
-    go cxt@(as, env) (ForAllTy (TvBndr tv vis) body_ty)
-       = do { ki' <- go cxt (tyVarKind tv)
-            ; let tv' = setTyVarKind tv ki'
+    go cxt@(as, env) (ForAllTy (Bndr tv vis) body_ty)
+       = do { ki' <- go cxt (varType tv)
+            ; let tv' = setVarType tv ki'
                   env' = extendVarEnv env tv tv'
                   as'  = as `delVarSet` tv
             ; body' <- go (as', env') body_ty
-            ; return (ForAllTy (TvBndr tv' vis) body') }
+            ; return (ForAllTy (Bndr tv' vis) body') }
 
&n