Re-add FunTy (big patch)
authorSimon Peyton Jones <simonpj@microsoft.com>
Fri, 27 May 2016 14:26:46 +0000 (15:26 +0100)
committerSimon Peyton Jones <simonpj@microsoft.com>
Wed, 15 Jun 2016 13:41:49 +0000 (14:41 +0100)
With TypeInType Richard combined ForAllTy and FunTy, but that was often
awkward, and yielded little benefit becuase in practice the two were
always treated separately.  This patch re-introduces FunTy.  Specfically

* New type
    data TyVarBinder = TvBndr TyVar VisibilityFlag
  This /always/ has a TyVar it.  In many places that's just what
  what we want, so there are /lots/ of TyBinder -> TyVarBinder changes

* TyBinder still exists:
    data TyBinder = Named TyVarBinder | Anon Type

* data Type = ForAllTy TyVarBinder Type
            | FunTy Type Type
            |  ....

There are a LOT of knock-on changes, but they are all routine.

The Haddock submodule needs to be updated too

82 files changed:
compiler/basicTypes/DataCon.hs
compiler/basicTypes/DataCon.hs-boot
compiler/basicTypes/MkId.hs
compiler/basicTypes/PatSyn.hs
compiler/codeGen/StgCmmClosure.hs
compiler/coreSyn/CoreArity.hs
compiler/coreSyn/CoreFVs.hs
compiler/coreSyn/CoreLint.hs
compiler/coreSyn/CoreUtils.hs
compiler/coreSyn/TrieMap.hs
compiler/deSugar/DsBinds.hs
compiler/deSugar/DsForeign.hs
compiler/hsSyn/HsUtils.hs
compiler/iface/BuildTyCl.hs
compiler/iface/IfaceSyn.hs
compiler/iface/IfaceType.hs
compiler/iface/MkIface.hs
compiler/iface/TcIface.hs
compiler/main/HscTypes.hs
compiler/prelude/TysPrim.hs
compiler/prelude/TysWiredIn.hs
compiler/simplCore/SetLevels.hs
compiler/simplCore/Simplify.hs
compiler/specialise/SpecConstr.hs
compiler/specialise/Specialise.hs
compiler/typecheck/FamInst.hs
compiler/typecheck/Inst.hs
compiler/typecheck/TcArrows.hs
compiler/typecheck/TcBinds.hs
compiler/typecheck/TcCanonical.hs
compiler/typecheck/TcDeriv.hs
compiler/typecheck/TcErrors.hs
compiler/typecheck/TcExpr.hs
compiler/typecheck/TcFlatten.hs
compiler/typecheck/TcForeign.hs
compiler/typecheck/TcGenDeriv.hs
compiler/typecheck/TcHsSyn.hs
compiler/typecheck/TcHsType.hs
compiler/typecheck/TcInstDcls.hs
compiler/typecheck/TcInteract.hs
compiler/typecheck/TcMType.hs
compiler/typecheck/TcMatches.hs
compiler/typecheck/TcPatSyn.hs
compiler/typecheck/TcRnDriver.hs
compiler/typecheck/TcRnTypes.hs
compiler/typecheck/TcSMonad.hs
compiler/typecheck/TcSigs.hs
compiler/typecheck/TcSplice.hs
compiler/typecheck/TcTyClsDecls.hs
compiler/typecheck/TcTyDecls.hs
compiler/typecheck/TcType.hs
compiler/typecheck/TcUnify.hs
compiler/typecheck/TcValidity.hs
compiler/types/Coercion.hs
compiler/types/FamInstEnv.hs
compiler/types/Kind.hs
compiler/types/TyCoRep.hs
compiler/types/TyCoRep.hs-boot
compiler/types/TyCon.hs
compiler/types/Type.hs
compiler/types/Type.hs-boot
compiler/types/Unify.hs
compiler/vectorise/Vectorise/Convert.hs
compiler/vectorise/Vectorise/Generic/PData.hs
compiler/vectorise/Vectorise/Type/TyConDecl.hs
compiler/vectorise/Vectorise/Type/Type.hs
compiler/vectorise/Vectorise/Utils/PADict.hs
libraries/Win32
libraries/bytestring
libraries/hpc
libraries/time
libraries/vector
nofib
testsuite/tests/dependent/should_fail/T11334b.stderr
testsuite/tests/ghci/scripts/T7587.stdout
testsuite/tests/ghci/scripts/T7730.stdout
testsuite/tests/partial-sigs/should_compile/T10403.stderr
testsuite/tests/partial-sigs/should_compile/T11192.stderr
testsuite/tests/partial-sigs/should_fail/T10045.stderr
testsuite/tests/polykinds/T9017.stderr
testsuite/tests/typecheck/should_fail/VtaFail.stderr
utils/haddock

index 138e5d2..b5a2263 100644 (file)
@@ -30,8 +30,8 @@ module DataCon (
         dataConRepType, dataConSig, dataConInstSig, dataConFullSig,
         dataConName, dataConIdentity, dataConTag, dataConTyCon,
         dataConOrigTyCon, dataConUserType,
-        dataConUnivTyVars, dataConUnivTyBinders,
-        dataConExTyVars, dataConExTyBinders,
+        dataConUnivTyVars, dataConUnivTyVarBinders,
+        dataConExTyVars, dataConExTyVarBinders,
         dataConAllTyVars,
         dataConEqSpec, dataConTheta,
         dataConStupidTheta,
@@ -307,14 +307,10 @@ data DataCon
         -- Universally-quantified type vars [a,b,c]
         -- INVARIANT: length matches arity of the dcRepTyCon
         -- INVARIANT: result type of data con worker is exactly (T a b c)
-        dcUnivTyVars    :: [TyVar],     -- Two linked fields
-        dcUnivTyBinders :: [TyBinder],  -- see Note [TyBinders in DataCons]
-
+        dcUnivTyVars    :: [TyVarBinder],
 
         -- Existentially-quantified type vars [x,y]
-        dcExTyVars     :: [TyVar],     -- Two linked fields
-        dcExTyBinders  :: [TyBinder],  -- see Note [TyBinders in DataCons]
-
+        dcExTyVars     :: [TyVarBinder],
 
         -- INVARIANT: the UnivTyVars and ExTyVars all have distinct OccNames
         -- Reason: less confusing, and easier to generate IfaceSyn
@@ -416,38 +412,18 @@ data DataCon
   }
 
 
-{- Note [TyBinders in DataCons]
+{- Note [TyVarBinders in DataCons]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-DataCons and PatSyns store their universal and existential type
-variables in a pair of fields, e.g.
-        dcUnivTyVars    :: [TyVar],
-        dcUnivTyBinders :: [TyBinder],
-and similarly dcExTyVars/dcExTyVarBinders
-
-Of these, the former is always redundant:
-  dcUnivTyVars = [ tv | Named tv _ <- dcUnivTyBinders ]
-
-Specifically:
-
- * The two fields correspond 1-1
+For the TyVarBinders in a DataCon and PatSyn:
 
- * Each TyBinder a Named (no Anons)
-
- * The TyVar in each TyBinder is the same as the TyVar in
-   the corresponding tyvar in the TyVars list.
-
- * Each Visibilty flag (va, vb, etc) is Invisible or Specified.
+ * Each Visibilty flag is Invisible or Specified.
    None are Visible. (A DataCon is a term-level function; see
    Note [No Visible TyBinder in terms] in TyCoRep.)
 
-Why store these fields redundantly?  Purely convenience.  In most
-places in GHC, it's just the TyVars that are needed, so that's what's
-returned from, say, dataConFullSig.
-
-Why do we need the TyBinders?  So that we can construct the right
-type for the DataCon with its foralls attributed the correce visiblity.
-That in turn governs whether you can use visible type application
-at a call of the data constructor.
+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
+attributed the correce visiblity.  That in turn governs whether you
+can use visible type application at a call of the data constructor.
 -}
 
 data DataConRep
@@ -571,11 +547,11 @@ substEqSpec subst (EqSpec tv ty)
     tv' = getTyVar "substEqSpec" (substTyVar subst tv)
 
 -- | Filter out any TyBinders mentioned in an EqSpec
-filterEqSpec :: [EqSpec] -> [TyBinder] -> [TyBinder]
+filterEqSpec :: [EqSpec] -> [TyVarBinder] -> [TyVarBinder]
 filterEqSpec eq_spec
   = filter not_in_eq_spec
   where
-    not_in_eq_spec bndr = let var = binderVar "filterEqSpec" bndr in
+    not_in_eq_spec bndr = let var = binderVar bndr in
                           all (not . (== var) . eqSpecTyVar) eq_spec
 
 instance Outputable EqSpec where
@@ -761,8 +737,8 @@ mkDataCon :: Name
           -> [HsSrcBang]    -- ^ Strictness/unpack annotations, from user
           -> [FieldLabel]   -- ^ Field labels for the constructor,
                             -- if it is a record, otherwise empty
-          -> [TyVar] -> [TyBinder]  -- ^ Universals. See Note [TyBinders in DataCons]
-          -> [TyVar] -> [TyBinder]  -- ^ Existentials.
+          -> [TyVarBinder]  -- ^ Universals. See Note [TyVarBinders in DataCons]
+          -> [TyVarBinder]  -- ^ Existentials.
                             -- (These last two must be Named and Invisible/Specified)
           -> [EqSpec]       -- ^ GADT equalities
           -> ThetaType      -- ^ Theta-type occuring before the arguments proper
@@ -780,7 +756,7 @@ mkDataCon :: Name
 mkDataCon name declared_infix prom_info
           arg_stricts   -- Must match orig_arg_tys 1-1
           fields
-          univ_tvs univ_bndrs ex_tvs ex_bndrs
+          univ_tvs ex_tvs
           eq_spec theta
           orig_arg_tys orig_res_ty rep_info rep_tycon
           stupid_theta work_id rep
@@ -797,8 +773,8 @@ mkDataCon name declared_infix prom_info
     is_vanilla = null ex_tvs && null eq_spec && null theta
     con = MkData {dcName = name, dcUnique = nameUnique name,
                   dcVanilla = is_vanilla, dcInfix = declared_infix,
-                  dcUnivTyVars = univ_tvs, dcUnivTyBinders = univ_bndrs,
-                  dcExTyVars = ex_tvs, dcExTyBinders = ex_bndrs,
+                  dcUnivTyVars = univ_tvs,
+                  dcExTyVars = ex_tvs,
                   dcEqSpec = eq_spec,
                   dcOtherTheta = theta,
                   dcStupidTheta = stupid_theta,
@@ -819,18 +795,18 @@ mkDataCon name declared_infix prom_info
     tag = assoc "mkDataCon" (tyConDataCons rep_tycon `zip` [fIRST_TAG..]) con
     rep_arg_tys = dataConRepArgTys con
 
-    rep_ty = mkForAllTys univ_bndrs $ mkForAllTys ex_bndrs $
+    rep_ty = mkForAllTys univ_tvs $ mkForAllTys ex_tvs $
              mkFunTys rep_arg_tys $
-             mkTyConApp rep_tycon (mkTyVarTys univ_tvs)
+             mkTyConApp rep_tycon (mkTyVarTys (map binderVar univ_tvs))
 
       -- See Note [Promoted data constructors] in TyCon
-    prom_binders = filterEqSpec eq_spec univ_bndrs ++
-                   ex_bndrs ++
+    prom_binders = map mkNamedBinder (filterEqSpec eq_spec univ_tvs) ++
+                   map mkNamedBinder ex_tvs ++
                    map mkAnonBinder theta ++
                    map mkAnonBinder orig_arg_tys
     prom_res_kind = orig_res_ty
-    promoted
-      = mkPromotedDataCon con name prom_info prom_binders prom_res_kind roles rep_info
+    promoted      = mkPromotedDataCon con name prom_info prom_binders
+                                      prom_res_kind roles rep_info
 
     roles = map (const Nominal) (univ_tvs ++ ex_tvs) ++
             map (const Representational) orig_arg_tys
@@ -866,24 +842,24 @@ dataConIsInfix = dcInfix
 
 -- | The universally-quantified type variables of the constructor
 dataConUnivTyVars :: DataCon -> [TyVar]
-dataConUnivTyVars = dcUnivTyVars
+dataConUnivTyVars (MkData { dcUnivTyVars = tvbs }) = map binderVar tvbs
 
 -- | 'TyBinder's for the universally-quantified type variables
-dataConUnivTyBinders :: DataCon -> [TyBinder]
-dataConUnivTyBinders = dcUnivTyBinders
+dataConUnivTyVarBinders :: DataCon -> [TyVarBinder]
+dataConUnivTyVarBinders = dcUnivTyVars
 
 -- | The existentially-quantified type variables of the constructor
 dataConExTyVars :: DataCon -> [TyVar]
-dataConExTyVars = dcExTyVars
+dataConExTyVars (MkData { dcExTyVars = tvbs }) = map binderVar tvbs
 
 -- | 'TyBinder's for the existentially-quantified type variables
-dataConExTyBinders :: DataCon -> [TyBinder]
-dataConExTyBinders = dcExTyBinders
+dataConExTyVarBinders :: DataCon -> [TyVarBinder]
+dataConExTyVarBinders = dcExTyVars
 
 -- | Both the universal and existentiatial type variables of the constructor
 dataConAllTyVars :: DataCon -> [TyVar]
 dataConAllTyVars (MkData { dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs })
-  = univ_tvs ++ ex_tvs
+  = map binderVar (univ_tvs ++ ex_tvs)
 
 -- | Equalities derived from the result type of the data constructor, as written
 -- by the programmer in any GADT declaration. This includes *all* GADT-like
@@ -1020,9 +996,8 @@ dataConBoxer _ = Nothing
 --
 -- 4) The /original/ result type of the 'DataCon'
 dataConSig :: DataCon -> ([TyVar], ThetaType, [Type], Type)
-dataConSig con@(MkData {dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs,
-                        dcOrigArgTys = arg_tys, dcOrigResTy = res_ty})
-  = (univ_tvs ++ ex_tvs, dataConTheta con, arg_tys, res_ty)
+dataConSig con@(MkData {dcOrigArgTys = arg_tys, dcOrigResTy = res_ty})
+  = (dataConAllTyVars con, dataConTheta con, arg_tys, res_ty)
 
 dataConInstSig
   :: DataCon
@@ -1035,12 +1010,13 @@ dataConInstSig (MkData { dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs
                        , dcEqSpec = eq_spec, dcOtherTheta  = theta
                        , dcOrigArgTys = arg_tys })
                univ_tys
-  = (ex_tvs'
+  = ( ex_tvs'
     , substTheta subst (eqSpecPreds eq_spec ++ theta)
     , substTys   subst arg_tys)
   where
-    univ_subst = zipTvSubst univ_tvs univ_tys
-    (subst, ex_tvs') = mapAccumL Type.substTyVarBndr univ_subst ex_tvs
+    univ_subst = zipTvSubst (map binderVar univ_tvs) univ_tys
+    (subst, ex_tvs') = mapAccumL Type.substTyVarBndr univ_subst $
+                       map binderVar ex_tvs
 
 
 -- | The \"full signature\" of the 'DataCon' returns, in order:
@@ -1062,7 +1038,7 @@ dataConFullSig :: DataCon
 dataConFullSig (MkData {dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs,
                         dcEqSpec = eq_spec, dcOtherTheta = theta,
                         dcOrigArgTys = arg_tys, dcOrigResTy = res_ty})
-  = (univ_tvs, ex_tvs, eq_spec, theta, arg_tys, res_ty)
+  = (map binderVar univ_tvs, map binderVar ex_tvs, eq_spec, theta, arg_tys, res_ty)
 
 dataConOrigResTy :: DataCon -> Type
 dataConOrigResTy dc = dcOrigResTy dc
@@ -1085,12 +1061,12 @@ dataConUserType :: DataCon -> Type
 --
 -- NB: If the constructor is part of a data instance, the result type
 -- mentions the family tycon, not the internal one.
-dataConUserType (MkData { dcUnivTyBinders = univ_bndrs,
-                          dcExTyBinders = ex_bndrs, dcEqSpec = eq_spec,
+dataConUserType (MkData { dcUnivTyVars = univ_tvs,
+                          dcExTyVars = ex_tvs, dcEqSpec = eq_spec,
                           dcOtherTheta = theta, dcOrigArgTys = arg_tys,
                           dcOrigResTy = res_ty })
-  = mkForAllTys (filterEqSpec eq_spec univ_bndrs) $
-    mkForAllTys ex_bndrs $
+  = mkForAllTys (filterEqSpec eq_spec univ_tvs) $
+    mkForAllTys ex_tvs $
     mkFunTys theta $
     mkFunTys arg_tys $
     res_ty
@@ -1110,7 +1086,7 @@ dataConInstArgTys dc@(MkData {dcUnivTyVars = univ_tvs,
  = ASSERT2( length univ_tvs == length inst_tys
           , text "dataConInstArgTys" <+> ppr dc $$ ppr univ_tvs $$ ppr inst_tys)
    ASSERT2( null ex_tvs, ppr dc )
-   map (substTyWith univ_tvs inst_tys) (dataConRepArgTys dc)
+   map (substTyWith (map binderVar univ_tvs) inst_tys) (dataConRepArgTys dc)
 
 -- | Returns just the instantiated /value/ argument types of a 'DataCon',
 -- (excluding dictionary args)
@@ -1128,7 +1104,7 @@ dataConInstOrigArgTys dc@(MkData {dcOrigArgTys = arg_tys,
           , text "dataConInstOrigArgTys" <+> ppr dc $$ ppr tyvars $$ ppr inst_tys )
     map (substTyWith tyvars inst_tys) arg_tys
   where
-    tyvars = univ_tvs ++ ex_tvs
+    tyvars = map binderVar (univ_tvs ++ ex_tvs)
 
 -- | Returns the argument types of the wrapper, excluding all dictionary arguments
 -- and without substituting for any type variables
index d8e3230..6de1f27 100644 (file)
@@ -6,18 +6,18 @@ import FieldLabel ( FieldLabel )
 import Unique ( Uniquable )
 import Outputable ( Outputable, OutputableBndr )
 import BasicTypes (Arity)
-import {-# SOURCE #-} TyCoRep (Type, ThetaType, TyBinder)
+import {-# SOURCE #-} TyCoRep (Type, ThetaType, TyVarBinder)
 
 data DataCon
 data DataConRep
 data EqSpec
-filterEqSpec :: [EqSpec] -> [TyBinder] -> [TyBinder]
+filterEqSpec :: [EqSpec] -> [TyVarBinder] -> [TyVarBinder]
 
 dataConName      :: DataCon -> Name
 dataConTyCon     :: DataCon -> TyCon
-dataConUnivTyBinders :: DataCon -> [TyBinder]
+dataConUnivTyVarBinders :: DataCon -> [TyVarBinder]
 dataConExTyVars  :: DataCon -> [TyVar]
-dataConExTyBinders :: DataCon -> [TyBinder]
+dataConExTyVarBinders :: DataCon -> [TyVarBinder]
 dataConSourceArity  :: DataCon -> Arity
 dataConFieldLabels :: DataCon -> [FieldLabel]
 dataConInstOrigArgTys  :: DataCon -> [Type] -> [Type]
index fe301d5..1ac5597 100644 (file)
@@ -274,13 +274,13 @@ mkDictSelId name clas
     sel_names      = map idName (classAllSelIds clas)
     new_tycon      = isNewTyCon tycon
     [data_con]     = tyConDataCons tycon
-    binders        = dataConUnivTyBinders data_con
-    tyvars         = dataConUnivTyVars data_con
+    tyvars         = dataConUnivTyVarBinders data_con
+    n_ty_args      = length tyvars
     arg_tys        = dataConRepArgTys data_con  -- Includes the dictionary superclasses
     val_index      = assoc "MkId.mkDictSelId" (sel_names `zip` [0..]) name
 
-    sel_ty = mkForAllTys binders $
-             mkFunTy (mkClassPred clas (mkTyVarTys tyvars)) $
+    sel_ty = mkForAllTys tyvars $
+             mkFunTy (mkClassPred clas (mkTyVarTys (map binderVar tyvars))) $
              getNth arg_tys val_index
 
     base_info = noCafIdInfo
@@ -299,8 +299,6 @@ mkDictSelId name clas
                    -- so that the rule is always available to fire.
                    -- See Note [ClassOp/DFun selection] in TcInstDcls
 
-    n_ty_args = length tyvars
-
     -- This is the built-in rule that goes
     --      op (dfT d1 d2) --->  opT d1 d2
     rule = BuiltinRule { ru_name = fsLit "Class op " `appendFS`
@@ -971,10 +969,9 @@ mkFCallId dflags uniq fcall ty
            `setArityInfo`         arity
            `setStrictnessInfo`    strict_sig
 
-    (bndrs, _)        = tcSplitPiTys ty
-    arity             = count isIdLikeBinder bndrs
-
-    strict_sig      = mkClosedStrictSig (replicate arity topDmd) topRes
+    (bndrs, _) = tcSplitPiTys ty
+    arity      = count isAnonTyBinder 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
     -- necessarily force them. See Trac #11076.
index 3c5e709..2510d71 100644 (file)
@@ -15,7 +15,7 @@ module PatSyn (
         patSynName, patSynArity, patSynIsInfix,
         patSynArgs,
         patSynMatcher, patSynBuilder,
-        patSynUnivTyBinders, patSynExTyVars, patSynExTyBinders, patSynSig,
+        patSynUnivTyVarBinders, patSynExTyVars, patSynExTyVarBinders, patSynSig,
         patSynInstArgTys, patSynInstResTy, patSynFieldLabels,
         patSynFieldType,
 
@@ -63,15 +63,13 @@ data PatSyn
                                        -- psArgs
 
         -- Universially-quantified type variables
-        psUnivTyVars    :: [TyVar],    -- Two linked fields; see DataCon
-        psUnivTyBinders :: [TyBinder], -- Note [TyBinders in DataCons]
+        psUnivTyVars  :: [TyVarBinder],
 
         -- Required dictionaries (may mention psUnivTyVars)
         psReqTheta    :: ThetaType,
 
         -- Existentially-quantified type vars
-        psExTyVars    :: [TyVar],      -- Two linked fields; see DataCon
-        psExTyBinders :: [TyBinder],   -- Note [TyBinders in DataCons]
+        psExTyVars    :: [TyVarBinder],
 
         -- Provided dictionaries (may mention psUnivTyVars or psExTyVars)
         psProvTheta   :: ThetaType,
@@ -300,11 +298,9 @@ instance Data.Data PatSyn where
 -- | Build a new pattern synonym
 mkPatSyn :: Name
          -> Bool                 -- ^ Is the pattern synonym declared infix?
-         -> ([TyVar], [TyBinder], ThetaType)
-                                 -- ^ Universially-quantified type variables
+         -> ([TyVarBinder], ThetaType) -- ^ Universially-quantified type variables
                                  --   and required dicts
-         -> ([TyVar], [TyBinder], ThetaType)
-                                 -- ^ Existentially-quantified type variables
+         -> ([TyVarBinder], ThetaType) -- ^ Existentially-quantified type variables
                                  --   and provided dicts
          -> [Type]               -- ^ Original arguments
          -> Type                 -- ^ Original result type
@@ -316,14 +312,14 @@ mkPatSyn :: Name
  -- NB: The univ and ex vars are both in TyBinder form and TyVar form for
  -- convenience. All the TyBinders should be Named!
 mkPatSyn name declared_infix
-         (univ_tvs, univ_bndrs, req_theta)
-         (ex_tvs, ex_bndrs, prov_theta)
+         (univ_tvs, req_theta)
+         (ex_tvs, prov_theta)
          orig_args
          orig_res_ty
          matcher builder field_labels
     = MkPatSyn {psName = name, psUnique = getUnique name,
-                psUnivTyVars = univ_tvs, psUnivTyBinders = univ_bndrs,
-                psExTyVars = ex_tvs, psExTyBinders = ex_bndrs,
+                psUnivTyVars = univ_tvs,
+                psExTyVars = ex_tvs,
                 psProvTheta = prov_theta, psReqTheta = req_theta,
                 psInfix = declared_infix,
                 psArgs = orig_args,
@@ -359,20 +355,20 @@ patSynFieldType ps label
       Just (_, ty) -> ty
       Nothing -> pprPanic "dataConFieldType" (ppr ps <+> ppr label)
 
-patSynUnivTyBinders :: PatSyn -> [TyBinder]
-patSynUnivTyBinders = psUnivTyBinders
+patSynUnivTyVarBinders :: PatSyn -> [TyVarBinder]
+patSynUnivTyVarBinders = psUnivTyVars
 
 patSynExTyVars :: PatSyn -> [TyVar]
-patSynExTyVars = psExTyVars
+patSynExTyVars ps = map binderVar (psExTyVars ps)
 
-patSynExTyBinders :: PatSyn -> [TyBinder]
-patSynExTyBinders = psExTyBinders
+patSynExTyVarBinders :: PatSyn -> [TyVarBinder]
+patSynExTyVarBinders = psExTyVars
 
 patSynSig :: PatSyn -> ([TyVar], ThetaType, [TyVar], ThetaType, [Type], Type)
 patSynSig (MkPatSyn { psUnivTyVars = univ_tvs, psExTyVars = ex_tvs
                     , psProvTheta = prov, psReqTheta = req
                     , psArgs = arg_tys, psOrigResTy = res_ty })
-  = (univ_tvs, req, ex_tvs, prov, arg_tys, res_ty)
+  = (map binderVar univ_tvs, req, map binderVar ex_tvs, prov, arg_tys, res_ty)
 
 patSynMatcher :: PatSyn -> (Id,Bool)
 patSynMatcher = psMatcher
@@ -401,7 +397,7 @@ patSynInstArgTys (MkPatSyn { psName = name, psUnivTyVars = univ_tvs
           , text "patSynInstArgTys" <+> ppr name $$ ppr tyvars $$ ppr inst_tys )
     map (substTyWith tyvars inst_tys) arg_tys
   where
-    tyvars = univ_tvs ++ ex_tvs
+    tyvars = map binderVar (univ_tvs ++ ex_tvs)
 
 patSynInstResTy :: PatSyn -> [Type] -> Type
 -- Return the type of whole pattern
@@ -414,19 +410,19 @@ patSynInstResTy (MkPatSyn { psName = name, psUnivTyVars = univ_tvs
                 inst_tys
   = ASSERT2( length univ_tvs == length inst_tys
            , text "patSynInstResTy" <+> ppr name $$ ppr univ_tvs $$ ppr inst_tys )
-    substTyWith univ_tvs inst_tys res_ty
+    substTyWith (map binderVar univ_tvs) inst_tys res_ty
 
 -- | Print the type of a pattern synonym. The foralls are printed explicitly
 pprPatSynType :: PatSyn -> SDoc
 pprPatSynType (MkPatSyn { psUnivTyVars = univ_tvs,  psReqTheta  = req_theta
                         , psExTyVars   = ex_tvs,    psProvTheta = prov_theta
                         , psArgs       = orig_args, psOrigResTy = orig_res_ty })
-  = sep [ pprForAllImplicit univ_tvs
+  = sep [ pprForAll univ_tvs
         , pprThetaArrowTy req_theta
         , ppWhen insert_empty_ctxt $ parens empty <+> darrow
         , pprType sigma_ty ]
   where
-    sigma_ty = mkForAllTys (mkNamedBinders Specified ex_tvs) $
+    sigma_ty = mkForAllTys ex_tvs  $
                mkFunTys prov_theta $
                mkFunTys orig_args orig_res_ty
     insert_empty_ctxt = null req_theta && not (null prov_theta && null ex_tvs)
index ca6b404..c612366 100644 (file)
@@ -970,15 +970,15 @@ getTyDescription ty
       TyVarTy _              -> "*"
       AppTy fun _            -> getTyDescription fun
       TyConApp tycon _       -> getOccString tycon
-      ForAllTy (Anon _) res  -> '-' : '>' : fun_result res
-      ForAllTy (Named {}) ty -> getTyDescription ty
+      FunTy _ res            -> '-' : '>' : fun_result res
+      ForAllTy _  ty         -> getTyDescription ty
       LitTy n                -> getTyLitDescription n
       CastTy ty _            -> getTyDescription ty
       CoercionTy co          -> pprPanic "getTyDescription" (ppr co)
     }
   where
-    fun_result (ForAllTy (Anon _) res) = '>' : fun_result res
-    fun_result other                   = getTyDescription other
+    fun_result (FunTy _ res) = '>' : fun_result res
+    fun_result other         = getTyDescription other
 
 getTyLitDescription :: TyLit -> String
 getTyLitDescription l =
index 812f12c..ef87656 100644 (file)
@@ -106,10 +106,11 @@ typeArity ty
   = go initRecTc ty
   where
     go rec_nts ty
-      | Just (bndr, ty')  <- splitPiTy_maybe ty
-      = if isIdLikeBinder bndr
-        then typeOneShot (binderType bndr) : go rec_nts ty'
-        else go rec_nts ty'
+      | Just (_, ty')  <- splitForAllTy_maybe ty
+      = go rec_nts ty'
+
+      | Just (arg,res) <- splitFunTy_maybe ty
+      = typeOneShot arg : go rec_nts res
 
       | Just (tc,tys) <- splitTyConApp_maybe ty
       , Just (ty', _) <- instNewTyCon_maybe tc tys
@@ -970,13 +971,15 @@ mkEtaWW orig_n orig_expr in_scope orig_ty
        | n == 0
        = (getTCvInScope subst, reverse eis)
 
-       | Just (bndr,ty') <- splitPiTy_maybe ty
-       = let ((subst', eta_id'), new_n) = caseBinder bndr
-               (\tv -> (Type.substTyVarBndr subst tv, n))
-               (\arg_ty -> (freshEtaVar n subst arg_ty, n-1))
-         in
-            -- Avoid free vars of the original expression
-         go new_n subst' ty' (EtaVar eta_id' : eis)
+       | Just (tv,ty') <- splitForAllTy_maybe ty
+       , let (subst', tv') = Type.substTyVarBndr subst tv
+           -- Avoid free vars of the original expression
+       = go n subst' ty' (EtaVar tv' : eis)
+
+       | Just (arg_ty, res_ty) <- splitFunTy_maybe ty
+       , let (subst', eta_id') = freshEtaId n subst arg_ty
+           -- Avoid free vars of the original expression
+       = go (n-1) subst' res_ty (EtaVar eta_id' : eis)
 
        | Just (co, ty') <- topNormaliseNewType_maybe ty
        =        -- Given this:
@@ -1009,7 +1012,7 @@ subst_bind = substBindSC
 
 
 --------------
-freshEtaVar :: Int -> TCvSubst -> Type -> (TCvSubst, Var)
+freshEtaId :: Int -> TCvSubst -> Type -> (TCvSubst, Id)
 -- Make a fresh Id, with specified type (after applying substitution)
 -- It should be "fresh" in the sense that it's not in the in-scope set
 -- of the TvSubstEnv; and it should itself then be added to the in-scope
@@ -1017,7 +1020,7 @@ freshEtaVar :: Int -> TCvSubst -> Type -> (TCvSubst, Var)
 --
 -- The Int is just a reasonable starting point for generating a unique;
 -- it does not necessarily have to be unique itself.
-freshEtaVar n subst ty
+freshEtaId n subst ty
       = (subst', eta_id')
       where
         ty'     = Type.substTy subst ty
index a71569e..09ef7f8 100644 (file)
@@ -352,8 +352,10 @@ orphNamesOfType (TyVarTy _)          = emptyNameSet
 orphNamesOfType (LitTy {})           = emptyNameSet
 orphNamesOfType (TyConApp tycon tys) = orphNamesOfTyCon tycon
                                        `unionNameSet` orphNamesOfTypes tys
-orphNamesOfType (ForAllTy bndr res)  = unitNameSet funTyConName    -- NB!  See Trac #8535
-                                       `unionNameSet` orphNamesOfType (binderType bndr)
+orphNamesOfType (ForAllTy bndr res)  = orphNamesOfType (binderType bndr)
+                                       `unionNameSet` orphNamesOfType res
+orphNamesOfType (FunTy arg res)      = unitNameSet funTyConName    -- NB!  See Trac #8535
+                                       `unionNameSet` orphNamesOfType arg
                                        `unionNameSet` orphNamesOfType res
 orphNamesOfType (AppTy fun arg)      = orphNamesOfType fun `unionNameSet` orphNamesOfType arg
 orphNamesOfType (CastTy ty co)       = orphNamesOfType ty `unionNameSet` orphNamesOfCo co
index 9c5b033..36a7e2b 100644 (file)
@@ -558,9 +558,10 @@ lintRhs rhs
     , length args == 5
     = flip fix binders0 $ \loopBinders binders -> case binders of
         -- imitate @lintCoreExpr (Lam ...)@
-        var : vars -> addLoc (LambdaBodyOf var) $ lintBinder var $ \var' -> do
-          body_ty <- loopBinders vars
-          return $ mkPiType var' body_ty
+        var : vars -> addLoc (LambdaBodyOf var) $
+                      lintBinder var $ \var' ->
+                      do { body_ty <- loopBinders vars
+                         ; return $ mkLamType var' body_ty }
         -- imitate @lintCoreExpr (App ...)@
         [] -> do
           fun_ty <- lintCoreExpr fun
@@ -703,7 +704,7 @@ lintCoreExpr (Lam var expr)
   = addLoc (LambdaBodyOf var) $
     lintBinder var $ \ var' ->
     do { body_ty <- lintCoreExpr expr
-       ; return $ mkPiType var' body_ty }
+       ; return $ mkLamType var' body_ty }
 
 lintCoreExpr e@(Case scrut var alt_ty alts) =
        -- Check the scrutinee
@@ -1097,12 +1098,12 @@ lintType ty@(TyConApp tc tys)
 
 -- arrows can related *unlifted* kinds, so this has to be separate from
 -- a dependent forall.
-lintType ty@(ForAllTy (Anon t1) t2)
+lintType ty@(FunTy t1 t2)
   = do { k1 <- lintType t1
        ; k2 <- lintType t2
        ; lintArrow (text "type or kind" <+> quotes (ppr ty)) k1 k2 }
 
-lintType t@(ForAllTy (Named tv _vis) ty)
+lintType t@(ForAllTy (TvBndr tv _vis) ty)
   = do { lintL (isTyVar tv) (text "Covar bound in type:" <+> ppr t)
        ; lintTyBndr tv $ \tv' ->
           do { k <- lintType ty
@@ -1192,11 +1193,11 @@ lint_app doc kfn kas
       | Just kfn' <- coreView kfn
       = go_app in_scope kfn' ka
 
-    go_app _ (ForAllTy (Anon kfa) kfb) (_,ka)
+    go_app _ (FunTy kfa kfb) (_,ka)
       = do { unless (ka `eqType` kfa) (addErrL fail_msg)
            ; return kfb }
 
-    go_app in_scope (ForAllTy (Named kv _vis) kfn) (ta,ka)
+    go_app in_scope (ForAllTy (TvBndr kv _vis) kfn) (ta,ka)
       = do { unless (ka `eqType` tyVarKind kv) (addErrL fail_msg)
            ; return (substTyWithInScope in_scope [kv] [ta] kfn) }
 
@@ -1346,7 +1347,7 @@ lintCoercion (ForAllCo tv1 kind_co co)
     do {
        ; (k3, k4, t1, t2, r) <- lintCoercion co
        ; in_scope <- getInScope
-       ; let tyl = mkNamedForAllTy tv1 Invisible t1
+       ; let tyl = mkInvForAllTy tv1 t1
              subst = mkTvSubst in_scope $
                      -- We need both the free vars of the `t2` and the
                      -- free vars of the range of the substitution in
@@ -1355,7 +1356,7 @@ lintCoercion (ForAllCo tv1 kind_co co)
                      -- linted and `tv2` has the same unique as `tv1`.
                      -- See Note [The substitution invariant]
                      unitVarEnv tv1 (TyVarTy tv2 `mkCastTy` mkSymCo kind_co)
-             tyr = mkNamedForAllTy tv2 Invisible $
+             tyr = mkInvForAllTy tv2 $
                    substTy subst t2
        ; return (k3, k4, tyl, tyr, r) } }
 
index 46232b3..7e0dc11 100644 (file)
@@ -103,7 +103,7 @@ exprType (Let bind body)
 exprType (Case _ _ ty _)     = ty
 exprType (Cast _ co)         = pSnd (coercionKind co)
 exprType (Tick _ e)          = exprType e
-exprType (Lam binder expr)   = mkPiType binder (exprType expr)
+exprType (Lam binder expr)   = mkLamType binder (exprType expr)
 exprType e@(App _ _)
   = case collectArgs e of
         (fun, args) -> applyTypeToArgs e (exprType fun) args
index fbff260..a37758c 100644 (file)
@@ -793,7 +793,7 @@ data TypeMapX a
 trieMapView :: Type -> Maybe Type
 trieMapView ty | Just ty' <- coreViewOneStarKind ty = Just ty'
 trieMapView (TyConApp tc tys@(_:_)) = Just $ foldl AppTy (TyConApp tc []) tys
-trieMapView (ForAllTy (Anon arg) res)
+trieMapView (FunTy arg res)
   = Just ((TyConApp funTyCon [] `AppTy` arg) `AppTy` res)
 trieMapView _ = Nothing
 
@@ -824,13 +824,13 @@ instance Eq (DeBruijn Type) where
             -> D env t1 == D env' t1' && D env t2 == D env' t2'
         (s, AppTy t1' t2') | Just (t1, t2) <- repSplitAppTy_maybe s
             -> D env t1 == D env' t1' && D env t2 == D env' t2'
-        (ForAllTy (Anon t1) t2, ForAllTy (Anon t1') t2')
+        (FunTy t1 t2, FunTy t1' t2')
             -> D env t1 == D env' t1' && D env t2 == D env' t2'
         (TyConApp tc tys, TyConApp tc' tys')
             -> tc == tc' && D env tys == D env' tys'
         (LitTy l, LitTy l')
             -> l == l'
-        (ForAllTy (Named tv _) ty, ForAllTy (Named tv' _) ty')
+        (ForAllTy (TvBndr tv _) ty, ForAllTy (TvBndr tv' _) ty')
             -> D env (tyVarKind tv)    == D env' (tyVarKind tv') &&
                D (extendCME env tv) ty == D (extendCME env' tv') ty'
         (CoercionTy {}, CoercionTy {})
@@ -870,9 +870,9 @@ 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 (Named tv _) ty)  = tm_forall >.> lkG (D (extendCME env tv) ty)
+    go (ForAllTy (TvBndr tv _) ty) = tm_forall >.> lkG (D (extendCME env tv) ty)
                                                >=> lkBndr env tv
-    go ty@(ForAllTy (Anon _) _)    = pprPanic "lkT FunTy" (ppr ty)
+    go ty@(FunTy {})               = pprPanic "lkT FunTy" (ppr ty)
     go (CastTy t _)                = go t
     go (CoercionTy {})             = tm_coerce
 
@@ -887,11 +887,11 @@ 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 (Named tv _) ty))  f m
+xtT (D env (ForAllTy (TvBndr 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)
-xtT (D _   ty@(ForAllTy (Anon _) _)) _ _ = pprPanic "xtT FunTy" (ppr ty)
+xtT (D _   ty@(TyConApp _ (_:_))) _ _ = pprPanic "xtT TyConApp" (ppr ty)
+xtT (D _   ty@(FunTy {}))         _ _ = pprPanic "xtT FunTy" (ppr ty)
 
 fdT :: (a -> b -> b) -> TypeMapX a -> b -> b
 fdT k m = foldTM k (tm_var m)
index c27168a..30e1707 100644 (file)
@@ -624,7 +624,7 @@ dsSpec mb_poly_rhs (L loc (SpecPrag poly_id spec_co spec_inl))
              spec_name = mkInternalName uniq spec_occ (getSrcSpan poly_name)
        ; (bndrs, ds_lhs) <- liftM collectBinders
                                   (dsHsWrapper spec_co (Var poly_id))
-       ; let spec_ty = mkPiTypes bndrs (exprType ds_lhs)
+       ; let spec_ty = mkLamTypes bndrs (exprType ds_lhs)
        ; -- pprTrace "dsRule" (vcat [ text "Id:" <+> ppr poly_id
          --                         , text "spec_co:" <+> ppr spec_co
          --                         , text "ds_rhs:" <+> ppr ds_lhs ]) $
index 26c84c7..00ed621 100644 (file)
@@ -195,15 +195,9 @@ dsFCall :: Id -> Coercion -> ForeignCall -> Maybe Header
         -> DsM ([(Id, Expr TyVar)], SDoc, SDoc)
 dsFCall fn_id co fcall mDeclHeader = do
     let
-        ty                     = pFst $ coercionKind co
-        (all_bndrs, io_res_ty) = tcSplitPiTys ty
-        (named_bndrs, arg_tys) = partitionBindersIntoBinders all_bndrs
-        tvs                    = ASSERT( fst (span isNamedBinder all_bndrs)
-                                         `equalLength` named_bndrs )
-                                   -- ensure that the named binders all come first
-                                 map (binderVar "dsFCall") named_bndrs
-                -- Must use tcSplit* functions because we want to
-                -- see that (IO t) in the corner
+        ty                   = pFst $ coercionKind co
+        (tv_bndrs, rho)      = tcSplitForAllTyVarBndrs ty
+        (arg_tys, io_res_ty) = tcSplitFunTys rho
 
     args <- newSysLocalsDs arg_tys
     (val_args, arg_wrappers) <- mapAndUnzipM unboxArg (map Var args)
@@ -266,7 +260,8 @@ dsFCall fn_id co fcall mDeclHeader = do
                   return (fcall, empty)
     let
         -- Build the worker
-        worker_ty     = mkForAllTys named_bndrs (mkFunTys (map idType work_arg_ids) ccall_result_ty)
+        worker_ty     = mkForAllTys tv_bndrs (mkFunTys (map idType work_arg_ids) ccall_result_ty)
+        tvs           = map binderVar tv_bndrs
         the_ccall_app = mkFCall dflags ccall_uniq fcall' val_args ccall_result_ty
         work_rhs      = mkLams tvs (mkLams work_arg_ids the_ccall_app)
         work_id       = mkSysLocal (fsLit "$wccall") work_uniq worker_ty
@@ -300,12 +295,9 @@ dsPrimCall :: Id -> Coercion -> ForeignCall
 dsPrimCall fn_id co fcall = do
     let
         ty                   = pFst $ coercionKind co
-        (bndrs, io_res_ty)   = tcSplitPiTys ty
-        (tvs, arg_tys)       = partitionBinders bndrs
-                -- Must use tcSplit* functions because we want to
-                -- see that (IO t) in the corner
+        (tvs, fun_ty)        = tcSplitForAllTys ty
+        (arg_tys, io_res_ty) = tcSplitFunTys fun_ty
 
-    MASSERT( fst (span isNamedBinder bndrs) `equalLength` tvs )
     args <- newSysLocalsDs arg_tys
 
     ccall_uniq <- newUnique
@@ -416,8 +408,6 @@ dsFExportDynamic :: Id
                  -> CCallConv
                  -> DsM ([Binding], SDoc, SDoc)
 dsFExportDynamic id co0 cconv = do
-    MASSERT( fst (span isNamedBinder bndrs) `equalLength` tvs )
-      -- make sure that the named binders all come first
     fe_id <-  newSysLocalDs ty
     mod <- getModule
     dflags <- getDynFlags
@@ -481,8 +471,8 @@ dsFExportDynamic id co0 cconv = do
 
  where
   ty                       = pFst (coercionKind co0)
-  (bndrs, fn_res_ty)       = tcSplitPiTys ty
-  (tvs, [arg_ty])          = partitionBinders bndrs
+  (tvs,sans_foralls)       = tcSplitForAllTys ty
+  ([arg_ty], fn_res_ty)    = tcSplitFunTys sans_foralls
   Just (io_tc, res_ty)     = tcSplitIOType_maybe fn_res_ty
         -- Must have an IO type; hence Just
 
index 23c8d91..f530272 100644 (file)
@@ -586,12 +586,12 @@ toLHsSigWcType ty
   = mkLHsSigWcType (go ty)
   where
     go :: Type -> LHsType RdrName
-    go ty@(ForAllTy (Anon arg) _)
+    go ty@(FunTy arg _)
       | isPredTy arg
       , (theta, tau) <- tcSplitPhiTy ty
       = noLoc (HsQualTy { hst_ctxt = noLoc (map go theta)
                         , hst_body = go tau })
-    go (ForAllTy (Anon arg) res) = nlHsFunTy (go arg) (go res)
+    go (FunTy arg res) = nlHsFunTy (go arg) (go res)
     go ty@(ForAllTy {})
       | (tvs, tau) <- tcSplitForAllTys ty
       = noLoc (HsForAllTy { hst_bndrs = map go_tv tvs
index f62e5ee..c20a5ee 100644 (file)
@@ -29,7 +29,7 @@ import MkId
 import Class
 import TyCon
 import Type
-import TyCoRep( TyBinder(..) )
+import TyCoRep( TyBinder(..), TyVarBinder(..) )
 import Id
 import TcType
 
@@ -112,9 +112,8 @@ buildDataCon :: FamInstEnvs
             -> Maybe [HsImplBang]
                 -- See Note [Bangs on imported data constructors] in MkId
            -> [FieldLabel]             -- Field labels
-           -> [TyVar] -> [TyBinder]    -- Universals; see
-                                       -- Note [TyBinders in DataCons] in DataCon
-           -> [TyVar] -> [TyBinder]    -- existentials
+           -> [TyVar] -> [TyBinder]    -- Universals
+           -> [TyVarBinder]            -- existentials
            -> [EqSpec]                 -- Equality spec
            -> ThetaType                -- Does not include the "stupid theta"
                                        -- or the GADT equalities
@@ -125,9 +124,9 @@ buildDataCon :: FamInstEnvs
 --   a) makes the worker Id
 --   b) makes the wrapper Id if necessary, including
 --      allocating its unique (hence monadic)
---   c) Sorts out the TyBinders. See Note [TyBinders in DataCons] in DataCon
+--   c) Sorts out the TyVarBinders. See mkDataConUnivTyBinders
 buildDataCon fam_envs src_name declared_infix prom_info src_bangs impl_bangs field_lbls
-             univ_tvs univ_bndrs ex_tvs ex_bndrs eq_spec ctxt arg_tys res_ty rep_tycon
+             univ_tvs univ_bndrs ex_tvs eq_spec ctxt arg_tys res_ty rep_tycon
   = do  { wrap_name <- newImplicitBinder src_name mkDataConWrapperOcc
         ; work_name <- newImplicitBinder src_name mkDataConWorkerOcc
         -- This last one takes the name of the data constructor in the source
@@ -137,11 +136,11 @@ buildDataCon fam_envs src_name declared_infix prom_info src_bangs impl_bangs fie
         ; traceIf (text "buildDataCon 1" <+> ppr src_name)
         ; us <- newUniqueSupply
         ; dflags <- getDynFlags
-        ; let dc_bndrs    = mkDataConUnivTyBinders univ_bndrs univ_tvs
+        ; let dc_bndrs    = mkDataConUnivTyVarBinders univ_tvs univ_bndrs
               stupid_ctxt = mkDataConStupidTheta rep_tycon arg_tys univ_tvs
               data_con = mkDataCon src_name declared_infix prom_info
                                    src_bangs field_lbls
-                                   univ_tvs dc_bndrs ex_tvs ex_bndrs eq_spec ctxt
+                                   dc_bndrs ex_tvs eq_spec ctxt
                                    arg_tys res_ty NoRRI rep_tycon
                                    stupid_ctxt dc_wrk dc_rep
               dc_wrk = mkDataConWorkId work_name data_con
@@ -171,25 +170,25 @@ mkDataConStupidTheta tycon arg_tys univ_tvs
                       tyCoVarsOfType pred `intersectVarSet` arg_tyvars
 
 
-mkDataConUnivTyBinders :: [TyBinder] -> [TyVar]   -- From the TyCon
-                       -> [TyBinder]              -- For the DataCon
+mkDataConUnivTyVarBinders :: [TyVar] -> [TyBinder]   -- From the TyCon
+                          -> [TyVarBinder]           -- For the DataCon
 -- See Note [Building the TyBinders for a DataCon]
-mkDataConUnivTyBinders bndrs tvs
- = zipWith mk_binder bndrs tvs
+mkDataConUnivTyVarBinders tvs bndrs
+ = zipWith mk_binder tvs bndrs
  where
-   mk_binder bndr tv = mkNamedBinder vis tv
+   mk_binder tv bndr = mkTyVarBinder vis tv
       where
         vis = case bndr of
-                Anon _          -> Specified
-                Named _ Visible -> Specified
-                Named _ vis     -> vis
+                Anon _                   -> Specified
+                Named (TvBndr _ Visible) -> Specified
+                Named (TvBndr _ vis)     -> vis
 
 {- Note [Building the TyBinders for a DataCon]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 A DataCon needs to keep track of the visibility of its universals and
 existentials, so that visible type application can work properly. This
-is done by storing the universal and existential TyBinders, along with
-the TyVars.  See Note [TyBinders in DataCons] in DataCon.
+is done by storing the universal and existential TyVarBinders.
+See Note [TyVarBinders in DataCons] in DataCon.
 
 During construction of a DataCon, we often start from the TyBinders of
 the parent TyCon.  For example
@@ -203,8 +202,8 @@ of the DataCon. Here is an example:
 
 The TyCon has
 
-  tyConTyVars    = [ k:*,                      a:k->*,      b:k]
-  tyConTyBinders = [ Named (k :: *) Invisible, Anon (k->*), Anon k ]
+  tyConTyVars    = [ k:*,                               a:k->*,      b:k]
+  tyConTyBinders = [ Named (TvBndr (k :: *) Invisible), Anon (k->*), Anon k ]
 
 The TyBinders for App line up with App's kind, given above.
 
@@ -213,9 +212,9 @@ But the DataCon MkApp has the type
 
 That is, its TyBinders should be
 
-  dataConUnivTyVars = [ Named (k:*)    Invisible
-                      , Named (a:k->*) Specified
-                      , Named (b:k)    Specified ]
+  dataConUnivTyVarBinders = [ TvBndr (k:*)    Invisible
+                            , TvBndr (a:k->*) Specified
+                            , TvBndr (b:k)    Specified ]
 
 So we want to take the TyCon's TyBinders and the TyCon's TyVars and
 merge them, pulling
@@ -237,15 +236,15 @@ DataCon (mkDataCon does no further work).
 ------------------------------------------------------
 buildPatSyn :: Name -> Bool
             -> (Id,Bool) -> Maybe (Id, Bool)
-            -> ([TyVar], [TyBinder], ThetaType) -- ^ Univ and req
-            -> ([TyVar], [TyBinder], ThetaType) -- ^ Ex and prov
+            -> ([TyVarBinder], ThetaType) -- ^ Univ and req
+            -> ([TyVarBinder], ThetaType) -- ^ Ex and prov
             -> [Type]               -- ^ Argument types
             -> Type                 -- ^ Result type
             -> [FieldLabel]         -- ^ Field labels for
                                     --   a record pattern synonym
             -> PatSyn
 buildPatSyn src_name declared_infix matcher@(matcher_id,_) builder
-            (univ_tvs, univ_bndrs, req_theta) (ex_tvs, ex_bndrs, prov_theta) arg_tys
+            (univ_tvs, req_theta) (ex_tvs, prov_theta) arg_tys
             pat_ty field_labels
   = -- The assertion checks that the matcher is
     -- compatible with the pattern synonym
@@ -263,17 +262,17 @@ buildPatSyn src_name declared_infix matcher@(matcher_id,_) builder
                     , ppr req_theta <+> twiddle <+> ppr req_theta1
                     , ppr arg_tys <+> twiddle <+> ppr arg_tys1]))
     mkPatSyn src_name declared_infix
-             (univ_tvs, univ_bndrs, req_theta) (ex_tvs, ex_bndrs, prov_theta)
+             (univ_tvs, req_theta) (ex_tvs, prov_theta)
              arg_tys pat_ty
              matcher builder field_labels
   where
     ((_:_:univ_tvs1), req_theta1, tau) = tcSplitSigmaTy $ idType matcher_id
-    ([pat_ty1, cont_sigma, _], _) = tcSplitFunTys tau
-    (ex_tvs1, prov_theta1, cont_tau) = tcSplitSigmaTy cont_sigma
+    ([pat_ty1, cont_sigma, _], _)      = tcSplitFunTys tau
+    (ex_tvs1, prov_theta1, cont_tau)   = tcSplitSigmaTy cont_sigma
     (arg_tys1, _) = tcSplitFunTys cont_tau
     twiddle = char '~'
     subst = zipTvSubst (univ_tvs1 ++ ex_tvs1)
-                       (mkTyVarTys (univ_tvs ++ ex_tvs))
+                       (mkTyVarTys (map binderVar (univ_tvs ++ ex_tvs)))
 
 ------------------------------------------------------
 type TcMethInfo = (Name, Type, Maybe (DefMethSpec Type))
@@ -342,7 +341,6 @@ buildClass tycon_name tvs roles sc_theta binders
                                    [{- No fields -}]
                                    tvs binders
                                    [{- no existentials -}]
-                                   [{- no existentials -}]
                                    [{- No GADT equalities -}]
                                    [{- No theta -}]
                                    arg_tys
index a95d8c9..0ad4b0f 100644 (file)
@@ -1314,8 +1314,8 @@ freeNamesIfForAllBndr :: IfaceForAllBndr -> NameSet
 freeNamesIfForAllBndr (IfaceTv tv _) = freeNamesIfTvBndr tv
 
 freeNamesIfTyBinder :: IfaceTyConBinder -> NameSet
-freeNamesIfTyBinder (IfaceAnon _ ty) = freeNamesIfType ty
-freeNamesIfTyBinder (IfaceNamed b)   = freeNamesIfForAllBndr b
+freeNamesIfTyBinder (IfaceAnon b)  = freeNamesIfTvBndr b
+freeNamesIfTyBinder (IfaceNamed b) = freeNamesIfForAllBndr b
 
 freeNamesIfTyBinders :: [IfaceTyConBinder] -> NameSet
 freeNamesIfTyBinders = fnList freeNamesIfTyBinder
index 45732ca..fb2b3df 100644 (file)
@@ -101,13 +101,15 @@ data IfaceBndr          -- Local (non-top-level) binders
 type IfaceIdBndr  = (IfLclName, IfaceType)
 type IfaceTvBndr  = (IfLclName, IfaceKind)
 
+ifaceTvBndrName :: IfaceTvBndr -> IfLclName
+ifaceTvBndrName (n,_) = n
+
+type IfaceLamBndr = (IfaceBndr, IfaceOneShot)
 
 data IfaceOneShot    -- See Note [Preserve OneShotInfo] in CoreTicy
   = IfaceNoOneShot   -- and Note [The oneShot function] in MkId
   | IfaceOneShot
 
-type IfaceLamBndr
-  = (IfaceBndr, IfaceOneShot)
 
 {-
 %************************************************************************
@@ -148,8 +150,8 @@ data IfaceForAllBndr
   = IfaceTv IfaceTvBndr VisibilityFlag
 
 data IfaceTyConBinder
-  = IfaceAnon  IfLclName IfaceType   -- like Anon, but it includes a name from
-                                     -- which to produce a tyConTyVar
+  = IfaceAnon  IfaceTvBndr      -- Like Anon, but it includes a name from
+                                -- which to produce a tyConTyVar
   | IfaceNamed IfaceForAllBndr
 
 -- See Note [Suppressing invisible arguments]
@@ -159,8 +161,9 @@ data IfaceTyConBinder
 -- type/kind) there'll just be one.
 data IfaceTcArgs
   = ITC_Nil
-  | ITC_Vis   IfaceType IfaceTcArgs
-  | ITC_Invis IfaceKind IfaceTcArgs
+  | ITC_Vis   IfaceType IfaceTcArgs   -- "Vis" means show when pretty-printing
+  | ITC_Invis IfaceKind IfaceTcArgs   -- "Invis" means don't show when pretty-printin
+                                      --         except with -fprint-explicit-kinds
 
 -- Encodes type constructors, kind constructors,
 -- coercion constructors, the lot.
@@ -266,13 +269,12 @@ isIfaceInvisBndr _                                  = False
 
 -- | Extract a IfaceTvBndr from a IfaceTyConBinder
 ifTyConBinderTyVar :: IfaceTyConBinder -> IfaceTvBndr
-ifTyConBinderTyVar (IfaceAnon name ki)         = (name, ki)
+ifTyConBinderTyVar (IfaceAnon tv)              = tv
 ifTyConBinderTyVar (IfaceNamed (IfaceTv tv _)) = tv
 
 -- | Extract the variable name from a IfaceTyConBinder
 ifTyConBinderName :: IfaceTyConBinder -> IfLclName
-ifTyConBinderName (IfaceAnon name _)                 = name
-ifTyConBinderName (IfaceNamed (IfaceTv (name, _) _)) = name
+ifTyConBinderName tcb = ifaceTvBndrName (ifTyConBinderTyVar tcb)
 
 ifTyVarsOfType :: IfaceType -> UniqSet IfLclName
 ifTyVarsOfType ty
@@ -533,12 +535,15 @@ toIfaceTcArgs tc ty_args
     go env ty                  ts
       | Just ty' <- coreView ty
       = go env ty' ts
-    go env (ForAllTy bndr res) (t:ts)
-      | isVisibleBinder bndr = ITC_Vis   t' ts'
-      | otherwise            = ITC_Invis t' ts'
+    go env (ForAllTy (TvBndr tv vis) res) (t:ts)
+      | isVisible vis = ITC_Vis   t' ts'
+      | otherwise     = ITC_Invis t' ts'
       where
         t'  = toIfaceType t
-        ts' = go (extendTvSubstBinder env bndr t) res ts
+        ts' = go (extendTvSubst env tv t) res ts
+
+    go env (FunTy _ res) (t:ts) -- No type-class args in tycon apps
+      = ITC_Vis (toIfaceType t) (go env res ts)
 
     go env (TyVarTy tv) ts
       | Just ki <- lookupTyVar env tv = go env ki ts
@@ -554,9 +559,8 @@ tcArgsIfaceTypes (ITC_Vis   t ts) = t : tcArgsIfaceTypes ts
 Note [Suppressing invisible arguments]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 We use the IfaceTcArgs to specify which of the arguments to a type
-constructor should be visible.
-This in turn used to control suppression when printing types,
-under the control of -fprint-explicit-kinds.
+constructor should be displayed when pretty-printing, under
+the control of -fprint-explicit-kinds.
 See also Type.filterOutInvisibleTypes.
 For example, given
     T :: forall k. (k->*) -> k -> *    -- Ordinary kind polymorphism
@@ -608,8 +612,7 @@ pprIfaceTvBndr (tv, ki)
 pprIfaceTyConBinders :: [IfaceTyConBinder] -> SDoc
 pprIfaceTyConBinders = sep . map go
   where
-    go (IfaceAnon name ki)         = pprIfaceTvBndr (name, ki)
-    go (IfaceNamed (IfaceTv tv _)) = pprIfaceTvBndr tv
+    go tcb = pprIfaceTvBndr (ifTyConBinderTyVar tcb)
 
 instance Binary IfaceBndr where
     put_ bh (IfaceIdBndr aa) = do
@@ -1004,16 +1007,15 @@ instance Binary IfaceForAllBndr where
      return (IfaceTv tv vis)
 
 instance Binary IfaceTyConBinder where
-  put_ bh (IfaceAnon n ty) = putByte bh 0 >> put_ bh n >> put_ bh ty
-  put_ bh (IfaceNamed b)   = putByte bh 1 >> put_ bh b
+  put_ bh (IfaceAnon b)  = putByte bh 0 >> put_ bh b
+  put_ bh (IfaceNamed b) = putByte bh 1 >> put_ bh b
 
   get bh =
     do c <- getByte bh
        case c of
          0 -> do
-           n  <- get bh
-           ty <- get bh
-           return $! IfaceAnon n ty
+           b  <- get bh
+           return $! IfaceAnon b
          _ -> do
            b <- get bh
            return $! IfaceNamed b
@@ -1283,7 +1285,7 @@ instance Binary (DefMethSpec IfaceType) where
 -}
 
 ----------------
-toIfaceTvBndr :: TyVar -> (IfLclName, IfaceKind)
+toIfaceTvBndr :: TyVar -> IfaceTvBndr
 toIfaceTvBndr tyvar   = ( occNameFS (getOccName tyvar)
                         , toIfaceKind (tyVarKind tyvar)
                         )
@@ -1308,9 +1310,8 @@ toIfaceType :: Type -> IfaceType
 toIfaceType (TyVarTy tv)      = IfaceTyVar (toIfaceTyVar tv)
 toIfaceType (AppTy t1 t2)     = IfaceAppTy (toIfaceType t1) (toIfaceType t2)
 toIfaceType (LitTy n)         = IfaceLitTy (toIfaceTyLit n)
-toIfaceType (ForAllTy (Named tv vis) t)
-  = IfaceForAllTy (varToIfaceForAllBndr tv vis) (toIfaceType t)
-toIfaceType (ForAllTy (Anon t1) t2)
+toIfaceType (ForAllTy b t)    = IfaceForAllTy (toIfaceForAllBndr b) (toIfaceType t)
+toIfaceType (FunTy t1 t2)
   | isPredTy t1 = IfaceDFunTy (toIfaceType t1) (toIfaceType t2)
   | otherwise   = IfaceFunTy  (toIfaceType t1) (toIfaceType t2)
 toIfaceType (CastTy ty co)      = IfaceCastTy (toIfaceType ty) (toIfaceCoercion co)
@@ -1338,14 +1339,12 @@ toIfaceTyVar = occNameFS . getOccName
 toIfaceCoVar :: CoVar -> FastString
 toIfaceCoVar = occNameFS . getOccName
 
-varToIfaceForAllBndr :: TyVar -> VisibilityFlag -> IfaceForAllBndr
-varToIfaceForAllBndr v vis
+toIfaceForAllBndr :: TyVarBinder -> IfaceForAllBndr
+toIfaceForAllBndr (TvBndr v vis)
   = IfaceTv (toIfaceTvBndr v) vis
 
-binderToIfaceForAllBndr :: TyBinder -> IfaceForAllBndr
-binderToIfaceForAllBndr (Named v vis) = IfaceTv (toIfaceTvBndr v) vis
-binderToIfaceForAllBndr binder
-  = pprPanic "binderToIfaceForAllBndr" (ppr binder)
+binderToIfaceForAllBndr :: TyVarBinder -> IfaceForAllBndr
+binderToIfaceForAllBndr (TvBndr v vis) = IfaceTv (toIfaceTvBndr v) vis
 
 ----------------
 toIfaceTyCon :: TyCon -> IfaceTyCon
@@ -1419,14 +1418,15 @@ toIfaceUnivCoProv (HoleProv h) = pprPanic "toIfaceUnivCoProv hit a hole" (ppr h)
 zipIfaceBinders :: [TyVar] -> [TyBinder] -> [IfaceTyConBinder]
 zipIfaceBinders = zipWith go
   where
-    go tv (Anon _)      = let (name, ki) = toIfaceTvBndr tv in
-                          IfaceAnon name ki
-    go tv (Named _ vis) = IfaceNamed (IfaceTv (toIfaceTvBndr tv) vis)
+    go tv (Anon _)    = IfaceAnon (toIfaceTvBndr tv)
+    go tv (Named tvb) = IfaceNamed (IfaceTv (toIfaceTvBndr tv) (binderVisibility tvb))
+                        -- Ugh!  take the tidied tyvar from the first arg,
+                        -- and visiblity from the second
 
 -- | Make IfaceTyConBinders without tyConTyVars. Used for pretty-printing only
 toDegenerateBinders :: [TyBinder] -> [IfaceTyConBinder]
 toDegenerateBinders = zipWith go [1..]
   where
     go :: Int -> TyBinder -> IfaceTyConBinder
-    go n (Anon ty)      = IfaceAnon (mkFastString ("t" ++ show n)) (toIfaceType ty)
-    go _ (Named tv vis) = IfaceNamed (IfaceTv (toIfaceTvBndr tv) vis)
+    go n (Anon ty)   = IfaceAnon  (mkFastString ("t" ++ show n), toIfaceType ty)
+    go _ (Named tvb) = IfaceNamed (toIfaceForAllBndr tvb)
index fcf63af..aedec42 100644 (file)
@@ -1321,10 +1321,10 @@ patSynToIfaceDecl ps
                 }
   where
     (_univ_tvs, req_theta, _ex_tvs, prov_theta, args, rhs_ty) = patSynSig ps
-    univ_bndrs = patSynUnivTyBinders ps
-    ex_bndrs   = patSynExTyBinders ps
-    (env1, univ_bndrs') = tidyTyBinders emptyTidyEnv univ_bndrs
-    (env2, ex_bndrs')   = tidyTyBinders env1 ex_bndrs
+    univ_bndrs = patSynUnivTyVarBinders ps
+    ex_bndrs   = patSynExTyVarBinders ps
+    (env1, univ_bndrs') = tidyTyVarBinders emptyTidyEnv univ_bndrs
+    (env2, ex_bndrs')   = tidyTyVarBinders env1 ex_bndrs
     to_if_pr (id, needs_dummy) = (idName id, needs_dummy)
 
 --------------------------
@@ -1415,12 +1415,15 @@ tyConToIfaceDecl env tycon
                   ifParent  = parent })
 
   | otherwise  -- FunTyCon, PrimTyCon, promoted TyCon/DataCon
-  -- For pretty printing purposes only.
+  -- We only convert these TyCons to IfaceTyCons when we are
+  -- just about to pretty-print them, not because we are going
+  -- to put them into interface files
   = ( env
     , IfaceData { ifName       = getOccName tycon,
                   ifBinders    = if_degenerate_binders,
                   ifResKind    = if_degenerate_res_kind,
-                    -- These don't have `tyConTyVars`, hence "degenerate"
+                    -- FunTyCon, PrimTyCon etc don't have
+                    -- `tyConTyVars`, hence "degenerate"
                   ifCType      = Nothing,
                   ifRoles      = tyConRoles tycon,
                   ifCtxt       = [],
@@ -1438,7 +1441,7 @@ tyConToIfaceDecl env tycon
     if_syn_type ty = tidyToIfaceType tc_env1 ty
     if_res_var     = getOccFS `fmap` tyConFamilyResVar_maybe tycon
 
-      -- use these when you don't have tyConTyVars
+      -- Use these when you don't have tyConTyVars
     (degenerate_binders, degenerate_res_kind)
       = splitPiTys (tidyType env (tyConKind tycon))
     if_degenerate_binders  = toDegenerateBinders degenerate_binders
@@ -1492,7 +1495,7 @@ tyConToIfaceDecl env tycon
         where
           (univ_tvs, _ex_tvs, eq_spec, theta, arg_tys, _)
             = dataConFullSig data_con
-          ex_bndrs = dataConExTyBinders data_con
+          ex_bndrs = dataConExTyVarBinders data_con
 
           -- Tidy the univ_tvs of the data constructor to be identical
           -- to the tyConTyVars of the type constructor.  This means
@@ -1504,8 +1507,8 @@ 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_bndrs') = tidyTyBinders con_env1 ex_bndrs
-          to_eq_spec (tv,ty)  = (toIfaceTyVar (tidyTyVar con_env2 tv), tidyToIfaceType con_env2 ty)
+          (con_env2, ex_bndrs') = tidyTyVarBinders con_env1 ex_bndrs
+          to_eq_spec (tv,ty) = (toIfaceTyVar (tidyTyVar con_env2 tv), tidyToIfaceType con_env2 ty)
 
     ifaceOverloaded flds = case dFsEnvElts flds of
                              fl:_ -> flIsOverloaded fl
index a6486f3..35d8325 100644 (file)
@@ -493,16 +493,16 @@ tc_iface_decl _ _ (IfacePatSyn{ ifName = occ_name
        ; traceIf (text "tc_iface_decl" <+> ppr name)
        ; matcher <- tc_pr if_matcher
        ; builder <- fmapMaybeM tc_pr if_builder
-       ; bindIfaceForAllBndrs univ_bndrs $ \univ_tvs univ_bndrs -> do
-       { bindIfaceForAllBndrs ex_bndrs $ \ex_tvs ex_bndrs -> do
+       ; bindIfaceForAllBndrs univ_bndrs $ \univ_tvs -> do
+       { bindIfaceForAllBndrs ex_bndrs $ \ex_tvs -> do
        { patsyn <- forkM (mk_doc name) $
              do { prov_theta <- tcIfaceCtxt prov_ctxt
                 ; req_theta  <- tcIfaceCtxt req_ctxt
                 ; pat_ty     <- tcIfaceType pat_ty
                 ; arg_tys    <- mapM tcIfaceType args
                 ; return $ buildPatSyn name is_infix matcher builder
-                                       (univ_tvs, univ_bndrs, req_theta)
-                                       (ex_tvs, ex_bndrs, prov_theta)
+                                       (univ_tvs, req_theta)
+                                       (ex_tvs, prov_theta)
                                        arg_tys pat_ty field_labels }
        ; return $ AConLike . PatSynCon $ patsyn }}}
   where
@@ -553,7 +553,7 @@ tcIfaceDataCons tycon_name tycon tc_tyvars tc_tybinders if_cons
                          ifConSrcStricts = if_src_stricts})
      = -- Universally-quantified tyvars are shared with
        -- parent TyCon, and are alrady in scope
-       bindIfaceForAllBndrs ex_bndrs    $ \ ex_tvs ex_binders' -> do
+       bindIfaceForAllBndrs ex_bndrs    $ \ ex_tvs -> do
         { traceIf (text "Start interface-file tc_con_decl" <+> ppr occ)
         ; dc_name  <- lookupIfaceTop occ
 
@@ -595,7 +595,7 @@ tcIfaceDataCons tycon_name tycon tc_tyvars tc_tybinders if_cons
                        -- worker.
                        -- See Note [Bangs on imported data constructors] in MkId
                        lbl_names
-                       tc_tyvars tc_tybinders ex_tvs ex_binders'
+                       tc_tyvars tc_tybinders ex_tvs
                        eq_spec theta
                        arg_tys orig_res_ty tycon
         ; traceIf (text "Done interface-file tc_con_decl" <+> ppr dc_name)
@@ -890,15 +890,16 @@ tcIfaceType = go
     go (IfaceTyVar n)         = TyVarTy <$> tcIfaceTyVar n
     go (IfaceAppTy t1 t2)     = AppTy <$> go t1 <*> go t2
     go (IfaceLitTy l)         = LitTy <$> tcIfaceTyLit l
-    go (IfaceFunTy t1 t2)     = ForAllTy <$> (Anon <$> go t1) <*> go t2
-    go (IfaceDFunTy t1 t2)    = ForAllTy <$> (Anon <$> go t1) <*> go t2
+    go (IfaceFunTy t1 t2)     = FunTy <$> go t1 <*> go t2
+    go (IfaceDFunTy t1 t2)    = FunTy <$> go t1 <*> go t2
     go (IfaceTupleTy s i tks) = tcIfaceTupleTy s i tks
     go (IfaceTyConApp tc tks)
       = do { tc' <- tcIfaceTyCon tc
            ; tks' <- mapM go (tcArgsIfaceTypes tks)
            ; return (mkTyConApp tc' tks') }
     go (IfaceForAllTy bndr t)
-      = bindIfaceForAllBndr bndr $ \ tv' vis -> mkNamedForAllTy tv' vis <$> go t
+      = bindIfaceForAllBndr bndr $ \ tv' vis ->
+        ForAllTy (TvBndr tv' vis) <$> go t
     go (IfaceCastTy ty co)   = CastTy <$> go ty <*> tcIfaceCo co
     go (IfaceCoercionTy co)  = CoercionTy <$> tcIfaceCo co
 
@@ -1436,12 +1437,12 @@ bindIfaceBndrs (b:bs) thing_inside
     thing_inside (b':bs')
 
 -----------------------
-bindIfaceForAllBndrs :: [IfaceForAllBndr] -> ([TyVar] -> [TyBinder] -> IfL a) -> IfL a
-bindIfaceForAllBndrs [] thing_inside = thing_inside [] []
+bindIfaceForAllBndrs :: [IfaceForAllBndr] -> ([TyVarBinder] -> IfL a) -> IfL a
+bindIfaceForAllBndrs [] thing_inside = thing_inside []
 bindIfaceForAllBndrs (bndr:bndrs) thing_inside
   = bindIfaceForAllBndr bndr $ \tv vis ->
-    bindIfaceForAllBndrs bndrs $ \tvs bndrs' ->
-    thing_inside (tv:tvs) (mkNamedBinder vis tv : bndrs')
+    bindIfaceForAllBndrs bndrs $ \bndrs' ->
+    thing_inside (mkTyVarBinder vis tv : bndrs')
 
 bindIfaceForAllBndr :: IfaceForAllBndr -> (TyVar -> VisibilityFlag -> IfL a) -> IfL a
 bindIfaceForAllBndr (IfaceTv tv vis) thing_inside
@@ -1488,9 +1489,9 @@ bindIfaceTyConBinders_AT (b : bs) thing_inside
 bindIfaceTyConBinderX :: (IfaceTvBndr -> (TyVar -> IfL a) -> IfL a)
                       -> IfaceTyConBinder
                       -> (TyVar -> TyBinder -> IfL a) -> IfL a
-bindIfaceTyConBinderX bind_tv (IfaceAnon name ki) thing_inside
-  = bind_tv (name, ki) $ \ tv' ->
+bindIfaceTyConBinderX bind_tv (IfaceAnon tv) thing_inside
+  = bind_tv tv $ \ tv' ->
     thing_inside tv' (Anon (tyVarKind tv'))
 bindIfaceTyConBinderX bind_tv (IfaceNamed (IfaceTv tv vis)) thing_inside
   = bind_tv tv $ \tv' ->
-    thing_inside tv' (Named tv' vis)
+    thing_inside tv' (Named (mkTyVarBinder vis tv'))
index a5eee7c..4529353 100644 (file)
@@ -1974,23 +1974,23 @@ lookupTypeHscEnv hsc_env name = do
 -- | Get the 'TyCon' from a 'TyThing' if it is a type constructor thing. Panics otherwise
 tyThingTyCon :: TyThing -> TyCon
 tyThingTyCon (ATyCon tc) = tc
-tyThingTyCon other       = pprPanic "tyThingTyCon" (pprTyThing other)
+tyThingTyCon other       = pprPanic "tyThingTyCon" (ppr other)
 
 -- | Get the 'CoAxiom' from a 'TyThing' if it is a coercion axiom thing. Panics otherwise
 tyThingCoAxiom :: TyThing -> CoAxiom Branched
 tyThingCoAxiom (ACoAxiom ax) = ax
-tyThingCoAxiom other         = pprPanic "tyThingCoAxiom" (pprTyThing other)
+tyThingCoAxiom other         = pprPanic "tyThingCoAxiom" (ppr other)
 
 -- | Get the 'DataCon' from a 'TyThing' if it is a data constructor thing. Panics otherwise
 tyThingDataCon :: TyThing -> DataCon
 tyThingDataCon (AConLike (RealDataCon dc)) = dc
-tyThingDataCon other                       = pprPanic "tyThingDataCon" (pprTyThing other)
+tyThingDataCon other                       = pprPanic "tyThingDataCon" (ppr other)
 
 -- | Get the 'Id' from a 'TyThing' if it is a id *or* data constructor thing. Panics otherwise
 tyThingId :: TyThing -> Id
 tyThingId (AnId id)                   = id
 tyThingId (AConLike (RealDataCon dc)) = dataConWrapId dc
-tyThingId other                       = pprPanic "tyThingId" (pprTyThing other)
+tyThingId other                       = pprPanic "tyThingId" (ppr other)
 
 {-
 ************************************************************************
index 1850e55..e0be093 100644 (file)
@@ -682,7 +682,7 @@ mkProxyPrimTy k ty = TyConApp proxyPrimTyCon [k, ty]
 
 proxyPrimTyCon :: TyCon
 proxyPrimTyCon = mkPrimTyCon proxyPrimTyConName binders res_kind [Nominal,Nominal]
-  where binders  = [ Named kv Specified
+  where binders  = [ Named (TvBndr kv Specified)
                    , Anon k ]
         res_kind = tYPE voidRepDataConTy
         kv       = kKiVar
@@ -699,8 +699,8 @@ proxyPrimTyCon = mkPrimTyCon proxyPrimTyConName binders res_kind [Nominal,Nomina
 eqPrimTyCon :: TyCon  -- The representation type for equality predicates
                       -- See Note [The equality types story]
 eqPrimTyCon  = mkPrimTyCon eqPrimTyConName binders res_kind roles
-  where binders = [ Named kv1 Specified
-                  , Named kv2 Specified
+  where binders = [ Named (TvBndr kv1 Specified)
+                  , Named (TvBndr kv2 Specified)
                   , Anon k1
                   , Anon k2 ]
         res_kind = tYPE voidRepDataConTy
@@ -714,8 +714,8 @@ eqPrimTyCon  = mkPrimTyCon eqPrimTyConName binders res_kind roles
 -- interpreted in coercionRole
 eqReprPrimTyCon :: TyCon   -- See Note [The equality types story]
 eqReprPrimTyCon = mkPrimTyCon eqReprPrimTyConName binders res_kind roles
-  where binders = [ Named kv1 Specified
-                  , Named kv2 Specified
+  where binders = [ Named (TvBndr kv1 Specified)
+                  , Named (TvBndr kv2 Specified)
                   , Anon k1
                   , Anon k2 ]
         res_kind = tYPE voidRepDataConTy
@@ -730,8 +730,8 @@ eqReprPrimTyCon = mkPrimTyCon eqReprPrimTyConName binders res_kind roles
 eqPhantPrimTyCon :: TyCon
 eqPhantPrimTyCon = mkPrimTyCon eqPhantPrimTyConName binders res_kind
                                [Nominal, Nominal, Phantom, Phantom]
-  where binders = [ Named kv1 Specified
-                  , Named kv2 Specified
+  where binders = [ Named (TvBndr kv1 Specified)
+                  , Named (TvBndr kv2 Specified)
                   , Anon k1
                   , Anon k2 ]
         res_kind = tYPE voidRepDataConTy
index 5613d86..82c5bfb 100644 (file)
@@ -130,7 +130,6 @@ import Type
 import DataCon
 import {-# SOURCE #-} ConLike
 import TyCon
-import TyCoRep          ( TyBinder(..) )
 import Class            ( Class, mkClass )
 import RdrName
 import Name
@@ -353,7 +352,7 @@ anyTyCon = mkFamilyTyCon anyTyConName binders res_kind [kKiVar] Nothing
                          Nothing
                          NotInjective
   where
-    binders  = [Named kKiVar Specified]
+    binders  = [mkNamedBinder (mkTyVarBinder Specified kKiVar)]
     res_kind = mkTyVarTy kKiVar
 
 anyTy :: Type
@@ -496,8 +495,8 @@ pcDataConWithFixity' declared_infix dc_name wrk_key rri tyvars ex_tyvars arg_tys
     data_con = mkDataCon dc_name declared_infix prom_info
                 (map (const no_bang) arg_tys)
                 []      -- No labelled fields
-                tyvars    (mkNamedBinders Specified tyvars)
-                ex_tyvars (mkNamedBinders Specified ex_tyvars)
+                (mkTyVarBinders Specified tyvars)
+                (mkTyVarBinders Specified ex_tyvars)
                 []      -- No equality spec
                 []      -- No theta
                 arg_tys (mkTyConApp tycon (mkTyVarTys tyvars))
@@ -758,7 +757,7 @@ mk_tuple boxity arity = (tycon, tuple_con)
             in
             ( UnboxedTuple
             , gHC_PRIM
-            , mkNamedBinders Specified rr_tvs ++
+            , map (mkNamedBinder . mkTyVarBinder Specified) rr_tvs ++
               map (mkAnonBinder . tyVarKind) open_tvs
             , unboxedTupleKind
             , arity * 2
@@ -819,8 +818,8 @@ heqSCSelId, coercibleSCSelId :: Id
     klass     = mkClass tvs [] [sc_pred] [sc_sel_id] [] [] (mkAnd []) tycon
     datacon   = pcDataCon heqDataConName tvs [sc_pred] tycon
 
-    binders   = [ mkNamedBinder Specified kv1
-                , mkNamedBinder Specified kv2
+    binders   = [ mkNamedBinder (mkTyVarBinder Specified kv1)
+                , mkNamedBinder (mkTyVarBinder Specified kv2)
                 , mkAnonBinder k1
                 , mkAnonBinder k2 ]
     kv1:kv2:_ = drop 9 alphaTyVars -- gets "j" and "k"
@@ -843,7 +842,7 @@ heqSCSelId, coercibleSCSelId :: Id
     klass     = mkClass tvs [] [sc_pred] [sc_sel_id] [] [] (mkAnd []) tycon
     datacon   = pcDataCon coercibleDataConName tvs [sc_pred] tycon
 
-    binders   = [ mkNamedBinder Specified kKiVar
+    binders   = [ mkNamedBinder (mkTyVarBinder Specified kKiVar)
                 , mkAnonBinder k
                 , mkAnonBinder k ]
     k         = mkTyVarTy kKiVar
index 94a7e9e..e9a0004 100644 (file)
@@ -78,7 +78,7 @@ import Literal          ( litIsTrivial )
 import Demand           ( StrictSig )
 import Name             ( getOccName, mkSystemVarName )
 import OccName          ( occNameString )
-import Type             ( isUnliftedType, Type, mkPiTypes )
+import Type             ( isUnliftedType, Type, mkLamTypes )
 import BasicTypes       ( Arity, RecFlag(..) )
 import UniqSupply
 import Util
@@ -1092,7 +1092,7 @@ newPolyBndrs dest_lvl
                              mkSysLocalOrCoVar (mkFastString str) uniq poly_ty
                            where
                              str     = "poly_" ++ occNameString (getOccName bndr)
-                             poly_ty = mkPiTypes abs_vars (substTy subst (idType bndr))
+                             poly_ty = mkLamTypes abs_vars (substTy subst (idType bndr))
 
 newLvlVar :: LevelledExpr        -- The RHS of the new binding
           -> Bool                -- Whether it is bottom
index debc7d8..6e6a6aa 100644 (file)
@@ -2525,8 +2525,8 @@ mkDupableAlt env case_bndr (con, bndrs', rhs') = do
                     else do { rw_id <- newId (fsLit "w") voidPrimTy
                             ; return ([setOneShotLambda rw_id], [Var voidPrimId]) }
 
-        ; join_bndr <- newId (fsLit "$j") (mkPiTypes final_bndrs' rhs_ty')
-                -- Note [Funky mkPiTypes]
+        ; join_bndr <- newId (fsLit "$j") (mkLamTypes final_bndrs' rhs_ty')
+                -- Note [Funky mkLamTypes]
 
         ; let   -- We make the lambdas into one-shot-lambdas.  The
                 -- join point is sure to be applied at most once, and doing so
@@ -2643,9 +2643,9 @@ but we only have one env shared between all the alts.
 (Remember we must zap the subst-env before re-simplifying something).
 Rather than do this we simply agree to re-simplify the original (small) thing later.
 
-Note [Funky mkPiTypes]
+Note [Funky mkLamTypes]
 ~~~~~~~~~~~~~~~~~~~~~~
-Notice the funky mkPiTypes.  If the contructor has existentials
+Notice the funky mkLamTypes.  If the contructor has existentials
 it's possible that the join point will be abstracted over
 type variables as well as term variables.
  Example:  Suppose we have
index 2b78705..00c6853 100644 (file)
@@ -1643,7 +1643,7 @@ spec_one env fn arg_bndrs body (call_pat@(qvars, pats), rule_number)
 --        return ()
 
                 -- And build the results
-        ; let spec_id    = mkLocalIdOrCoVar spec_name (mkPiTypes spec_lam_args body_ty)
+        ; let spec_id    = mkLocalIdOrCoVar spec_name (mkLamTypes spec_lam_args body_ty)
                              -- See Note [Transfer strictness]
                              `setIdStrictness` spec_str
                              `setIdArity` count isId spec_lam_args
index b69c914..d587eeb 100644 (file)
@@ -1266,7 +1266,7 @@ specCalls mb_mod env rules_for_me calls_for_me fn rhs
                    | isUnliftedType body_ty     -- C.f. WwLib.mkWorkerArgs
                    = (poly_tyvars ++ [voidArgId], poly_tyvars ++ [voidPrimId])
                    | otherwise = (poly_tyvars, poly_tyvars)
-                 spec_id_ty = mkPiTypes lam_args body_ty
+                 spec_id_ty = mkLamTypes lam_args body_ty
 
            ; spec_f <- newSpecIdSM fn spec_id_ty
            ; (spec_rhs, rhs_uds) <- specExpr rhs_env2 (mkLams lam_args body)
index a789a7b..a18bd9c 100644 (file)
@@ -473,12 +473,12 @@ unusedInjTvsInRHS tycon injList lhs rhs =
         | otherwise            = mapUnionVarSet collectInjVars tys
       collectInjVars (LitTy {})
         = emptyVarSet
-      collectInjVars (ForAllTy (Anon arg) res)
+      collectInjVars (FunTy arg res)
         = collectInjVars arg `unionVarSet` collectInjVars res
       collectInjVars (AppTy fun arg)
         = collectInjVars fun `unionVarSet` collectInjVars arg
       -- no forall types in the RHS of a type family
-      collectInjVars (ForAllTy _ _)    =
+      collectInjVars (ForAllTy {})    =
           panic "unusedInjTvsInRHS.collectInjVars"
       collectInjVars (CastTy ty _)   = collectInjVars ty
       collectInjVars (CoercionTy {}) = emptyVarSet
index 27382c5..7ed98de 100644 (file)
@@ -46,6 +46,7 @@ import CoreSyn     ( isOrphan )
 import FunDeps
 import TcMType
 import Type
+import TyCoRep     ( TyBinder(..), TyVarBinder(..) )
 import TcType
 import HscTypes
 import Class( Class )
@@ -183,7 +184,7 @@ top_instantiate inst_all orig ty
                | otherwise        = ([], theta)
              in_scope    = mkInScopeSet (tyCoVarsOfType ty)
              empty_subst = mkEmptyTCvSubst in_scope
-             inst_tvs    = map (binderVar "top_inst") inst_bndrs
+             inst_tvs    = binderVars inst_bndrs
        ; (subst, inst_tvs') <- mapAccumLM newMetaTyVarX empty_subst inst_tvs
        ; let inst_theta' = substTheta subst inst_theta
              sigma'      = substTy subst (mkForAllTys leave_bndrs $
@@ -212,7 +213,7 @@ top_instantiate inst_all orig ty
 
   | otherwise = return (idHsWrapper, ty)
   where
-    (binders, phi) = tcSplitNamedPiTys ty
+    (binders, phi) = tcSplitForAllTyVarBndrs ty
     (theta, rho)   = tcSplitPhiTy phi
 
     should_inst bndr
@@ -367,13 +368,17 @@ tcInstBindersX subst mb_kind_info bndrs
 -- | Used only in *types*
 tcInstBinderX :: Maybe (VarEnv Kind)
               -> TCvSubst -> TyBinder -> TcM (TCvSubst, TcType)
-tcInstBinderX mb_kind_info subst binder
-  | Just tv <- binderVar_maybe binder
+tcInstBinderX mb_kind_info subst (Named (TvBndr tv _))
   = case lookup_tv tv of
       Just ki -> return (extendTvSubstAndInScope subst tv ki, ki)
       Nothing -> do { (subst', tv') <- newMetaTyVarX subst tv
                     ; return (subst', mkTyVarTy tv') }
+  where
+    lookup_tv tv = do { env <- mb_kind_info   -- `Maybe` monad
+                      ; lookupVarEnv env tv }
+
 
+tcInstBinderX _ subst (Anon ty)
      -- This is the *only* constraint currently handled in types.
   | Just (mk, role, k1, k2) <- get_pred_tys_maybe substed_ty
   = do { let origin = TypeEqOrigin { uo_actual   = k1
@@ -382,7 +387,7 @@ tcInstBinderX mb_kind_info subst binder
        ; co <- case role of
                  Nominal          -> unifyKind noThing k1 k2
                  Representational -> emitWantedEq origin KindLevel role k1 k2
-                 Phantom          -> pprPanic "tcInstBinderX Phantom" (ppr binder)
+                 Phantom          -> pprPanic "tcInstBinderX Phantom" (ppr ty)
        ; arg' <- mk co k1 k2
        ; return (subst, arg') }
 
@@ -397,14 +402,11 @@ tcInstBinderX mb_kind_info subst binder
 
 
   | otherwise
-  = do { ty <- newFlexiTyVarTy substed_ty
-       ; return (subst, ty) }
+  = do { tv_ty <- newFlexiTyVarTy substed_ty
+       ; return (subst, tv_ty) }
 
   where
-    substed_ty = substTy subst (binderType binder)
-
-    lookup_tv tv = do { env <- mb_kind_info   -- `Maybe` monad
-                      ; lookupVarEnv env tv }
+    substed_ty = substTy subst ty
 
       -- handle boxed equality constraints, because it's so easy
     get_pred_tys_maybe ty
index f2424ea..8285276 100644 (file)
@@ -297,7 +297,7 @@ tc_cmd env cmd@(HsCmdArrForm expr fixity cmd_args) (cmd_stk, res_ty)
   = addErrCtxt (cmdCtxt cmd)    $
     do  { (cmd_args', cmd_tys) <- mapAndUnzipM tc_cmd_arg cmd_args
                               -- We use alphaTyVar for 'w'
-        ; let e_ty = mkNamedForAllTy alphaTyVar Invisible $
+        ; let e_ty = mkInvForAllTy alphaTyVar $
                      mkFunTys cmd_tys $
                      mkCmdArrTy env (mkPairTy alphaTy cmd_stk) res_ty
         ; expr' <- tcPolyExpr expr e_ty
index 4517b73..fb89416 100644 (file)
@@ -35,6 +35,7 @@ import FamInstEnv( normaliseType )
 import FamInst( tcGetFamInstEnvs )
 import TyCon
 import TcType
+import Type( mkStrLitTy, tidyOpenType, TyVarBinder, mkTyVarBinder )
 import TysPrim
 import TysWiredIn( cTupleTyConName )
 import Id
@@ -54,7 +55,6 @@ import Maybes
 import Util
 import BasicTypes
 import Outputable
-import Type(mkStrLitTy, tidyOpenType)
 import PrelNames( gHC_PRIM, ipClassName )
 import TcValidity (checkValidType)
 import UniqFM
@@ -835,13 +835,13 @@ chooseInferredQuantifiers :: TcThetaType   -- inferred
                           -> TcTyVarSet    -- tvs free in tau type
                           -> [TcTyVar]     -- inferred quantified tvs
                           -> Maybe TcIdSigInst
-                          -> TcM ([TcTyBinder], TcThetaType)
+                          -> TcM ([TyVarBinder], TcThetaType)
 chooseInferredQuantifiers inferred_theta tau_tvs qtvs Nothing
   = -- No type signature (partial or complete) for this binder,
     do { let free_tvs = closeOverKinds (growThetaTyVars inferred_theta tau_tvs)
                         -- Include kind variables!  Trac #7916
              my_theta = pickCapturedPreds free_tvs inferred_theta
-             binders  = [ mkNamedBinder Invisible tv
+             binders  = [ mkTyVarBinder Invisible tv
                         | tv <- qtvs
                         , tv `elemVarSet` free_tvs ]
        ; return (binders, my_theta) }
@@ -886,7 +886,7 @@ chooseInferredQuantifiers inferred_theta tau_tvs qtvs
   where
     spec_tv_set = mkVarSet $ map snd annotated_tvs
     mk_binders free_tvs
-      = [ mkNamedBinder vis tv
+      = [ mkTyVarBinder vis tv
         | tv <- qtvs
         , tv `elemVarSet` free_tvs
         , let vis | tv `elemVarSet` spec_tv_set = Specified
index cde6478..3d05a55 100644 (file)
@@ -594,10 +594,10 @@ can_eq_nc' _flat _rdr_env _envs ev eq_rel ty1 _ ty2 _
   = canTyConApp ev eq_rel tc1 tys1 tc2 tys2
 
 can_eq_nc' _flat _rdr_env _envs ev eq_rel
-           s1@(ForAllTy (Named {}) _) _ s2@(ForAllTy (Named {}) _) _
+           s1@(ForAllTy {}) _ s2@(ForAllTy {}) _
  | CtWanted { ctev_loc = loc, ctev_dest = orig_dest } <- ev
- = do { let (bndrs1,body1) = tcSplitNamedPiTys s1
-            (bndrs2,body2) = tcSplitNamedPiTys s2
+ = do { let (bndrs1,body1) = tcSplitForAllTyVarBndrs s1
+            (bndrs2,body2) = tcSplitForAllTyVarBndrs s2
       ; if not (equalLength bndrs1 bndrs2)
         then do { traceTcS "Forall failure" $
                      vcat [ ppr s1, ppr s2, ppr bndrs1, ppr bndrs2
@@ -1138,7 +1138,7 @@ canDecomposableTyConAppOK ev eq_rel tc tys1 tys2
       -- in error messages
     bndrs      = tyConBinders tc
     kind_loc   = toKindLoc loc
-    is_kinds   = map isNamedBinder bndrs
+    is_kinds   = map isNamedTyBinder bndrs
     new_locs | Just KindLevel <- ctLocTypeOrKind_maybe loc
              = repeat loc
              | otherwise
@@ -1896,7 +1896,7 @@ unifyWanted loc role orig_ty1 orig_ty2
     go ty1 ty2 | Just ty1' <- coreView ty1 = go ty1' ty2
     go ty1 ty2 | Just ty2' <- coreView ty2 = go ty1 ty2'
 
-    go (ForAllTy (Anon s1) t1) (ForAllTy (Anon s2) t2)
+    go (FunTy s1 t1) (FunTy s2 t2)
       = do { co_s <- unifyWanted loc role s1 s2
            ; co_t <- unifyWanted loc role t1 t2
            ; return (mkTyConAppCo role funTyCon [co_s,co_t]) }
@@ -1945,7 +1945,7 @@ unify_derived loc role    orig_ty1 orig_ty2
     go ty1 ty2 | Just ty1' <- coreView ty1 = go ty1' ty2
     go ty1 ty2 | Just ty2' <- coreView ty2 = go ty1 ty2'
 
-    go (ForAllTy (Anon s1) t1) (ForAllTy (Anon s2) t2)
+    go (FunTy s1 t1) (FunTy s2 t2)
       = do { unify_derived loc role s1 s2
            ; unify_derived loc role t1 t2 }
     go (TyConApp tc1 tys1) (TyConApp tc2 tys2)
index 030de07..2418517 100644 (file)
@@ -1087,8 +1087,8 @@ inferConstraints tvs main_cls cls_tys inst_ty rep_tc rep_tc_args mkTheta
   where
     tc_binders = tyConBinders rep_tc
     choose_level bndr
-      | isNamedBinder bndr = KindLevel
-      | otherwise          = TypeLevel
+      | isNamedTyBinder bndr = KindLevel
+      | otherwise            = TypeLevel
     t_or_ks = map choose_level tc_binders ++ repeat TypeLevel
        -- want to report *kind* errors when possible
 
index d5b003b..2a87975 100644 (file)
@@ -1800,17 +1800,17 @@ expandSynonymsToMatch ty1 ty2 = (ty1_ret, ty2_ret)
           (t1_2', t2_2') = go t1_2 t2_2
        in (mkAppTy t1_1' t1_2', mkAppTy t2_1' t2_2')
 
-    go (ForAllTy (Anon t1_1) t1_2) (ForAllTy (Anon t2_1) t2_2) =
+    go (FunTy t1_1 t1_2) (FunTy t2_1 t2_2) =
       let (t1_1', t2_1') = go t1_1 t2_1
           (t1_2', t2_2') = go t1_2 t2_2
        in (mkFunTy t1_1' t1_2', mkFunTy t2_1' t2_2')
 
-    go (ForAllTy (Named tv1 vis1) t1) (ForAllTy (Named tv2 vis2) t2) =
+    go (ForAllTy b1 t1) (ForAllTy b2 t2) =
       -- NOTE: We may have a bug here, but we just can't reproduce it easily.
       -- See D1016 comments for details and our attempts at producing a test
       -- case. Short version: We probably need RnEnv2 to really get this right.
       let (t1', t2') = go t1 t2
-       in (ForAllTy (Named tv1 vis1) t1', ForAllTy (Named tv2 vis2) t2')
+       in (ForAllTy b1 t1', ForAllTy b2 t2')
 
     go (CastTy ty1 _) ty2 = go ty1 ty2
     go ty1 (CastTy ty2 _) = go ty1 ty2
@@ -1864,13 +1864,13 @@ expandSynonymsToMatch ty1 ty2 = (ty1_ret, ty2_ret)
       | otherwise = followExpansions tss
 
     sameShapes :: Type -> Type -> Bool
-    sameShapes AppTy{}              AppTy{}              = True
-    sameShapes (TyConApp tc1 _)     (TyConApp tc2 _)     = tc1 == tc2
-    sameShapes (ForAllTy Anon{} _)  (ForAllTy Anon{} _)  = True
-    sameShapes (ForAllTy Named{} _) (ForAllTy Named{} _) = True
-    sameShapes (CastTy ty1 _)       ty2                  = sameShapes ty1 ty2
-    sameShapes ty1                  (CastTy ty2 _)       = sameShapes ty1 ty2
-    sameShapes _                    _                    = False
+    sameShapes AppTy{}          AppTy{}          = True
+    sameShapes (TyConApp tc1 _) (TyConApp tc2 _) = tc1 == tc2
+    sameShapes (FunTy {})       (FunTy {})       = True
+    sameShapes (ForAllTy {})    (ForAllTy {})    = True
+    sameShapes (CastTy ty1 _)   ty2              = sameShapes ty1 ty2
+    sameShapes ty1              (CastTy ty2 _)   = sameShapes ty1 ty2
+    sameShapes _                _                = False
 
 sameOccExtra :: TcType -> TcType -> SDoc
 -- See Note [Disambiguating (X ~ X) errors]
index 816fd9b..0e3c655 100644 (file)
@@ -1189,13 +1189,14 @@ tcArgs fun orig_fun_ty fun_orig orig_args herald
       = do { (wrap1, upsilon_ty) <- topInstantiateInferred fun_orig fun_ty
                -- wrap1 :: fun_ty "->" upsilon_ty
            ; case tcSplitForAllTy_maybe upsilon_ty of
-               Just (binder, inner_ty)
-                 | Just tv <- binderVar_maybe binder ->
-                 ASSERT2( binderVisibility binder == Specified
-                        , (vcat [ ppr fun_ty, ppr upsilon_ty, ppr binder
+               Just (tvb, inner_ty) ->
+                 do { let tv   = binderVar tvb
+                          vis  = binderVisibility tvb
+                          kind = tyVarKind tv
+                    ; MASSERT2( vis == Specified
+                        , (vcat [ ppr fun_ty, ppr upsilon_ty, ppr tvb
                                 , ppr inner_ty, pprTvBndr tv
-                                , ppr (binderVisibility binder) ]) )
-                 do { let kind = tyVarKind tv
+                                , ppr vis ]) )
                     ; ty_arg <- tcHsTypeApp hs_ty_arg kind
                     ; let insted_ty = substTyWithUnchecked [tv] [ty_arg] inner_ty
                     ; (inner_wrap, args', res_ty)
index 5005abc..f31c122 100644 (file)
@@ -972,21 +972,21 @@ flatten_one (TyConApp tc tys)
 --                   _ -> fmode
   = flatten_ty_con_app tc tys
 
-flatten_one (ForAllTy (Anon ty1) ty2)
+flatten_one (FunTy ty1 ty2)
   = do { (xi1,co1) <- flatten_one ty1
        ; (xi2,co2) <- flatten_one ty2
        ; role <- getRole
        ; return (mkFunTy xi1 xi2, mkFunCo role co1 co2) }
 
-flatten_one ty@(ForAllTy (Named {}) _)
+flatten_one ty@(ForAllTy {})
 -- TODO (RAE): This is inadequate, as it doesn't flatten the kind of
 -- the bound tyvar. Doing so will require carrying around a substitution
 -- and the usual substTyVarBndr-like silliness. Argh.
 
 -- We allow for-alls when, but only when, no type function
 -- applications inside the forall involve the bound type variables.
-  = do { let (bndrs, rho) = splitNamedPiTys ty
-             tvs          = map (binderVar "flatten") bndrs
+  = do { let (bndrs, rho) = splitForAllTyVarBndrs ty
+             tvs          = map binderVar bndrs
        ; (rho', co) <- setMode FM_SubstOnly $ flatten_one rho
                          -- Substitute only under a forall
                          -- See Note [Flattening under a forall]
index cb4c9ce..99838fe 100644 (file)
@@ -128,11 +128,11 @@ normaliseFfiType' env ty0 = go initRecTc ty0
       | Just (tc, tys) <- splitTyConApp_maybe ty
       = go_tc_app rec_nts tc tys
 
-      | Just (bndr, inner_ty) <- splitPiTy_maybe ty
-      , Just tyvar <- binderVar_maybe bndr
+      | (bndrs, inner_ty) <- splitForAllTyVarBndrs ty
+      , not (null bndrs)
       = do (coi, nty1, gres1) <- go rec_nts inner_ty
-           return ( mkHomoForAllCos [tyvar] coi
-                  , mkForAllTy bndr nty1, gres1 )
+           return ( mkHomoForAllCos (map binderVar bndrs) coi
+                  , mkForAllTys bndrs nty1, gres1 )
 
       | otherwise -- see Note [Don't recur in normaliseFfiType']
       = return (mkRepReflCo ty, ty, emptyBag)
index e01586c..b085135 100644 (file)
@@ -1640,8 +1640,8 @@ functorLikeTraverse var (FT { ft_triv = caseTrivial,     ft_var = caseVar
 
     go co ty | Just ty' <- coreView ty = go co ty'
     go co (TyVarTy    v) | v == var = (if co then caseCoVar else caseVar,True)
-    go co (ForAllTy (Anon x) y)  | isPredTy x = go co y
-                                 | xc || yc   = (caseFun xr yr,True)
+    go co (FunTy x y)  | isPredTy x = go co y
+                       | xc || yc   = (caseFun xr yr,True)
         where (xr,xc) = go (not co) x
               (yr,yc) = go co       y
     go co (AppTy    x y) | xc = (caseWrongArg,   True)
@@ -1659,9 +1659,10 @@ functorLikeTraverse var (FT { ft_triv = caseTrivial,     ft_var = caseVar
        | otherwise        = (caseWrongArg, True)   -- Non-decomposable (eg type function)
        where
          (xrs,xcs) = unzip (map (go co) args)
-    go _  (ForAllTy (Named _ Visible) _) = panic "unexpected visible binder"
-    go co (ForAllTy (Named v _)       x) | v /= var && xc = (caseForAll v xr,True)
-        where (xr,xc) = go co x
+    go co (ForAllTy (TvBndr v vis) x)
+       | isVisible vis   = panic "unexpected visible binder"
+       | v /= var && xc  = (caseForAll v xr,True)
+       where (xr,xc) = go co x
 
     go _ _ = (caseTrivial,False)
 
index 2e6ab35..87f333b 100644 (file)
@@ -48,7 +48,7 @@ import TcEvidence
 import TysPrim
 import TysWiredIn
 import Type
-import TyCoRep  ( TyBinder(..) )
+import TyCoRep  ( TyBinder(..), TyVarBinder(..) )
 import TyCon
 import Coercion
 import ConLike
@@ -345,9 +345,9 @@ zonkTyBinders = mapAccumLM zonkTyBinder
 
 zonkTyBinder :: ZonkEnv -> TcTyBinder -> TcM (ZonkEnv, TyBinder)
 zonkTyBinder env (Anon ty) = (env, ) <$> (Anon <$> zonkTcTypeToType env ty)
-zonkTyBinder env (Named tv vis)
+zonkTyBinder env (Named (TvBndr tv vis))
   = do { (env', tv') <- zonkTyBndrX env tv
-       ; return (env', Named tv' vis) }
+       ; return (env', Named (TvBndr tv' vis)) }
 
 zonkTopExpr :: HsExpr TcId -> TcM (HsExpr Id)
 zonkTopExpr e = zonkExpr emptyZonkEnv e
index 7fb77e6..7297066 100644 (file)
@@ -57,6 +57,7 @@ import TcSimplify ( solveEqualities )
 import TcType
 import Inst   ( tcInstBinders, tcInstBindersX )
 import Type
+import TyCoRep( TyBinder(..) )
 import Kind
 import RdrName( lookupLocalRdrOcc )
 import Var
@@ -521,7 +522,7 @@ tc_hs_type mode (HsForAllTy { hst_bndrs = hs_tvs, hst_body = ty }) exp_kind
     -- Why exp_kind?  See Note [Body kind of HsForAllTy]
     do { ty' <- tc_lhs_type mode ty exp_kind
        ; let bound_vars = allBoundVariables ty'
-             bndrs      = mkNamedBinders Specified tvs'
+             bndrs      = mkTyVarBinders Specified tvs'
        ; return (mkForAllTys bndrs ty', bound_vars) }
 
 tc_hs_type mode (HsQualTy { hst_ctxt = ctxt, hst_body = ty }) exp_kind
@@ -788,10 +789,10 @@ tc_infer_args mode orig_ty binders mb_kind_info orig_args n0
       = ASSERT( isVisibleBinder binder )
         do { traceTc "tc_infer_args 2" (ppr binder $$ ppr arg)
            ; arg' <- addErrCtxt (funAppCtxt orig_ty arg n) $
-                     tc_lhs_type mode arg (substTyUnchecked subst $ binderType binder)
-           ; let subst' = case binderVar_maybe binder of
-                   Just tv -> extendTvSubst subst tv arg'
-                   Nothing -> subst
+                     tc_lhs_type mode arg (substTyUnchecked subst $ tyBinderType binder)
+           ; let subst' = case binder of
+                   Named bndr -> extendTvSubst subst (binderVar bndr) arg'
+                   Anon {}    -> subst
            ; go subst' binders args (n+1) (arg' : acc) }
 
     go subst [] all_args n acc
@@ -816,7 +817,7 @@ tcInferApps mode orig_ty ty ki args = go ty ki args 1
       = do { (subst, leftover_binders, args', leftover_args, n')
                 <- tc_infer_args mode orig_ty binders Nothing args n
            ; let fun_kind' = substTyUnchecked subst $
-                             mkForAllTys leftover_binders res_kind
+                             mkPiTys leftover_binders res_kind
            ; go (mkNakedAppTys fun args') fun_kind' leftover_args n' }
 
     go fun fun_kind all_args@(arg:args) n
@@ -875,7 +876,7 @@ instantiateTyN n ty ki
     in
     if num_to_inst <= 0 then return (ty, ki) else
     do { (subst, inst_args) <- tcInstBinders inst_bndrs
-       ; let rebuilt_ki = mkForAllTys leftover_bndrs inner_ki
+       ; let rebuilt_ki = mkPiTys leftover_bndrs inner_ki
              ki'        = substTy subst rebuilt_ki
        ; return (mkNakedAppTys ty inst_args, ki') }
 
@@ -1008,7 +1009,7 @@ So we must be careful not to use "smart constructors" for types that
 look at the TyCon or Class involved.
 
   * Hence the use of mkNakedXXX functions. These do *not* enforce
-    the invariants (for example that we use (ForAllTy (Anon s) t) rather
+    the invariants (for example that we use (FunTy s t) rather
     than (TyConApp (->) [s,t])).
 
   * The zonking functions establish invariants (even zonkTcType, a change from
@@ -1247,12 +1248,12 @@ kcHsTyVarBndrs name cusk open_fam all_kind_vars
            -- kind vars, in dependency order.
        ; binders  <- mapM zonkTcTyBinder binders
        ; res_kind <- zonkTcType res_kind
-       ; let qkvs = tyCoVarsOfTypeWellScoped (mkForAllTys binders res_kind)
+       ; let qkvs = tyCoVarsOfTypeWellScoped (mkPiTys binders res_kind)
                    -- the visibility of tvs doesn't matter here; we just
                    -- want the free variables not to include the tvs
 
-          -- if there are any meta-tvs left, the user has lied about having
-          -- a CUSK. Error.
+          -- If there are any meta-tvs left, the user has
+          -- lied about having a CUSK. Error.
        ; let (meta_tvs, good_tvs) = partition isMetaTyVar qkvs
        ; when (not (null meta_tvs)) $
          report_non_cusk_tvs (qkvs ++ tvs)
@@ -1268,7 +1269,7 @@ kcHsTyVarBndrs name cusk open_fam all_kind_vars
                                            scoped_kvs
        ; reportFloatingKvs name tycon_tyvars unmentioned_kvs
 
-       ; let final_binders      = mkNamedBinders Specified good_tvs ++ binders
+       ; let final_binders      = mkNamedTyBinders Specified good_tvs ++ binders
              mk_tctc unsat      = mkTcTyCon name tycon_tyvars
                                             final_binders res_kind
                                             unsat (scoped_kvs ++ tvs)
@@ -1318,7 +1319,7 @@ kcHsTyVarBndrs name cusk open_fam all_kind_vars
                                                 thing
                   -- See Note [Dependent LHsQTyVars]
            ; let new_binder | hsTyVarName hs_tv `elemNameSet` dep_names
-                            = mkNamedBinder Visible tv
+                            = mkNamedBinder (mkTyVarBinder Visible tv)
                             | otherwise
                             = mkAnonBinder (tyVarKind tv)
            ; return ( tv : tvs
@@ -1681,13 +1682,13 @@ tcDataKindSig kind
             -- NB: Use the tv from a binder if there is one. Otherwise,
             -- we end up inventing a new Unique for it, and any other tv
             -- that mentions the first ends up with the wrong kind.
-        ; return ( [ tv
-                   | ((bndr, occ), uniq) <- bndrs `zip` occs `zip` uniqs
-                   , let tv | Just bndr_tv <- binderVar_maybe bndr
-                            = bndr_tv
-                            | otherwise
-                            = mk_tv span uniq occ (binderType bndr) ]
-                 , bndrs, res_kind ) }
+              tvs = [ tv
+                    | (bndr, occ, uniq) <- zip3 bndrs occs uniqs
+                    , let tv = case bndr of
+                                 Named tvb -> binderVar tvb
+                                 Anon kind -> mk_tv span uniq occ kind ]
+
+        ; return (tvs, bndrs, res_kind) }
   where
     (bndrs, res_kind) = splitPiTys kind
     mk_tv loc uniq occ kind
index d078e2d..8c968df 100644 (file)
@@ -983,7 +983,7 @@ tcSuperClasses dfun_id cls tyvars dfun_evs inst_tys dfun_ev_binds _fam_envs sc_t
            ; sc_top_name  <- newName (mkSuperDictAuxOcc n (getOccName cls))
            ; sc_ev_id     <- newEvVar sc_pred
            ; addTcEvBind ev_binds_var $ mkWantedEvBind sc_ev_id sc_ev_tm
-           ; let sc_top_ty = mkInvForAllTys tyvars (mkPiTypes dfun_evs sc_pred)
+           ; let sc_top_ty = mkInvForAllTys tyvars (mkLamTypes dfun_evs sc_pred)
                  sc_top_id = mkLocalId sc_top_name sc_top_ty
                  export = ABE { abe_wrap = idHsWrapper
                               , abe_poly = sc_top_id
index 8cd6066..f6a59e1 100644 (file)
@@ -2034,8 +2034,8 @@ doTyConApp clas ty args
 -- polymorphism, but no more.
 onlyNamedBndrsApplied :: TyCon -> [KindOrType] -> Bool
 onlyNamedBndrsApplied tc ks
- = all isNamedBinder used_bndrs &&
-   not (any isNamedBinder leftover_bndrs)
+ = all isNamedTyBinder used_bndrs &&
+   all isAnonTyBinder  leftover_bndrs
  where
    bndrs                        = tyConBinders tc
    (used_bndrs, leftover_bndrs) = splitAtList ks bndrs
index 5f11e10..c2cf82e 100644 (file)
@@ -1375,8 +1375,10 @@ zonkTcTyCoVarBndr tyvar
 
 -- | Zonk a TyBinder
 zonkTcTyBinder :: TcTyBinder -> TcM TcTyBinder
-zonkTcTyBinder (Anon ty)      = Anon <$> zonkTcType ty
-zonkTcTyBinder (Named tv vis) = Named <$> zonkTcTyCoVarBndr tv <*> pure vis
+zonkTcTyBinder (Anon ty)   = Anon <$> zonkTcType ty
+zonkTcTyBinder (Named (TvBndr tv vis))
+  = do { tv' <- zonkTcTyCoVarBndr tv
+       ; return (Named (TvBndr tv' vis)) }
 
 zonkTcTyVar :: TcTyVar -> TcM TcType
 -- Simply look through all Flexis
index 8d59b8f..85a7e30 100644 (file)
@@ -501,7 +501,7 @@ tcLcStmt m_tc ctxt (TransStmt { trS_form = form, trS_stmts = stmts
              tup_ty        = mkBigCoreVarTupTy bndr_ids
              poly_arg_ty   = m_app alphaTy
              poly_res_ty   = m_app (n_app alphaTy)
-             using_poly_ty = mkNamedForAllTy alphaTyVar Invisible $
+             using_poly_ty = mkInvForAllTy alphaTyVar $
                              by_arrow $
                              poly_arg_ty `mkFunTy` poly_res_ty
 
@@ -638,7 +638,7 @@ tcMcStmt ctxt (TransStmt { trS_stmts = stmts, trS_bndrs = bindersMap
              using_arg_ty = m1_ty `mkAppTy` tup_ty
              poly_res_ty  = m2_ty `mkAppTy` n_app alphaTy
              using_res_ty = m2_ty `mkAppTy` n_app tup_ty
-             using_poly_ty = mkNamedForAllTy alphaTyVar Invisible $
+             using_poly_ty = mkInvForAllTy alphaTyVar $
                              by_arrow $
                              poly_arg_ty `mkFunTy` poly_res_ty
 
@@ -678,8 +678,8 @@ tcMcStmt ctxt (TransStmt { trS_stmts = stmts, trS_bndrs = bindersMap
        ; fmap_op' <- case form of
                        ThenForm -> return noExpr
                        _ -> fmap unLoc . tcPolyExpr (noLoc fmap_op) $
-                            mkNamedForAllTy alphaTyVar Invisible $
-                            mkNamedForAllTy betaTyVar  Invisible $
+                            mkInvForAllTy alphaTyVar $
+                            mkInvForAllTy betaTyVar  $
                             (alphaTy `mkFunTy` betaTy)
                             `mkFunTy` (n_app alphaTy)
                             `mkFunTy` (n_app betaTy)
index c5a0c27..e2d2638 100644 (file)
@@ -16,6 +16,7 @@ import HsSyn
 import TcPat
 import Type( binderVar, mkNamedBinders, binderVisibility, mkEmptyTCvSubst
            , tidyTyCoVarBndrs, tidyTypes, tidyType )
+           , tcHsContext, tcHsLiftedType, tcHsOpenType, kindGeneralize )
 import TcRnMonad
 import TcSigs( emptyPragEnv, completeSigFromId )
 import TcEnv
@@ -90,9 +91,9 @@ tcInferPatSynDecl PSB{ psb_id = lname@(L _ name), psb_args = details,
 
        ; traceTc "tcInferPatSynDecl }" $ ppr name
        ; tc_patsyn_finish lname dir is_infix lpat'
-                          (univ_tvs, mkNamedBinders Invisible univ_tvs
+                          (mkTyVarBinders Invisible univ_tvs
                             , req_theta,  ev_binds, req_dicts)
-                          (ex_tvs,   mkNamedBinders Invisible ex_tvs
+                          (mkTyVarBinders Invisible ex_tvs
                             , mkTyVarTys ex_tvs, prov_theta, map EvId prov_dicts)
                           (map nlHsVar args, map idType args)
                           pat_ty rec_fields }
@@ -185,8 +186,8 @@ tcCheckPatSynDecl psb@PSB{ psb_id = lname@(L _ name), psb_args = details
 
        ; traceTc "tcCheckPatSynDecl }" $ ppr name
        ; tc_patsyn_finish lname dir is_infix lpat'
-                          (univ_tvs, univ_bndrs, req_theta, ev_binds, req_dicts)
-                          (ex_tvs, ex_bndrs, mkTyVarTys ex_tvs', prov_theta, prov_dicts)
+                          (univ_bndrs, req_theta, ev_binds, req_dicts)
+                          (ex_bndrs, mkTyVarTys ex_tvs', prov_theta, prov_dicts)
                           (args', arg_tys)
                           pat_ty rec_fields }
   where
@@ -284,74 +285,54 @@ tc_patsyn_finish :: Located Name  -- ^ PatSyn Name
                  -> HsPatSynDir Name  -- ^ PatSyn type (Uni/Bidir/ExplicitBidir)
                  -> Bool              -- ^ Whether infix
                  -> LPat Id           -- ^ Pattern of the PatSyn
-                 -> ([TcTyVar], [TcTyBinder], [PredType], TcEvBinds, [EvVar])
-                 -> ([TcTyVar], [TcTyBinder], [TcType], [PredType], [EvTerm])
+                 -> ([TcTyVarBinder], [PredType], TcEvBinds, [EvVar])
+                 -> ([TcTyVarBinder], [TcType], [PredType], [EvTerm])
                  -> ([LHsExpr TcId], [TcType])   -- ^ Pattern arguments and types
                  -> TcType              -- ^ Pattern type
                  -> [Name]              -- ^ Selector names
                  -- ^ Whether fields, empty if not record PatSyn
                  -> TcM (LHsBinds Id, TcGblEnv)
 tc_patsyn_finish lname dir is_infix lpat'
-                 (univ_tvs, univ_bndrs, req_theta, req_ev_binds, req_dicts)
-                 (ex_tvs, ex_bndrs, ex_tys, prov_theta, prov_dicts)
+                 (univ_bndrs, req_theta, req_ev_binds, req_dicts)
+                 (ex_bndrs, ex_tys, prov_theta, prov_dicts)
                  (args, arg_tys)
                  pat_ty field_labels
   = do { -- Zonk everything.  We are about to build a final PatSyn
          -- so there had better be no unification variables in there
-         univ_tvs'    <- mapMaybeM (zonkQuantifiedTyVar False) univ_tvs
-       ; ex_tvs'      <- mapMaybeM (zonkQuantifiedTyVar False) ex_tvs
-                         -- ToDo: The False means that we behave here as if
-                         -- -XPolyKinds was always on, which isn't right.
+         univ_tvs'    <- mapMaybeM zonk_qtv univ_bndrs
+       ; ex_tvs'      <- mapMaybeM zonk_qtv ex_bndrs
        ; prov_theta'  <- zonkTcTypes prov_theta
        ; req_theta'   <- zonkTcTypes req_theta
        ; pat_ty'      <- zonkTcType pat_ty
        ; arg_tys'     <- zonkTcTypes arg_tys
 
-       ; let (env1, univ_tvs) = tidyTyCoVarBndrs emptyTidyEnv univ_tvs'
-             (env2, ex_tvs)   = tidyTyCoVarBndrs env1 ex_tvs'
+       ; let (env1, univ_tvs) = tidyTyVarBinders emptyTidyEnv univ_tvs'
+             (env2, ex_tvs)   = tidyTyVarBinders env1 ex_tvs'
              req_theta  = tidyTypes env2 req_theta'
              prov_theta = tidyTypes env2 prov_theta'
              arg_tys    = tidyTypes env2 arg_tys'
              pat_ty     = tidyType  env2 pat_ty'
 
-          -- We need to update the univ and ex binders after zonking.
-          -- But zonking may have defaulted some erstwhile binders,
-          -- so we need to make sure the tyvars and tybinders remain
-          -- lined up
-       ; let update_binders :: [TyVar] -> [TcTyBinder] -> [TyBinder]
-             update_binders [] _ = []
-             update_binders all_tvs@(tv:tvs) (bndr:bndrs)
-               | tv == bndr_var
-               = mkNamedBinder (binderVisibility bndr) tv : update_binders tvs bndrs
-               | otherwise
-               = update_binders all_tvs bndrs
-               where
-                 bndr_var = binderVar "tc_patsyn_finish" bndr
-             update_binders tvs _ = pprPanic "tc_patsyn_finish" (ppr lname $$ ppr tvs)
-
-             univ_bndrs' = update_binders univ_tvs univ_bndrs
-             ex_bndrs'   = update_binders ex_tvs   ex_bndrs
-
        ; traceTc "tc_patsyn_finish {" $
            ppr (unLoc lname) $$ ppr (unLoc lpat') $$
-           ppr (univ_tvs, univ_bndrs', req_theta, req_ev_binds, req_dicts) $$
-           ppr (ex_tvs, ex_bndrs', prov_theta, prov_dicts) $$
+           ppr (univ_tvs, req_theta, req_ev_binds, req_dicts) $$
+           ppr (ex_tvs, prov_theta, prov_dicts) $$
            ppr args $$
            ppr arg_tys $$
            ppr pat_ty
 
        -- Make the 'matcher'
        ; (matcher_id, matcher_bind) <- tcPatSynMatcher lname lpat'
-                                         (univ_tvs, req_theta, req_ev_binds, req_dicts)
-                                         (ex_tvs, ex_tys, prov_theta, prov_dicts)
+                                         (map binderVar univ_tvs, req_theta, req_ev_binds, req_dicts)
+                                         (map binderVar ex_tvs, ex_tys, prov_theta, prov_dicts)
                                          (args, arg_tys)
                                          pat_ty
 
 
        -- Make the 'builder'
        ; builder_id <- mkPatSynBuilderId dir lname
-                                         univ_bndrs' req_theta
-                                         ex_bndrs'   prov_theta
+                                         univ_tvs req_theta
+                                         ex_tvs   prov_theta
                                          arg_tys pat_ty
 
          -- TODO: Make this have the proper information
@@ -360,11 +341,10 @@ tc_patsyn_finish lname dir is_infix lpat'
                                             , flSelector = name }
              field_labels' = map mkFieldLabel field_labels
 
-
        -- Make the PatSyn itself
        ; let patSyn = mkPatSyn (unLoc lname) is_infix
-                        (univ_tvs, univ_bndrs', req_theta)
-                        (ex_tvs, ex_bndrs', prov_theta)
+                        (univ_tvs, req_theta)
+                        (ex_tvs, prov_theta)
                         arg_tys
                         pat_ty
                         matcher_id builder_id
@@ -378,6 +358,14 @@ tc_patsyn_finish lname dir is_infix lpat'
 
        ; traceTc "tc_patsyn_finish }" empty
        ; return (matcher_bind, tcg_env) }
+  where
+    -- This is a bit of an odd functions; why does it not occur elsewhere
+    zonk_qtv :: TcTyVarBinder -> TcM (Maybe TcTyVarBinder)
+    zonk_qtv (TvBndr tv vis)
+      = do { mb_tv' <- zonkQuantifiedTyVar False tv
+                    -- ToDo: The False means that we behave here as if
+                    -- -XPolyKinds was always on, which isn't right.
+           ; return (fmap (\tv' -> TvBndr tv' vis) mb_tv') }
 
 {-
 ************************************************************************
@@ -496,8 +484,8 @@ isUnidirectional ExplicitBidirectional{} = False
 -}
 
 mkPatSynBuilderId :: HsPatSynDir a -> Located Name
-                  -> [TyBinder] -> ThetaType
-                  -> [TyBinder] -> ThetaType
+                  -> [TyVarBinder] -> ThetaType
+                  -> [TyVarBinder] -> ThetaType
                   -> [Type] -> Type
                   -> TcM (Maybe (Id, Bool))
 mkPatSynBuilderId dir (L _ name)
index 378f17a..9d3bd99 100644 (file)
@@ -53,6 +53,7 @@ import TcExpr
 import TcRnMonad
 import TcEvidence
 import PprTyThing( pprTyThing )
+import MkIface( tyThingToIfaceDecl )
 import Coercion( pprCoAxiom )
 import CoreFVs( orphNamesOfFamInst )
 import FamInst
@@ -69,7 +70,6 @@ import TcInstDcls
 import TcIface
 import TcMType
 import TcType
-import MkIface
 import TcSimplify
 import TcTyClsDecls
 import TcTypeable ( mkTypeableBinds )
@@ -2011,7 +2011,7 @@ tcRnExpr hsc_env rdr_expr
     -- Ignore the dictionary bindings
     _ <- simplifyInteractive (andWC stWC lie_top) ;
 
-    let { all_expr_ty = mkInvForAllTys qtvs (mkPiTypes dicts res_ty) } ;
+    let { all_expr_ty = mkInvForAllTys qtvs (mkLamTypes dicts res_ty) } ;
     ty <- zonkTcType all_expr_ty ;
 
     -- We normalise type families, so that the type of an expression is the
@@ -2484,10 +2484,13 @@ ppr_sigs ids
 
 ppr_tydecls :: [TyCon] -> SDoc
 ppr_tydecls tycons
-        -- Print type constructor info; sort by OccName
-  = vcat (map ppr_tycon (sortBy (comparing getOccName) tycons))
-  where
-    ppr_tycon tycon = vcat [ ppr (tyThingToIfaceDecl (ATyCon tycon)) ]
+  -- Print type constructor info for debug purposes
+  -- Sort by OccName to reduce unnecessary changes
+  = vcat [ ppr (tyThingToIfaceDecl (ATyCon tc))
+         | tc <- sortBy (comparing getOccName) tycons ]
+    -- The Outputable instance for IfaceDecl uses
+    -- showAll, which is what we want here, whereas
+    -- pprTyThing uses ShowSome.
 
 {-
 ********************************************************************************
index a737067..9ebb1d5 100644 (file)
@@ -918,7 +918,7 @@ data PromotionErr
   | NoTypeInTypeDC   -- -XTypeInType not enabled (for a datacon)
 
 instance Outputable TcTyThing where     -- Debugging only
-   ppr (AGlobal g)      = pprTyThing g
+   ppr (AGlobal g)      = ppr g
    ppr elt@(ATcId {})   = text "Identifier" <>
                           brackets (ppr (tct_id elt) <> dcolon
                                  <> ppr (varType (tct_id elt)) <> comma
index 7354139..75506b9 100644 (file)
@@ -3101,8 +3101,8 @@ See TcSMonad.deferTcSForAllEq
 deferTcSForAllEq :: Role -- Nominal or Representational
                  -> CtLoc  -- Original wanted equality flavor
                  -> [Coercion]        -- among the kinds of the binders
-                 -> ([TyBinder],TcType)   -- ForAll tvs1 body1
-                 -> ([TyBinder],TcType)   -- ForAll tvs2 body2
+                 -> ([TyVarBinder],TcType)   -- ForAll tvs1 body1
+                 -> ([TyVarBinder],TcType)   -- ForAll tvs2 body2
                  -> TcS Coercion
 deferTcSForAllEq role loc kind_cos (bndrs1,body1) (bndrs2,body2)
  = do { let tvs1'  = zipWithEqual "deferTcSForAllEq"
@@ -3132,5 +3132,5 @@ deferTcSForAllEq role loc kind_cos (bndrs1,body1) (bndrs2,body2)
       ; let cobndrs    = zip skol_tvs kind_cos
       ; return $ mkForAllCos cobndrs hole_co }
    where
-     tvs1 = map (binderVar "deferTcSForAllEq") bndrs1
-     tvs2 = map (binderVar "deferTcSForAllEq") bndrs2
+     tvs1 = map binderVar bndrs1
+     tvs2 = map binderVar bndrs2
index 8bccc35..62f4db8 100644 (file)
@@ -393,8 +393,8 @@ tcPatSynSig name sig_ty
               , text "prov" <+> ppr prov
               , text "body_ty" <+> ppr body_ty ]
        ; return (TPSI { patsig_name = name
-                      , patsig_implicit_bndrs = mkNamedBinders Invisible kvs ++
-                                                mkNamedBinders Specified implicit_tvs
+                      , patsig_implicit_bndrs = mkTyVarBinders Invisible kvs ++
+                                                mkTyVarBinders Specified implicit_tvs
                       , patsig_univ_bndrs     = univ_tvs
                       , patsig_req            = req
                       , patsig_ex_bndrs       = ex_tvs
index 828cb95..4614b70 100644 (file)
@@ -1612,12 +1612,12 @@ reifyFamilyInstance is_poly_tvs inst@(FamInst { fi_flavor = flavor
 ------------------------------
 reifyType :: TyCoRep.Type -> TcM TH.Type
 -- Monadic only because of failure
-reifyType ty@(ForAllTy (Named _ _) _)        = reify_for_all ty
+reifyType ty@(ForAllTy {})  = reify_for_all ty
 reifyType (LitTy t)         = do { r <- reifyTyLit t; return (TH.LitT r) }
 reifyType (TyVarTy tv)      = return (TH.VarT (reifyName tv))
 reifyType (TyConApp tc tys) = reify_tc_app tc tys   -- Do not expand type synonyms here
 reifyType (AppTy t1 t2)     = do { [r1,r2] <- reifyTypes [t1,t2] ; return (r1 `TH.AppT` r2) }
-reifyType ty@(ForAllTy (Anon t1) t2)
+reifyType ty@(FunTy t1 t2)
   | isPredTy t1 = reify_for_all ty  -- Types like ((?x::Int) => Char -> Char)
   | otherwise   = do { [r1,r2] <- reifyTypes [t1,t2] ; return (TH.ArrowT `TH.AppT` r1 `TH.AppT` r2) }
 reifyType ty@(CastTy {})    = noTH (sLit "kind casts") (ppr ty)
@@ -1663,6 +1663,7 @@ reifyKind  ki
     reifyNonArrowKind k | isLiftedTypeKind k = return TH.StarT
                         | isConstraintKind k = return TH.ConstraintT
     reifyNonArrowKind (TyVarTy v)            = return (TH.VarT (reifyName v))
+    reifyNonArrowKind (FunTy _ k)            = reifyKind k
     reifyNonArrowKind (ForAllTy _ k)         = reifyKind k
     reifyNonArrowKind (TyConApp kc kis)      = reify_kc_app kc kis
     reifyNonArrowKind (AppTy k1 k2)          = do { k1' <- reifyKind k1
@@ -1780,7 +1781,7 @@ reify_tc_app tc tys
         isEmptyVarSet $
         filterVarSet isTyVar $
         tyCoVarsOfType $
-        mkForAllTys (dropList tys tc_binders) tc_res_kind
+        mkPiTys (dropList tys tc_binders) tc_res_kind
 
 reifyPred :: TyCoRep.PredType -> TcM TH.Pred
 reifyPred ty
index 7f0023e..f8308e8 100644 (file)
@@ -351,7 +351,7 @@ kcTyClGroup decls
                  kc_binders  = tyConBinders tc
                  kc_res_kind = tyConResKind tc
                  kc_tyvars   = tyConTyVars tc
-           ; kvs <- kindGeneralize (mkForAllTys kc_binders kc_res_kind)
+           ; kvs <- kindGeneralize (mkPiTys kc_binders kc_res_kind)
            ; (kc_binders', kc_res_kind') <- zonkTcKindToKind kc_binders kc_res_kind
            ; kc_tyvars <- mapM zonkTcTyVarToTyVar kc_tyvars
 
@@ -362,7 +362,7 @@ kcTyClGroup decls
                   , ppr kc_tyvars, ppr (tcTyConScopedTyVars tc)]
 
            ; return (mkTcTyCon name (kvs ++ kc_tyvars)
-                               (mkNamedBinders Invisible kvs ++ kc_binders')
+                               (mkNamedTyBinders Invisible kvs ++ kc_binders')
                                kc_res_kind'
                                (mightBeUnsaturatedTyCon tc)
                                (tcTyConScopedTyVars tc)) }
@@ -1491,9 +1491,8 @@ tcConDecl new_or_data rep_tycon tmpl_tvs tmpl_bndrs res_tmpl
        -- Can't print univ_tvs, arg_tys etc, because we are inside the knot here
        ; traceTc "tcConDecl 2" (ppr name $$ ppr field_lbls)
        ; let
-           ex_tvs     = qkvs ++ user_qtvs
-           ex_binders = mkNamedBinders Invisible qkvs ++
-                        mkNamedBinders Specified user_qtvs
+           ex_tvs = mkTyVarBinders Invisible qkvs ++
+                    mkTyVarBinders Specified user_qtvs
            buildOneDataCon (L _ name) = do
              { is_infix <- tcConIsInfixH98 name hs_details
              ; rep_nm   <- newTyConRepName name
@@ -1501,7 +1500,7 @@ tcConDecl new_or_data rep_tycon tmpl_tvs tmpl_bndrs res_tmpl
              ; buildDataCon fam_envs name is_infix rep_nm
                             stricts Nothing field_lbls
                             tmpl_tvs tmpl_bndrs
-                            ex_tvs ex_binders
+                            ex_tvs
                             [{- no eq_preds -}] ctxt arg_tys
                             res_tmpl rep_tycon
                   -- NB:  we put data_tc, the type constructor gotten from the
@@ -1538,8 +1537,8 @@ tcConDecl _new_or_data rep_tycon tmpl_tvs _tmpl_bndrs res_tmpl
              -- See Note [Checking GADT return types]
 
              -- See Note [Wrong visibility for GADTs]
-             univ_bndrs = mkNamedBinders Specified univ_tvs
-             ex_bndrs   = mkNamedBinders Specified ex_tvs
+             univ_bndrs = mkNamedTyBinders Specified univ_tvs
+             ex_bndrs   = mkTyVarBinders Specified ex_tvs
 
        ; fam_envs <- tcGetFamInstEnvs
 
@@ -1553,7 +1552,7 @@ tcConDecl _new_or_data rep_tycon tmpl_tvs _tmpl_bndrs res_tmpl
              ; buildDataCon fam_envs name is_infix
                             rep_nm
                             stricts Nothing field_lbls
-                            univ_tvs univ_bndrs ex_tvs ex_bndrs eq_preds
+                            univ_tvs univ_bndrs ex_bndrs eq_preds
                             (substTys arg_subst ctxt)
                             (substTys arg_subst arg_tys)
                             (substTy  arg_subst res_ty')
@@ -2608,11 +2607,11 @@ checkValidRoles tc
       =  check_ty_roles env role    ty1
       >> check_ty_roles env Nominal ty2
 
-    check_ty_roles env role (ForAllTy (Anon ty1) ty2)
+    check_ty_roles env role (FunTy ty1 ty2)
       =  check_ty_roles env role ty1
       >> check_ty_roles env role ty2
 
-    check_ty_roles env role (ForAllTy (Named tv _) ty)
+    check_ty_roles env role (ForAllTy (TvBndr tv _) ty)
       =  check_ty_roles env Nominal (tyVarKind tv)
       >> check_ty_roles (extendVarEnv env tv Nominal) role ty
 
index 7529f15..025afc9 100644 (file)
@@ -29,7 +29,7 @@ import TcRnMonad
 import TcEnv
 import TcBinds( tcRecSelBinds )
 import RnEnv( RoleAnnotEnv, lookupRoleAnnot )
-import TyCoRep( Type(..), TyBinder(..), delBinderVarFV )
+import TyCoRep( Type(..) )
 import TcType
 import TysWiredIn( unitTy )
 import MkCore( rEC_SEL_ERROR_ID )
@@ -47,7 +47,8 @@ import Id
 import IdInfo
 import VarEnv
 import VarSet
-import NameSet
+import NameSet  ( NameSet, unitNameSet, emptyNameSet, unionNameSet
+                , extendNameSet, mkNameSet, nameSetElems, elemNameSet )
 import Coercion ( ltRole )
 import Digraph
 import BasicTypes
@@ -608,7 +609,7 @@ initialRoleEnv1 is_boot annots_env tc
   | otherwise             = pprPanic "initialRoleEnv1" (ppr tc)
   where name         = tyConName tc
         bndrs        = tyConBinders tc
-        visflags     = map binderVisibility $ take (tyConArity tc) bndrs
+        visflags     = map tyBinderVisibility $ take (tyConArity tc) bndrs
         num_exps     = count (== Visible) visflags
 
           -- if the number of annotations in the role annotation decl
@@ -690,11 +691,11 @@ irType = go
     go lcls (AppTy t1 t2)      = go lcls t1 >> markNominal lcls t2
     go lcls (TyConApp tc tys)  = do { roles <- lookupRolesX tc
                                     ; zipWithM_ (go_app lcls) roles tys }
-    go lcls (ForAllTy (Named tv _) ty)
-      = let lcls' = extendVarSet lcls tv in
-        markNominal lcls (tyVarKind tv) >> go lcls' ty
-    go lcls (ForAllTy (Anon arg) res)
-      = go lcls arg >> go lcls res
+    go lcls (ForAllTy tvb ty)  = do { let tv = binderVar tvb
+                                          lcls' = extendVarSet lcls tv
+                                    ; markNominal lcls (tyVarKind tv)
+                                    ; go lcls' ty }
+    go lcls (FunTy arg res)    = go lcls arg >> go lcls res
     go _    (LitTy {})         = return ()
       -- See Note [Coercions in role inference]
     go lcls (CastTy ty _)      = go lcls ty
@@ -727,15 +728,15 @@ markNominal lcls ty = let nvars = fvVarList (FV.delFVs lcls $ get_ty_vars ty) in
      -- get_ty_vars gets all the tyvars (no covars!) from a type *without*
      -- recurring into coercions. Recall: coercions are totally ignored during
      -- role inference. See [Coercions in role inference]
-    get_ty_vars (TyVarTy tv)     = FV.unitFV tv
-    get_ty_vars (AppTy t1 t2)    = get_ty_vars t1 `unionFV` get_ty_vars t2
-    get_ty_vars (TyConApp _ tys) = mapUnionFV get_ty_vars tys
-    get_ty_vars (ForAllTy bndr ty)
-      = delBinderVarFV bndr (get_ty_vars ty)
-        `unionFV` (tyCoFVsOfType $ binderType bndr)
-    get_ty_vars (LitTy {})       = emptyFV
-    get_ty_vars (CastTy ty _)    = get_ty_vars ty
-    get_ty_vars (CoercionTy _)   = emptyFV
+    get_ty_vars :: Type -> FV
+    get_ty_vars (TyVarTy tv)      = unitFV tv
+    get_ty_vars (AppTy t1 t2)     = get_ty_vars t1 `unionFV` get_ty_vars t2
+    get_ty_vars (FunTy t1 t2)     = get_ty_vars t1 `unionFV` get_ty_vars t2
+    get_ty_vars (TyConApp _ tys)  = mapUnionFV get_ty_vars tys
+    get_ty_vars (ForAllTy tvb ty) = tyCoFVsBndr tvb (get_ty_vars ty)
+    get_ty_vars (LitTy {})        = emptyFV
+    get_ty_vars (CastTy ty _)     = get_ty_vars ty
+    get_ty_vars (CoercionTy _)    = emptyFV
 
 -- like lookupRoles, but with Nominal tags at the end for oversaturated TyConApps
 lookupRolesX :: TyCon -> RoleM [Role]
index 286ad63..a307851 100644 (file)
@@ -22,7 +22,7 @@ module TcType (
   -- Types
   TcType, TcSigmaType, TcRhoType, TcTauType, TcPredType, TcThetaType,
   TcTyVar, TcTyVarSet, TcDTyVarSet, TcTyCoVarSet, TcDTyCoVarSet,
-  TcKind, TcCoVar, TcTyCoVar, TcTyBinder, TcTyCon,
+  TcKind, TcCoVar, TcTyCoVar, TcTyBinder, TcTyVarBinder, TcTyCon,
 
   ExpType(..), ExpSigmaType, ExpRhoType, mkCheckExpType,
 
@@ -58,7 +58,7 @@ module TcType (
   -- These are important because they do not look through newtypes
   getTyVar,
   tcSplitForAllTy_maybe,
-  tcSplitForAllTys, tcSplitPiTys, tcSplitNamedPiTys,
+  tcSplitForAllTys, tcSplitPiTys, tcSplitForAllTyVarBndrs,
   tcSplitPhiTy, tcSplitPredFunTy_maybe,
   tcSplitFunTy_maybe, tcSplitFunTys, tcFunArgTy, tcFunResultTy, tcSplitFunTysN,
   tcSplitTyConApp, tcSplitTyConApp_maybe, tcRepSplitTyConApp_maybe,
@@ -130,7 +130,7 @@ module TcType (
   -- Rexported from Type
   Type, PredType, ThetaType, TyBinder, VisibilityFlag(..),
 
-  mkForAllTy, mkForAllTys, mkInvForAllTys, mkSpecForAllTys, mkNamedForAllTy,
+  mkForAllTy, mkForAllTys, mkInvForAllTys, mkSpecForAllTys, mkInvForAllTy,
   mkFunTy, mkFunTys,
   mkTyConApp, mkAppTy, mkAppTys,
   mkTyConTy, mkTyVarTy,
@@ -270,8 +270,10 @@ type TcTyCoVar = Var    -- Either a TcTyVar or a CoVar
         --      forall a. T
         -- a cannot occur inside a MutTyVar in T; that is,
         -- T is "flattened" before quantifying over a
-type TcTyBinder = TyBinder
-type TcTyCon = TyCon   -- these can be the TcTyCon constructor
+
+type TcTyVarBinder = TyVarBinder
+type TcTyBinder    = TyBinder
+type TcTyCon       = TyCon   -- these can be the TcTyCon constructor
 
 -- These types do not have boxy type variables in them
 type TcPredType     = PredType
@@ -719,6 +721,7 @@ tcTyFamInsts (TyConApp tc tys)
 tcTyFamInsts (LitTy {})         = []
 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
 tcTyFamInsts (CastTy ty _)      = tcTyFamInsts ty
 tcTyFamInsts (CoercionTy _)     = []  -- don't count tyfams in coercions,
@@ -771,6 +774,7 @@ exactTyCoVarsOfType ty
     go (TyConApp _ tys)     = exactTyCoVarsOfTypes tys
     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 (binderType bndr)
     go (CastTy ty co)       = go ty `unionVarSet` goCo co
     go (CoercionTy co)      = goCo co
@@ -819,8 +823,8 @@ allBoundVariables ty = fvVarSet $ go ty
     go (TyVarTy tv)     = go (tyVarKind tv)
     go (TyConApp _ tys) = mapUnionFV go tys
     go (AppTy t1 t2)    = go t1 `unionFV` go t2
-    go (ForAllTy (Anon t1) t2) = go t1 `unionFV` go t2
-    go (ForAllTy (Named tv _) t2) = FV.unitFV tv `unionFV`
+    go (FunTy t1 t2)    = go t1 `unionFV` go t2
+    go (ForAllTy (TvBndr tv _) t2) = FV.unitFV tv `unionFV`
                                     go (tyVarKind tv) `unionFV` go t2
     go (LitTy {})       = emptyFV
     go (CastTy ty _)    = go ty
@@ -932,15 +936,15 @@ splitDepVarsOfTypes = foldMap splitDepVarsOfType
 splitDepVarsOfType :: Type -> TcDepVars
 splitDepVarsOfType = go
   where
-    go (TyVarTy tv)              = DV { dv_kvs =tyCoVarsOfTypeDSet $ tyVarKind tv
-                                      , dv_tvs = unitDVarSet tv }
-    go (AppTy t1 t2)             = go t1 `mappend` go t2
-    go (TyConApp _ tys)          = foldMap go tys
-    go (ForAllTy (Anon arg) res) = go arg `mappend` go res
-    go (LitTy {})                = mempty
-    go (CastTy ty co)            = go ty `mappend` go_co co
-    go (CoercionTy co)           = go_co co
-    go (ForAllTy (Named tv _) ty)
+    go (TyVarTy tv)     = DV { dv_kvs =tyCoVarsOfTypeDSet $ tyVarKind tv
+                             , dv_tvs = unitDVarSet tv }
+    go (AppTy t1 t2)    = go t1 `mappend` go t2
+    go (TyConApp _ tys) = foldMap go tys
+    go (FunTy arg res)  = go arg `mappend` go res
+    go (LitTy {})       = mempty
+    go (CastTy ty co)   = go ty `mappend` go_co co
+    go (CoercionTy co)  = go_co co
+    go (ForAllTy (TvBndr tv _) ty)
       = let DV { dv_kvs = kvs, dv_tvs = tvs } = go ty in
         DV { dv_kvs = (kvs `delDVarSet` tv)
                       `extendDVarSetList` tyCoVarsOfTypeList (tyVarKind tv)
@@ -1115,18 +1119,16 @@ isRuntimeUnkSkol x
 ************************************************************************
 -}
 
-mkSigmaTy :: [TyBinder] -> [PredType] -> Type -> Type
+mkSigmaTy :: [TyVarBinder] -> [PredType] -> Type -> Type
 mkSigmaTy bndrs theta tau = mkForAllTys bndrs (mkPhiTy theta tau)
 
 mkInvSigmaTy :: [TyVar] -> [PredType] -> Type -> Type
-mkInvSigmaTy tyvars
-  = mkSigmaTy (mkNamedBinders Invisible tyvars)
+mkInvSigmaTy tyvars ty = mkSigmaTy (mkTyVarBinders Invisible tyvars) 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
-  = mkSigmaTy (mkNamedBinders Specified tyvars)
+mkSpecSigmaTy tyvars ty = mkSigmaTy (mkTyVarBinders Specified tyvars) ty
 
 mkPhiTy :: [PredType] -> Type -> Type
 mkPhiTy = mkFunTys
@@ -1138,7 +1140,7 @@ isTauTy (TyVarTy _)           = True
 isTauTy (LitTy {})            = True
 isTauTy (TyConApp tc tys)     = all isTauTy tys && isTauTyCon tc
 isTauTy (AppTy a b)           = isTauTy a && isTauTy b
-isTauTy (ForAllTy (Anon a) b) = isTauTy a && isTauTy b
+isTauTy (FunTy a b)           = isTauTy a && isTauTy b
 isTauTy (ForAllTy {})         = False
 isTauTy (CastTy _ _)          = False
 isTauTy (CoercionTy _)        = False
@@ -1157,8 +1159,8 @@ getDFunTyKey (TyVarTy tv)            = getOccName tv
 getDFunTyKey (TyConApp tc _)         = getOccName tc
 getDFunTyKey (LitTy x)               = getDFunTyLitKey x
 getDFunTyKey (AppTy fun _)           = getDFunTyKey fun
-getDFunTyKey (ForAllTy (Anon _) _)   = getOccName funTyCon
-getDFunTyKey (ForAllTy (Named {}) t) = getDFunTyKey t
+getDFunTyKey (FunTy _ _)             = getOccName funTyCon
+getDFunTyKey (ForAllTy _ t)          = getDFunTyKey t
 getDFunTyKey (CastTy ty _)           = getDFunTyKey ty
 getDFunTyKey t@(CoercionTy _)        = pprPanic "getDFunTyKey" (ppr t)
 
@@ -1216,7 +1218,7 @@ variables.  It's up to you to make sure this doesn't matter.
 tcSplitPiTys :: Type -> ([TyBinder], Type)
 tcSplitPiTys = splitPiTys
 
-tcSplitForAllTy_maybe :: Type -> Maybe (TyBinder, Type)
+tcSplitForAllTy_maybe :: Type -> Maybe (TyVarBinder, Type)
 tcSplitForAllTy_maybe ty | Just ty' <- coreView ty = tcSplitForAllTy_maybe ty'
 tcSplitForAllTy_maybe (ForAllTy tv ty) = Just (tv, ty)
 tcSplitForAllTy_maybe _                = Nothing
@@ -1227,20 +1229,20 @@ tcSplitForAllTys :: Type -> ([TyVar], Type)
 tcSplitForAllTys = splitForAllTys
 
 -- | Like 'tcSplitForAllTys', but splits off only named binders.
-tcSplitNamedPiTys :: Type -> ([TyBinder], Type)
-tcSplitNamedPiTys = splitNamedPiTys
+tcSplitForAllTyVarBndrs :: Type -> ([TyVarBinder], Type)
+tcSplitForAllTyVarBndrs = splitForAllTyVarBndrs
 
 -- | Is this a ForAllTy with a named binder?
 tcIsForAllTy :: Type -> Bool
 tcIsForAllTy ty | Just ty' <- coreView ty = tcIsForAllTy ty'
-tcIsForAllTy (ForAllTy (Named {}) _) = True
-tcIsForAllTy _                       = False
+tcIsForAllTy (ForAllTy {}) = True
+tcIsForAllTy _             = False
 
 tcSplitPredFunTy_maybe :: Type -> Maybe (PredType, Type)
 -- Split off the first predicate argument from a type
 tcSplitPredFunTy_maybe ty
   | Just ty' <- coreView ty = tcSplitPredFunTy_maybe ty'
-tcSplitPredFunTy_maybe (ForAllTy (Anon arg) res)
+tcSplitPredFunTy_maybe (FunTy arg res)
   | isPredTy arg = Just (arg, res)
 tcSplitPredFunTy_maybe _
   = Nothing
@@ -1298,9 +1300,9 @@ tcSplitTyConApp_maybe ty | Just ty' <- coreView ty = tcSplitTyConApp_maybe ty'
 tcSplitTyConApp_maybe ty                           = tcRepSplitTyConApp_maybe ty
 
 tcRepSplitTyConApp_maybe :: Type -> Maybe (TyCon, [Type])
-tcRepSplitTyConApp_maybe (TyConApp tc tys)          = Just (tc, tys)
-tcRepSplitTyConApp_maybe (ForAllTy (Anon arg) res)  = Just (funTyCon, [arg,res])
-tcRepSplitTyConApp_maybe _                          = Nothing
+tcRepSplitTyConApp_maybe (TyConApp tc tys) = Just (tc, tys)
+tcRepSplitTyConApp_maybe (FunTy arg res)   = Just (funTyCon, [arg,res])
+tcRepSplitTyConApp_maybe _                 = Nothing
 
 
 -----------------------
@@ -1313,8 +1315,7 @@ tcSplitFunTys ty = case tcSplitFunTy_maybe ty of
 
 tcSplitFunTy_maybe :: Type -> Maybe (Type, Type)
 tcSplitFunTy_maybe ty | Just ty' <- coreView ty         = tcSplitFunTy_maybe ty'
-tcSplitFunTy_maybe (ForAllTy (Anon arg) res)
-                                   | not (isPredTy arg) = Just (arg, res)
+tcSplitFunTy_maybe (FunTy arg res) | not (isPredTy arg) = Just (arg, res)
 tcSplitFunTy_maybe _                                    = Nothing
         -- Note the typeKind guard
         -- Consider     (?x::Int) => Bool
@@ -1480,12 +1481,12 @@ tc_eq_type view_fun orig_ty1 orig_ty2 = go Visible orig_env orig_ty1 orig_ty2
     go vis _   (LitTy lit1)        (LitTy lit2)
       = check vis $ lit1 == lit2
 
-    go vis env (ForAllTy (Named tv1 vis1) ty1)
-               (ForAllTy (Named tv2 vis2) ty2)
+    go vis env (ForAllTy (TvBndr tv1 vis1) ty1)
+               (ForAllTy (TvBndr tv2 vis2) ty2)
       = go vis1 env (tyVarKind tv1) (tyVarKind tv2)
           <!> go vis (rnBndr2 env tv1 tv2) ty1 ty2
           <!> check vis (vis1 == vis2)
-    go vis env (ForAllTy (Anon arg1) res1) (ForAllTy (Anon arg2) res2)
+    go vis env (FunTy arg1 res1) (FunTy arg2 res2)
       = go vis env arg1 arg2 <!> go vis env res1 res2
 
       -- See Note [Equality on AppTys] in Type
@@ -1513,7 +1514,7 @@ tc_eq_type view_fun orig_ty1 orig_ty2 = go Visible orig_env orig_ty1 orig_ty2
        -- be oversaturated
       where
         bndrs = tyConBinders tc
-        viss  = map binderVisibility bndrs
+        viss  = map tyBinderVisibility bndrs
     tc_vis vis _ = repeat vis   -- if we're not in a visible context, our args
                                 -- aren't either
 
@@ -1609,9 +1610,9 @@ occurCheckExpand dflags tv ty
     fast_check (TyVarTy tv')       = tv /= tv' && fast_check (tyVarKind tv')
     fast_check (TyConApp tc tys)   = all fast_check tys
                                      && (isTauTyCon tc || impredicative)
-    fast_check (ForAllTy (Anon a) r) = fast_check a && fast_check r
+    fast_check (FunTy a r)         = fast_check a && fast_check r
     fast_check (AppTy fun arg)     = fast_check fun && fast_check arg
-    fast_check (ForAllTy (Named tv' _) ty)
+    fast_check (ForAllTy (TvBndr tv' _) ty)
                                    = impredicative
                                    && fast_check (tyVarKind tv')
                                    && (tv == tv' || fast_check ty)
@@ -1634,18 +1635,17 @@ occurCheckExpand dflags tv ty
     go env (AppTy ty1 ty2) = do { ty1' <- go env ty1
                                 ; ty2' <- go env ty2
                                 ; return (mkAppTy ty1' ty2') }
-    go env (ForAllTy (Anon ty1) ty2)
-                           = do { ty1' <- go env ty1
+    go env (FunTy ty1 ty2) = do { ty1' <- go env ty1
                                 ; ty2' <- go env ty2
                                 ; return (mkFunTy ty1' ty2') }
-    go env ty@(ForAllTy (Named tv' vis) body_ty)
+    go env ty@(ForAllTy (TvBndr tv' vis) body_ty)
        | not impredicative = OC_Forall
        | tv == tv'         = return ty
        | otherwise         = do { ki' <- go env ki
                                 ; let tv'' = setTyVarKind tv' ki'
                                       env' = extendVarEnv env tv' tv''
                                 ; body' <- go env' body_ty
-                                ; return (ForAllTy (Named tv'' vis) body') }
+                                ; return (ForAllTy (TvBndr tv'' vis) body') }
       where ki = tyVarKind tv'
 
     -- For a type constructor application, first try expanding away the
@@ -1998,15 +1998,15 @@ isSigmaTy :: TcType -> Bool
 -- *necessarily* have any foralls.  E.g
 --        f :: (?x::Int) => Int -> Int
 isSigmaTy ty | Just ty' <- coreView ty = isSigmaTy ty'
-isSigmaTy (ForAllTy (Named {}) _) = True
-isSigmaTy (ForAllTy (Anon a) _)   = isPredTy a
-isSigmaTy _                       = False
+isSigmaTy (ForAllTy {}) = True
+isSigmaTy (FunTy a _)   = isPredTy a
+isSigmaTy _             = False
 
 isRhoTy :: TcType -> Bool   -- True of TcRhoTypes; see Note [TcRhoType]
 isRhoTy ty | Just ty' <- coreView ty = isRhoTy ty'
-isRhoTy (ForAllTy (Named {}) _) = False
-isRhoTy (ForAllTy (Anon a) r)   = not (isPredTy a) && isRhoTy r
-isRhoTy _                       = True
+isRhoTy (ForAllTy {}) = False
+isRhoTy (FunTy a r)   = not (isPredTy a) && isRhoTy r
+isRhoTy _             = True
 
 -- | Like 'isRhoTy', but also says 'True' for 'Infer' types
 isRhoExpTy :: ExpType -> Bool
@@ -2017,9 +2017,9 @@ isOverloadedTy :: Type -> Bool
 -- Yes for a type of a function that might require evidence-passing
 -- Used only by bindLocalMethods
 isOverloadedTy ty | Just ty' <- coreView ty = isOverloadedTy ty'
-isOverloadedTy (ForAllTy (Named {}) ty) = isOverloadedTy ty
-isOverloadedTy (ForAllTy (Anon a) _)    = isPredTy a
-isOverloadedTy _                        = False
+isOverloadedTy (ForAllTy  ty) = isOverloadedTy ty
+isOverloadedTy (FunTy a _)      = isPredTy a
+isOverloadedTy _                = False
 
 isFloatTy, isDoubleTy, isIntegerTy, isIntTy, isWordTy, isBoolTy,
     isUnitTy, isCharTy, isAnyTy :: Type -> Bool
@@ -2082,6 +2082,7 @@ isTyVarExposed _  (LitTy {})      = False
 isTyVarExposed tv (AppTy fun arg) = isTyVarExposed tv fun
                                  || isTyVarExposed tv arg
 isTyVarExposed _  (ForAllTy {})   = False
+isTyVarExposed _  (FunTy {})      = False
 isTyVarExposed tv (CastTy ty _)   = isTyVarExposed tv ty
 isTyVarExposed _  (CoercionTy {}) = False
 
@@ -2098,9 +2099,9 @@ isTyVarUnderDatatype tv = go False
                                                       Representational
                                     in any (go under_dt') tys
     go _        (LitTy {}) = False
-    go _        (ForAllTy (Anon arg) res) = go True arg || go True res
+    go _        (FunTy arg res) = go True arg || go True res
     go under_dt (AppTy fun arg) = go under_dt fun || go under_dt arg
-    go under_dt (ForAllTy (Named tv' _) inner_ty)
+    go under_dt (ForAllTy (TvBndr tv' _) inner_ty)
       | tv' == tv = False
       | otherwise = go under_dt inner_ty
     go under_dt (CastTy ty _)   = go under_dt ty
@@ -2518,9 +2519,9 @@ sizeType = go
                                            -- expand to any arbitrary size
       | otherwise                = sizeTypes (filterOutInvisibleTypes tc tys) + 1
     go (LitTy {})                = 1
-    go (ForAllTy (Anon arg) res) = go arg + go res + 1
+    go (FunTy arg res)           = go arg + go res + 1
     go (AppTy fun arg)           = go fun + go arg
-    go (ForAllTy (Named tv vis) ty)
+    go (ForAllTy (TvBndr tv vis) ty)
         | Visible <- vis         = go (tyVarKind tv) + go ty + 1
         | otherwise              = go ty + 1
     go (CastTy ty _)             = go ty
index 5d84a46..3ca6aa3 100644 (file)
@@ -132,7 +132,7 @@ matchExpectedFunTys herald arity orig_ty thing_inside
     go acc_arg_tys n ty
       | Just ty' <- coreView ty = go acc_arg_tys n ty'
 
-    go acc_arg_tys n (ForAllTy (Anon arg_ty) res_ty)
+    go acc_arg_tys n (FunTy arg_ty res_ty)
       = ASSERT( not (isPredTy arg_ty) )
         do { (result, wrap_res) <- go (mkCheckExpType arg_ty : acc_arg_tys)
                                       (n-1) res_ty
@@ -258,7 +258,7 @@ matchActualFunTysPart herald ct_orig mb_thing arity orig_ty
     go n acc_args ty
       | Just ty' <- coreView ty = go n acc_args ty'
 
-    go n acc_args (ForAllTy (Anon arg_ty) res_ty)
+    go n acc_args (FunTy arg_ty res_ty)
       = ASSERT( not (isPredTy arg_ty) )
         do { (wrap_res, tys, ty_r) <- go (n-1) (arg_ty : acc_args) res_ty
            ; return ( mkWpFun idHsWrapper wrap_res arg_ty ty_r
@@ -739,7 +739,7 @@ tc_sub_type_ds eq_orig inst_orig ctxt ty_actual ty_expected
                  |  otherwise
                  -> inst_and_unify }
 
-    go (ForAllTy (Anon act_arg) act_res) (ForAllTy (Anon exp_arg) exp_res)
+    go (FunTy act_arg act_res) (FunTy exp_arg exp_res)
       | not (isPredTy act_arg)
       , not (isPredTy exp_arg)
       = -- See Note [Co/contra-variance of subsumption checking]
@@ -1147,7 +1147,7 @@ uType origin t_or_k orig_ty1 orig_ty2
            ; return (mkCoherenceRightCo co_tys co2) }
 
         -- Functions (or predicate functions) just check the two parts
-    go (ForAllTy (Anon fun1) arg1) (ForAllTy (Anon fun2) arg2)
+    go (FunTy fun1 arg1) (FunTy fun2 arg2)
       = do { co_l <- uType origin t_or_k fun1 fun2
            ; co_r <- uType origin t_or_k arg1 arg2
            ; return $ mkFunCo Nominal co_l co_r }
@@ -1459,7 +1459,8 @@ checkTauTvUpdate dflags origin t_or_k tv ty
     defer_me (TyConApp tc tys) = isTypeFamilyTyCon tc || any defer_me tys
                                  || not (impredicative || isTauTyCon tc)
     defer_me (ForAllTy bndr t) = defer_me (binderType bndr) || defer_me t
-                                 || (isNamedBinder bndr && not impredicative)
+                                 || not impredicative
+    defer_me (FunTy fun arg)   = defer_me fun || defer_me arg
     defer_me (AppTy fun arg)   = defer_me fun || defer_me arg
     defer_me (CastTy ty co)    = defer_me ty || defer_me_co co
     defer_me (CoercionTy co)   = defer_me_co co
@@ -1630,10 +1631,8 @@ matchExpectedFunKind num_args_remaining ty = go
                 Indirect fun_kind -> go fun_kind
                 Flexi ->             defer k }
 
-    go k@(ForAllTy (Anon arg) res)
-      = return (mkNomReflCo k, arg, res)
-
-    go other = defer other
+    go k@(FunTy arg res) = return (mkNomReflCo k, arg, res)
+    go other             = defer other
 
     defer k
       = do { arg_kind <- newMetaKindVar
index 679bf04..2c66f35 100644 (file)
@@ -503,7 +503,7 @@ check_type env ctxt rank ty
 
 check_type _ _ _ (TyVarTy _) = return ()
 
-check_type env ctxt rank (ForAllTy (Anon arg_ty) res_ty)
+check_type env ctxt rank (FunTy arg_ty res_ty)
   = do  { check_type env ctxt arg_rank arg_ty
         ; when (representationPolymorphismForbidden ctxt) $
           checkForRepresentationPolymorphism empty arg_ty
@@ -1117,13 +1117,13 @@ dropCasts :: Type -> Type
 -- To consider: drop only UnivCo(HoleProv) casts
 dropCasts (CastTy ty _)     = dropCasts ty
 dropCasts (AppTy t1 t2)     = mkAppTy (dropCasts t1) (dropCasts t2)
+dropCasts (FunTy t1 t2)     = mkFunTy (dropCasts t1) (dropCasts t2)
 dropCasts (TyConApp tc tys) = mkTyConApp tc (map dropCasts tys)
 dropCasts (ForAllTy b ty)   = ForAllTy (dropCastsB b) (dropCasts ty)
 dropCasts ty                = ty  -- LitTy, TyVarTy, CoercionTy
 
-dropCastsB :: TyBinder -> TyBinder
-dropCastsB (Anon ty) = Anon (dropCasts ty)
-dropCastsB b         = b   -- Don't bother in the kind of a forall
+dropCastsB :: TyVarBinder -> TyVarBinder
+dropCastsB b = b   -- Don't bother in the kind of a forall
 
 abstractClassKeys :: [Unique]
 abstractClassKeys = [ heqTyConKey
@@ -1872,9 +1872,10 @@ fvType (TyVarTy tv)          = [tv]
 fvType (TyConApp _ tys)      = fvTypes tys
 fvType (LitTy {})            = []
 fvType (AppTy fun arg)       = fvType fun ++ fvType arg
-fvType (ForAllTy bndr ty)
-  = fvType (binderType bndr) ++
-    caseBinder bndr (\tv -> filter (/= tv)) (const id) (fvType ty)
+fvType (FunTy arg res)       = fvType arg ++ fvType res
+fvType (ForAllTy (TvBndr tv _) ty)
+  = fvType (tyVarKind tv) ++
+    filter (/= tv) (fvType ty)
 fvType (CastTy ty co)        = fvType ty ++ fvCo co
 fvType (CoercionTy co)       = fvCo co
 
@@ -1913,10 +1914,8 @@ sizeType (TyVarTy {})      = 1
 sizeType (TyConApp _ tys)  = sizeTypes tys + 1
 sizeType (LitTy {})        = 1
 sizeType (AppTy fun arg)   = sizeType fun + sizeType arg
-sizeType (ForAllTy (Anon arg) res)
-                           = sizeType arg + sizeType res + 1
-sizeType (ForAllTy (Named {}) ty)
-                           = sizeType ty
+sizeType (FunTy arg res)   = sizeType arg + sizeType res + 1
+sizeType (ForAllTy _ ty)   = sizeType ty
 sizeType (CastTy ty _)     = sizeType ty
 sizeType (CoercionTy _)    = 1
 
index cc3912d..d392a66 100644 (file)
@@ -301,7 +301,7 @@ ppr_co_ax_branch ppr_rhs
                           , cab_rhs = rhs
                           , cab_loc = loc })
   = foldr1 (flip hangNotEmpty 2)
-        [ pprUserForAll (mkNamedBinders Invisible (tvs ++ cvs))
+        [ pprUserForAll (mkTyVarBinders Invisible (tvs ++ cvs))
         , pprTypeApp fam_tc lhs <+> equals <+> ppr_rhs fam_tc rhs
         , text "-- Defined" <+> pprLoc loc ]
   where
@@ -686,7 +686,7 @@ mkForAllCo :: TyVar -> Coercion -> Coercion -> Coercion
 mkForAllCo tv kind_co co
   | Refl r ty <- co
   , Refl {} <- kind_co
-  = Refl r (mkNamedForAllTy tv Invisible ty)
+  = Refl r (mkInvForAllTy tv ty)
   | otherwise
   = ForAllCo tv kind_co co
 
@@ -1517,9 +1517,8 @@ ty_co_subst lc role ty
                              liftCoSubstTyVar lc r tv
     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 (ForAllTy (Anon ty1) ty2)
-                           = mkFunCo r (go r ty1) (go r ty2)
-    go r (ForAllTy (Named v _) ty)
+    go r (FunTy ty1 ty2)   = mkFunCo r (go r ty1) (go r ty2)
+    go r (ForAllTy (TvBndr 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 )
@@ -1727,7 +1726,7 @@ coercionKind co = go co
             -- from Note [The substitution invariant]
             -- This is doing repeated substitutions and probably doesn't
             -- need to, see #11735
-        mkNamedForAllTy <$> Pair tv1 tv2 <*> pure Invisible <*> Pair ty1 ty2'
+        mkInvForAllTy <$> Pair tv1 tv2 <*> Pair ty1 ty2'
     go (CoVarCo cv)         = toPair $ coVarTypes cv
     go (AxiomInstCo ax ind cos)
       | CoAxBranch { cab_tvs = tvs, cab_cvs = cvs
@@ -1807,7 +1806,7 @@ coercionKindRole = go
             -- from Note [The substitution invariant]
             -- This is doing repeated substitutions and probably doesn't
             -- need to, see #11735
-        (mkNamedForAllTy <$> Pair tv1 tv2 <*> pure Invisible <*> Pair ty1 ty2', r)
+        (mkInvForAllTy <$> Pair tv1 tv2 <*> Pair ty1 ty2', r)
     go (CoVarCo cv) = (toPair $ coVarTypes cv, coVarRole cv)
     go co@(AxiomInstCo ax _ _) = (coercionKind co, coAxiomRole ax)
     go (UnivCo _ r ty1 ty2)  = (Pair ty1 ty2, r)
index 62906dd..52c1004 100644 (file)
@@ -1305,16 +1305,16 @@ normalise_type
       = do { (co,  nty1) <- go ty1
            ; (arg, nty2) <- withRole Nominal $ go ty2
            ; return (mkAppCo co arg, mkAppTy nty1 nty2) }
-    go (ForAllTy (Anon ty1) ty2)
+    go (FunTy ty1 ty2)
       = do { (co1, nty1) <- go ty1
            ; (co2, nty2) <- go ty2
            ; r <- getRole
            ; return (mkFunCo r co1 co2, mkFunTy nty1 nty2) }
-    go (ForAllTy (Named tyvar vis) ty)
+    go (ForAllTy (TvBndr tyvar vis) ty)
       = do { (lc', tv', h, ki') <- normalise_tyvar_bndr tyvar
            ; (co, nty)          <- withLC lc' $ normalise_type ty
            ; let tv2 = setTyVarKind tv' ki'
-           ; return (mkForAllCo tv' h co, mkNamedForAllTy tv2 vis nty) }
+           ; return (mkForAllCo tv' h co, ForAllTy (TvBndr tv2 vis) nty) }
     go (TyVarTy tv)    = normalise_tyvar tv
     go (CastTy ty co)
       = do { (nco, nty) <- go ty
@@ -1475,14 +1475,14 @@ coreFlattenTy = go
       = let (env', tys') = coreFlattenTys env tys in
         (env', mkTyConApp tc tys')
 
-    go env (ForAllTy (Anon ty1) ty2) = let (env1, ty1') = go env  ty1
-                                           (env2, ty2') = go env1 ty2 in
-                                       (env2, mkFunTy ty1' ty2')
+    go env (FunTy ty1 ty2) = let (env1, ty1') = go env  ty1
+                                 (env2, ty2') = go env1 ty2 in
+                             (env2, mkFunTy ty1' ty2')
 
-    go env (ForAllTy (Named tv vis) ty)
+    go env (ForAllTy (TvBndr tv vis) ty)
       = let (env1, tv') = coreFlattenVarBndr env tv
             (env2, ty') = go env1 ty in
-        (env2, mkNamedForAllTy tv' vis ty')
+        (env2, ForAllTy (TvBndr tv' vis) ty')
 
     go env ty@(LitTy {}) = (env, ty)
 
@@ -1556,12 +1556,13 @@ allTyVarsInTy :: Type -> VarSet
 allTyVarsInTy = go
   where
     go (TyVarTy tv)      = unitVarSet tv
-    go (AppTy ty1 ty2)   = (go ty1) `unionVarSet` (go ty2)
     go (TyConApp _ tys)  = allTyVarsInTys tys
-    go (ForAllTy bndr ty) =
-      caseBinder bndr (\tv -> unitVarSet tv) (const emptyVarSet)
-      `unionVarSet` go (binderType bndr) `unionVarSet` go ty
-        -- don't remove the tv from the set!
+    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 (LitTy {})        = emptyVarSet
     go (CastTy ty co)    = go ty `unionVarSet` go_co co
     go (CoercionTy co)   = go_co co
index e3cebcd..c38a533 100644 (file)
@@ -71,6 +71,7 @@ isConstraintKind _               = False
 -- ends in @*@ and @Maybe a -> [a]@ ends in @[]@.
 returnsTyCon :: Unique -> Type -> Bool
 returnsTyCon tc_u (ForAllTy _ ty)  = returnsTyCon tc_u ty
+returnsTyCon tc_u (FunTy    _ ty)  = returnsTyCon tc_u ty
 returnsTyCon tc_u (TyConApp tc' _) = tc' `hasKey` tc_u
 returnsTyCon _  _                  = False
 
index 7df02b6..edacdad 100644 (file)
@@ -24,7 +24,6 @@ Note [The Type-related module hierarchy]
 module TyCoRep (
         TyThing(..),
         Type(..),
-        TyBinder(..),
         TyLit(..),
         KindOrType, Kind,
         PredType, ThetaType,      -- Synonyms
@@ -37,22 +36,26 @@ module TyCoRep (
 
         -- * Functions over types
         mkTyConTy, mkTyVarTy, mkTyVarTys,
-        mkFunTy, mkFunTys, mkForAllTys,
+        mkFunTy, mkFunTys, mkForAllTy, mkForAllTys,
+        mkPiTy, mkPiTys,
         isLiftedTypeKind, isUnliftedTypeKind,
         isCoercionType, isRuntimeRepTy, isRuntimeRepVar,
         isRuntimeRepKindedTy, dropRuntimeRepArgs,
         sameVis,
 
         -- * Functions over binders
-        binderType, delBinderVar, isInvisibleBinder, isVisibleBinder,
-        isNamedBinder, isAnonBinder, delBinderVarFV,
+        TyBinder(..), TyVarBinder(..),
+        binderVar, binderType, binderVisibility,
+        delBinderVar,
+        isInvisible, isVisible,
+        isInvisibleBinder, isVisibleBinder,
 
         -- * Functions over coercions
         pickLR,
 
         -- * Pretty-printing
         pprType, pprParendType, pprTypeApp, pprTvBndr, pprTvBndrs,
-        pprTyThing, pprTyThingCategory, pprSigmaType,
+        pprShortTyThing, pprTyThingCategory, pprSigmaType,
         pprTheta, pprForAll, pprForAllImplicit, pprUserForAll,
         pprThetaArrowTy, pprClassPred,
         pprKind, pprParendKind, pprTyLit,
@@ -87,10 +90,8 @@ module TyCoRep (
         extendCvSubst, extendCvSubstWithClone,
         extendTvSubst, extendTvSubstWithClone,
         extendTvSubstList, extendTvSubstAndInScope,
-        extendTvSubstBinder,
         unionTCvSubst, zipTyEnv, zipCoEnv, mkTyCoInScopeSet,
         zipTvSubst, zipCvSubst,
-        zipTyBinderSubst,
         mkTvSubstPrs,
 
         substTyWith, substTyWithCoVars, substTysWith, substTysWithCoVars,
@@ -119,13 +120,13 @@ module TyCoRep (
         tidyTopType,
         tidyKind,
         tidyCo, tidyCos,
-        tidyTyBinder, tidyTyBinders
+        tidyTyVarBinder, tidyTyVarBinders
     ) where
 
 #include "HsVersions.h"
 
 import {-# SOURCE #-} DataCon( dataConTyCon, dataConFullSig
-                              , dataConUnivTyBinders, dataConExTyBinders
+                              , dataConUnivTyVarBinders, dataConExTyVarBinders
                               , DataCon, filterEqSpec )
 import {-# SOURCE #-} Type( isPredTy, isCoercionTy, mkAppTy
                           , tyCoVarsOfTypesWellScoped
@@ -214,11 +215,13 @@ data Type
                         --    can appear as the right hand side of a type synonym.
 
   | ForAllTy
-        TyBinder
+        {-# UNPACK #-} !TyVarBinder
         Type            -- ^ A Π type.
                         -- This includes arrow types, constructed with
                         -- @ForAllTy (Anon ...)@. See also Note [TyBinder].
 
+  | FunTy Type Type     -- ^ t1 -> t2   Very common, so an important special case
+
   | LitTy TyLit     -- ^ Type literals are similar to type constructors.
 
   | CastTy
@@ -374,9 +377,14 @@ same kinds.
 -- ('Named') or nondependent ('Anon'). They may also be visible or not.
 -- See Note [TyBinders]
 data TyBinder
-  = Named TyVar VisibilityFlag  -- Always a TyVar (not CoVar or Id)
+  = Named TyVarBinder
   | Anon Type   -- Visibility is determined by the type (Constraint vs. *)
-    deriving Data.Data
+  deriving Data.Data
+
+data TyVarBinder
+  = TvBndr TyVar            -- Always a TyVar (not CoVar or Id)
+           VisibilityFlag
+  deriving Data.Data
 
 -- | Is something required to appear in source Haskell ('Visible'),
 -- permitted by request ('Specified') (visible type application), or
@@ -385,6 +393,29 @@ data TyBinder
 data VisibilityFlag = Visible | Specified | Invisible
   deriving (Eq, Data.Data)
 
+binderVar :: TyVarBinder -> TyVar
+binderVar (TvBndr v _) = v
+
+binderType :: TyVarBinder -> Type
+binderType (TvBndr v _) = varType v
+
+binderVisibility :: TyVarBinder -> VisibilityFlag
+binderVisibility (TvBndr _ vis) = vis
+
+-- | 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
+
+-- | Does this binder bind an invisible argument?
+isInvisibleBinder :: TyBinder -> Bool
+isInvisibleBinder (Named (TvBndr _ vis)) = isInvisible vis
+isInvisibleBinder (Anon ty)              = isPredTy ty
+
+-- | Does this binder bind a visible argument?
+isVisibleBinder :: TyBinder -> Bool
+isVisibleBinder = not . isInvisibleBinder
+
 -- | Do these denote the same level of visibility? Except that
 -- 'Specified' and 'Invisible' are considered the same. Used
 -- for printing.
@@ -394,9 +425,18 @@ sameVis Visible _       = False
 sameVis _       Visible = False
 sameVis _       _       = True
 
+isVisible :: VisibilityFlag -> Bool
+isVisible Visible = True
+isVisible _       = False
+
+isInvisible :: VisibilityFlag -> Bool
+isInvisible v = not (isVisible v)
+
+
 {- Note [TyBinders]
 ~~~~~~~~~~~~~~~~~~~
-A ForAllTy contains a TyBinder.
+A ForAllTy contains a TyVarBinder.  But a type can be decomposed
+to a telescope consisting of a [TyBinder]
 
 A TyBinder represents the type of binders -- that is, the type of an
 argument to a Pi-type. GHC Core currently supports two different
@@ -404,11 +444,11 @@ Pi-types:
 
  * A non-dependent function,
    written with ->, e.g. ty1 -> ty2
-   represented as ForAllTy (Anon ty1) ty2
+   represented as FunTy ty1 ty2
 
  * A dependent compile-time-only polytype,
    written with forall, e.g.  forall (a:*). ty
-   represented as ForAllTy (Named a v) ty
+   represented as ForAllTy (TvBndr a v) ty
 
 Both Pi-types classify terms/types that take an argument. In other
 words, if `x` is either a function or a polytype, `x arg` makes sense
@@ -421,7 +461,7 @@ The two constructors for TyBinder sort out the two different possibilities.
 
 Note [TyBinders and VisibilityFlags]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-A ForAllTy contains a TyBinder.  Each Named TyBinders are equipped
+A ForAllTy contains a TyVarBinder.  Each TyVarBinder is equipped
 with a VisibilityFlag, which says whether or not arguments for this
 binder should be visible (explicit) in source Haskell.
 
@@ -624,16 +664,26 @@ mkTyVarTys = map mkTyVarTy -- a common use of mkTyVarTy
 infixr 3 `mkFunTy`      -- Associates to the right
 -- | Make an arrow type
 mkFunTy :: Type -> Type -> Type
-mkFunTy arg res = ForAllTy (Anon arg) res
+mkFunTy arg res = FunTy arg res
 
 -- | Make nested arrow types
 mkFunTys :: [Type] -> Type -> Type
 mkFunTys tys ty = foldr mkFunTy ty tys
 
+mkForAllTy :: TyVarBinder -> Type -> Type
+mkForAllTy = ForAllTy
+
 -- | Wraps foralls over the type using the provided 'TyVar's from left to right
-mkForAllTys :: [TyBinder] -> Type -> Type
+mkForAllTys :: [TyVarBinder] -> 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
+
+mkPiTys :: [TyBinder] -> Type -> Type
+mkPiTys tbs ty = foldr mkPiTy ty tbs
+
 -- | Does this type classify a core (unlifted) Coercion?
 -- At either role nominal or reprsentational
 --    (t1 ~# t2) or (t1 ~R# t2)
@@ -644,38 +694,6 @@ isCoercionType (TyConApp tc tys)
   = True
 isCoercionType _ = False
 
-binderType :: TyBinder -> Type
-binderType (Named v _) = varType v
-binderType (Anon ty)   = ty
-
--- | Remove the binder's variable from the set, if the binder has
--- a variable.
-delBinderVar :: VarSet -> TyBinder -> VarSet
-delBinderVar vars (Named tv _) = vars `delVarSet` tv
-delBinderVar vars (Anon {})    = vars
-
--- | Remove the binder's variable from the set, if the binder has
--- a variable.
-delBinderVarFV :: TyBinder -> FV -> FV
-delBinderVarFV (Named tv _) vars fv_cand in_scope acc = delFV tv vars fv_cand in_scope acc
-delBinderVarFV (Anon {})    vars fv_cand in_scope acc = vars fv_cand in_scope acc
-
--- | Does this binder bind an invisible argument?
-isInvisibleBinder :: TyBinder -> Bool
-isInvisibleBinder (Named _ vis) = vis /= Visible
-isInvisibleBinder (Anon ty)     = isPredTy ty
-
--- | Does this binder bind a visible argument?
-isVisibleBinder :: TyBinder -> Bool
-isVisibleBinder = not . isInvisibleBinder
-
-isNamedBinder :: TyBinder -> Bool
-isNamedBinder (Named {}) = True
-isNamedBinder _          = False
-
-isAnonBinder :: TyBinder -> Bool
-isAnonBinder (Anon {}) = True
-isAnonBinder _         = False
 
 -- | Create the plain type constructor type which has been applied to no type arguments at all.
 mkTyConTy :: TyCon -> Type
@@ -1383,14 +1401,15 @@ tyCoFVsOfType (TyVarTy v)        a b c = (unitFV v `unionFV` tyCoFVsOfType (tyVa
 tyCoFVsOfType (TyConApp _ tys)   a b c = tyCoFVsOfTypes tys a b c
 tyCoFVsOfType (LitTy {})         a b c = emptyFV a b c
 tyCoFVsOfType (AppTy fun arg)    a b c = (tyCoFVsOfType fun `unionFV` tyCoFVsOfType arg) a b c
+tyCoFVsOfType (FunTy arg res)    a b c = (tyCoFVsOfType arg `unionFV` tyCoFVsOfType res) a b c
 tyCoFVsOfType (ForAllTy bndr ty) a b c = tyCoFVsBndr bndr (tyCoFVsOfType ty)  a b c
 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 :: TyBinder -> FV -> FV
+tyCoFVsBndr :: TyVarBinder -> FV -> FV
 -- Free vars of (forall b. <thing with fvs>)
-tyCoFVsBndr bndr fvs = delBinderVarFV bndr fvs
-                           `unionFV` tyCoFVsOfType (binderType bndr)
+tyCoFVsBndr (TvBndr tv _) fvs = (delFV tv fvs)
+                                `unionFV` tyCoFVsOfType (tyVarKind tv)
 
 -- | Returns free variables of types, including kind variables as
 -- a non-deterministic set. For type synonyms it does /not/ expand the
@@ -1478,9 +1497,10 @@ coVarsOfType (TyVarTy v)         = coVarsOfType (tyVarKind v)
 coVarsOfType (TyConApp _ tys)    = coVarsOfTypes tys
 coVarsOfType (LitTy {})          = emptyVarSet
 coVarsOfType (AppTy fun arg)     = coVarsOfType fun `unionVarSet` coVarsOfType arg
-coVarsOfType (ForAllTy bndr ty)
-  = coVarsOfType ty `delBinderVar` bndr
-    `unionVarSet` coVarsOfType (binderType bndr)
+coVarsOfType (FunTy arg res)     = coVarsOfType arg `unionVarSet` coVarsOfType res
+coVarsOfType (ForAllTy (TvBndr tv _) ty)
+  = (coVarsOfType ty `delVarSet` tv)
+    `unionVarSet` coVarsOfType (tyVarKind tv)
 coVarsOfType (CastTy ty co)      = coVarsOfType ty `unionVarSet` coVarsOfCo co
 coVarsOfType (CoercionTy co)     = coVarsOfCo co
 
@@ -1572,10 +1592,12 @@ data TyThing
   | ACoAxiom (CoAxiom Branched)
 
 instance Outputable TyThing where
-  ppr = pprTyThing
+  ppr = pprShortTyThing
 
-pprTyThing :: TyThing -> SDoc
-pprTyThing thing = pprTyThingCategory thing <+> quotes (ppr (getName thing))
+pprShortTyThing :: TyThing -> SDoc
+-- c.f. PprTyThing.pprTyThing, which prints all the details
+pprShortTyThing thing
+  = pprTyThingCategory thing <+> quotes (ppr (getName thing))
 
 pprTyThingCategory :: TyThing -> SDoc
 pprTyThingCategory (ATyCon tc)
@@ -1858,10 +1880,6 @@ extendTvSubstList :: TCvSubst -> [Var] -> [Type] -> TCvSubst
 extendTvSubstList subst tvs tys
   = foldl2 extendTvSubst subst tvs tys
 
-extendTvSubstBinder :: TCvSubst -> TyBinder -> Type -> TCvSubst
-extendTvSubstBinder env (Anon {})    _  = env
-extendTvSubstBinder env (Named tv _) ty = extendTvSubst env tv ty
-
 unionTCvSubst :: TCvSubst -> TCvSubst -> TCvSubst
 -- Works when the ranges are disjoint
 unionTCvSubst (TCvSubst in_scope1 tenv1 cenv1) (TCvSubst in_scope2 tenv2 cenv2)
@@ -1905,15 +1923,6 @@ zipCvSubst cvs cos
   where
     cenv = zipCoEnv cvs cos
 
--- | Create a TCvSubst combining the binders and types provided.
--- NB: It is specifically OK if the lists are of different lengths.
-zipTyBinderSubst :: [TyBinder] -> [Type] -> TCvSubst
-zipTyBinderSubst bndrs tys
-  = mkTvSubst is tenv
-  where
-    is = mkInScopeSet (tyCoVarsOfTypes tys)
-    tenv = mkVarEnv [ (tv, ty) | (Named tv _, ty) <- zip bndrs tys ]
-
 -- | Generates the in-scope set for the 'TCvSubst' from the types in the
 -- incoming environment. No CoVars, please!
 mkTvSubstPrs :: [(TyVar, Type)] -> TCvSubst
@@ -2206,12 +2215,11 @@ subst_ty subst ty
                 -- by [Int], represented with TyConApp
     go (TyConApp tc tys) = let args = map go tys
                            in  args `seqList` TyConApp tc args
-    go (ForAllTy (Anon arg) res)
-                         = (ForAllTy $! (Anon $! go arg)) $! go res
-    go (ForAllTy (Named tv vis) ty)
+    go (FunTy arg res)   = (FunTy $! go arg) $! go res
+    go (ForAllTy (TvBndr tv vis) ty)
                          = case substTyVarBndrUnchecked subst tv of
                              (subst', tv') ->
-                               (ForAllTy $! ((Named $! tv') vis)) $!
+                               (ForAllTy $! ((TvBndr $! tv') vis)) $!
                                             (subst_ty subst' ty)
     go (LitTy n)         = LitTy $! n
     go (CastTy ty co)    = (CastTy $! (go ty)) $! (subst_co subst co)
@@ -2552,17 +2560,17 @@ defaultRuntimeRepVars' :: TyVarSet  -- ^ the binders which we should default
                        -> Type -> Type
 -- TODO: Eventually we should just eliminate the Type pretty-printer
 -- entirely and simply use IfaceType; this task is tracked as #11660.
-defaultRuntimeRepVars' subs (ForAllTy (Named var vis) ty)
+defaultRuntimeRepVars' subs (ForAllTy (TvBndr var vis) ty)
   | isRuntimeRepVar var                        =
     let subs' = extendVarSet subs var
     in defaultRuntimeRepVars' subs' ty
   | otherwise                                  =
     let var' = var { varType = defaultRuntimeRepVars' subs (varType var) }
-    in ForAllTy (Named var' vis) (defaultRuntimeRepVars' subs ty)
+    in ForAllTy (TvBndr var' vis) (defaultRuntimeRepVars' subs ty)
 
-defaultRuntimeRepVars' subs (ForAllTy (Anon kind) ty) =
-    ForAllTy (Anon $ defaultRuntimeRepVars' subs kind)
-             (defaultRuntimeRepVars' subs ty)
+defaultRuntimeRepVars' subs (FunTy kind ty) =
+    FunTy (defaultRuntimeRepVars' subs kind)
+          (defaultRuntimeRepVars' subs ty)
 
 defaultRuntimeRepVars' subs (TyVarTy var)
   | var `elemVarSet` subs                      = ptrRepLiftedTy
@@ -2650,6 +2658,7 @@ ppr_type _ (TyVarTy tv)       = ppr_tvar tv
 ppr_type p (TyConApp tc tys)  = pprTyTcApp p tc tys
 ppr_type p (LitTy l)          = ppr_tylit p l
 ppr_type p ty@(ForAllTy {})   = ppr_forall_type p ty
+ppr_type p ty@(FunTy {})      = ppr_forall_type p ty
 
 ppr_type p (AppTy t1 t2)
   = if_print_coercions
@@ -2678,6 +2687,7 @@ ppr_type _ (CoercionTy co)
       (text "<>")
 
 ppr_forall_type :: TyPrec -> Type -> SDoc
+-- Used for types starting with ForAllTy or FunTy
 ppr_forall_type p ty
   = maybeParen p FunPrec $
     sdocWithDynFlags $ \dflags ->
@@ -2710,21 +2720,26 @@ if_print_coercions yes no
 ppr_sigma_type :: DynFlags
                -> Bool -- ^ True <=> Show the foralls unconditionally
                -> Type -> SDoc
+-- Used for types starting with ForAllTy or FunTy
 -- Suppose we have (forall a. Show a => forall b. a -> b). When we're not
 -- printing foralls, we want to drop both the (forall a) and the (forall b).
 -- This logic does so.
 ppr_sigma_type dflags False orig_ty
   | not (gopt Opt_PrintExplicitForalls dflags)
-  , all (isEmptyVarSet . tyCoVarsOfType . binderType) named
+  , all (isEmptyVarSet . tyCoVarsOfType . tyVarKind) tv_bndrs
       -- See Note [When to print foralls]
-  = sep [ pprThetaArrowTy (map binderType ctxt)
+  = sep [ pprThetaArrowTy theta
         , pprArrowChain TopPrec (ppr_fun_tail tau) ]
   where
-    (invis_bndrs, tau) = split [] orig_ty
-    (named, ctxt)      = partition isNamedBinder invis_bndrs
+    (tv_bndrs, theta, tau) = split [] [] orig_ty
 
-    split acc (ForAllTy bndr ty) | isInvisibleBinder bndr = split (bndr:acc) ty
-    split acc ty                                          = (reverse acc, ty)
+    split :: [TyVar] -> [PredType] -> Type
+          -> ([TyVar], [PredType], Type)
+    split bndr_acc theta_acc (ForAllTy (TvBndr tv vis) ty)
+      | isInvisible vis         = split (tv : bndr_acc) theta_acc ty
+    split bndr_acc theta_acc (FunTy ty1 ty2)
+      | isPredTy ty1            = split bndr_acc (ty1 : theta_acc) ty2
+    split bndr_acc theta_acc ty = (reverse bndr_acc, reverse theta_acc, ty)
 
 ppr_sigma_type _ _ ty
   = sep [ pprForAll bndrs
@@ -2734,23 +2749,23 @@ ppr_sigma_type _ _ ty
     (bndrs, rho) = split1 [] ty
     (ctxt, tau)  = split2 [] rho
 
-    split1 bndrs (ForAllTy bndr@(Named {}) ty) = split1 (bndr:bndrs) ty
-    split1 bndrs ty                            = (reverse bndrs, ty)
+    split1 bndrs (ForAllTy bndr ty) = split1 (bndr:bndrs) ty
+    split1 bndrs ty                 = (reverse bndrs, ty)
 
-    split2 ps (ForAllTy (Anon ty1) ty2) | isPredTy ty1 = split2 (ty1:ps) ty2
-    split2 ps ty                                       = (reverse ps, ty)
+    split2 ps (FunTy ty1 ty2) | isPredTy ty1 = split2 (ty1:ps) ty2
+    split2 ps ty                             = (reverse ps, ty)
 
     -- We don't want to lose synonyms, so we mustn't use splitFunTys here.
 ppr_fun_tail :: Type -> [SDoc]
-ppr_fun_tail (ForAllTy (Anon ty1) ty2)
+ppr_fun_tail (FunTy ty1 ty2)
   | not (isPredTy ty1) = ppr_type FunPrec ty1 : ppr_fun_tail ty2
 ppr_fun_tail other_ty = [ppr_type TopPrec other_ty]
 
 pprSigmaType :: Type -> SDoc
 pprSigmaType ty = sdocWithDynFlags $ \dflags ->
-    eliminateRuntimeRep (ppr_sigma_type dflags False) ty
+                  eliminateRuntimeRep (ppr_sigma_type dflags False) ty
 
-pprUserForAll :: [TyBinder] -> SDoc
+pprUserForAll :: [TyVarBinder] -> SDoc
 -- Print a user-level forall; see Note [When to print foralls]
 pprUserForAll bndrs
   = sdocWithDynFlags $ \dflags ->
@@ -2761,13 +2776,13 @@ pprUserForAll bndrs
       = not (isEmptyVarSet (tyCoVarsOfType (binderType bndr)))
 
 pprForAllImplicit :: [TyVar] -> SDoc
-pprForAllImplicit tvs = pprForAll (zipWith Named tvs (repeat Specified))
+pprForAllImplicit tvs = pprForAll [ TvBndr tv Specified | tv <- tvs ]
 
 -- | Render the "forall ... ." or "forall ... ->" bit of a type.
 -- Do not pass in anonymous binders!
-pprForAll :: [TyBinder] -> SDoc
+pprForAll :: [TyVarBinder] -> SDoc
 pprForAll [] = empty
-pprForAll bndrs@(Named _ vis : _)
+pprForAll bndrs@(TvBndr _ vis : _)
   = add_separator (forAllLit <+> doc) <+> pprForAll bndrs'
   where
     (bndrs', doc) = ppr_tv_bndrs bndrs vis
@@ -2775,7 +2790,6 @@ pprForAll bndrs@(Named _ vis : _)
     add_separator stuff = case vis of
                             Visible   -> stuff <+> arrow
                             _inv      -> stuff <>  dot
-pprForAll bndrs = pprPanic "pprForAll: anonymous binder" (ppr bndrs)
 
 pprTvBndrs :: [TyVar] -> SDoc
 pprTvBndrs tvs = sep (map pprTvBndr tvs)
@@ -2783,10 +2797,10 @@ pprTvBndrs tvs = sep (map pprTvBndr tvs)
 -- | Render the ... in @(forall ... .)@ or @(forall ... ->)@.
 -- Returns both the list of not-yet-rendered binders and the doc.
 -- No anonymous binders here!
-ppr_tv_bndrs :: [TyBinder]
+ppr_tv_bndrs :: [TyVarBinder]
              -> VisibilityFlag  -- ^ visibility of the first binder in the list
-             -> ([TyBinder], SDoc)
-ppr_tv_bndrs all_bndrs@(Named tv vis : bndrs) vis1
+             -> ([TyVarBinder], SDoc)
+ppr_tv_bndrs all_bndrs@(TvBndr tv vis : bndrs) vis1
   | vis `sameVis` vis1 = let (bndrs', doc) = ppr_tv_bndrs bndrs vis1
                              pp_tv = sdocWithDynFlags $ \dflags ->
                                      if Invisible == vis &&
@@ -2797,7 +2811,6 @@ ppr_tv_bndrs all_bndrs@(Named tv vis : bndrs) vis1
                          (bndrs', pp_tv <+> doc)
   | otherwise   = (all_bndrs, empty)
 ppr_tv_bndrs [] _ = ([], empty)
-ppr_tv_bndrs bndrs _ = pprPanic "ppr_tv_bndrs: anonymous binder" (ppr bndrs)
 
 pprTvBndr :: TyVar -> SDoc
 pprTvBndr tv
@@ -2813,11 +2826,14 @@ pprTvBndrNoParens tv
              where
                kind = tyVarKind tv
 
+instance Outputable TyVarBinder where
+  ppr (TvBndr v Visible)   = ppr v
+  ppr (TvBndr v Specified) = char '@' <> ppr v
+  ppr (TvBndr v Invisible) = braces (ppr v)
+
 instance Outputable TyBinder where
-  ppr (Named v Visible)   = ppr v
-  ppr (Named v Specified) = char '@' <> ppr v
-  ppr (Named v Invisible) = braces (ppr v)
-  ppr (Anon ty)       = text "[anon]" <+> ppr ty
+  ppr (Named tvb) = ppr tvb
+  ppr (Anon ty)   = text "[anon]" <+> ppr ty
 
 instance Outputable VisibilityFlag where
   ppr Visible   = text "[vis]"
@@ -2879,8 +2895,8 @@ pprDataConWithArgs :: DataCon -> SDoc
 pprDataConWithArgs dc = sep [forAllDoc, thetaDoc, ppr dc <+> argsDoc]
   where
     (_univ_tvs, _ex_tvs, eq_spec, theta, arg_tys, _res_ty) = dataConFullSig dc
-    univ_bndrs = dataConUnivTyBinders dc
-    ex_bndrs   = dataConExTyBinders dc
+    univ_bndrs = dataConUnivTyVarBinders dc
+    ex_bndrs   = dataConExTyVarBinders dc
     forAllDoc = pprUserForAll $ (filterEqSpec eq_spec univ_bndrs ++ ex_bndrs)
     thetaDoc  = pprThetaArrowTy theta
     argsDoc   = hsep (fmap pprParendType arg_tys)
@@ -3148,16 +3164,14 @@ tidyTyCoVarBndr tidy_env@(occ_env, subst) tyvar
            else mkVarOcc   (occNameString occ ++ "0")
          | otherwise         = occ
 
-tidyTyBinder :: TidyEnv -> TyBinder -> (TidyEnv, TyBinder)
-tidyTyBinder tidy_env (Named tv vis)
-  = (tidy_env', Named tv' vis)
+tidyTyVarBinder :: TidyEnv -> TyVarBinder -> (TidyEnv, TyVarBinder)
+tidyTyVarBinder tidy_env (TvBndr tv vis)
+  = (tidy_env', TvBndr tv' vis)
   where
     (tidy_env', tv') = tidyTyCoVarBndr tidy_env tv
-tidyTyBinder tidy_env (Anon ty)
-  = (tidy_env, Anon $ tidyType tidy_env ty)
 
-tidyTyBinders :: TidyEnv -> [TyBinder] -> (TidyEnv, [TyBinder])
-tidyTyBinders = mapAccumL tidyTyBinder
+tidyTyVarBinders :: TidyEnv -> [TyVarBinder] -> (TidyEnv, [TyVarBinder])
+tidyTyVarBinders = mapAccumL tidyTyVarBinder
 
 ---------------
 tidyFreeTyCoVars :: TidyEnv -> [TyCoVar] -> TidyEnv
@@ -3200,10 +3214,9 @@ tidyType env (TyVarTy tv)         = TyVarTy (tidyTyVarOcc 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)
-tidyType env (ForAllTy (Anon fun) arg)
-  = (ForAllTy $! (Anon $! (tidyType env fun))) $! (tidyType env arg)
-tidyType env (ForAllTy (Named tv vis) ty)
-  = (ForAllTy $! ((Named $! tvp) $! vis)) $! (tidyType envp ty)
+tidyType env (FunTy fun arg)      = (FunTy $! (tidyType env fun)) $! (tidyType env arg)
+tidyType env (ForAllTy (TvBndr tv vis) ty)
+  = (ForAllTy $! ((TvBndr $! tvp) $! vis)) $! (tidyType envp ty)
   where
     (envp, tvp) = tidyTyCoVarBndr env tv
 tidyType env (CastTy ty co)       = (CastTy $! tidyType env ty) $! (tidyCo env co)
index 0bcd9b3..314eed1 100644 (file)
@@ -5,13 +5,14 @@ import Data.Data  ( Data )
 
 data Type
 data TyBinder
+data TyVarBinder
 data TyThing
 data Coercion
 data LeftOrRight
 data UnivCoProvenance
 data TCvSubst
 
-mkForAllTys :: [TyBinder] -> Type -> Type
+mkPiTys :: [TyBinder] -> Type -> Type
 
 type PredType = Type
 type Kind = Type
index bafcb2c..c7c225d 100644 (file)
@@ -111,7 +111,7 @@ module TyCon(
 
 #include "HsVersions.h"
 
-import {-# SOURCE #-} TyCoRep ( Kind, Type, PredType, TyBinder, pprType, mkForAllTys )
+import {-# SOURCE #-} TyCoRep ( Kind, Type, PredType, TyBinder, pprType, mkPiTys )
 import {-# SOURCE #-} TysWiredIn  ( runtimeRepTyCon, constraintKind
                                   , vecCountTyCon, vecElemTyCon, liftedTypeKind )
 import {-# SOURCE #-} DataCon ( DataCon, dataConExTyVars, dataConFieldLabels )
@@ -367,6 +367,15 @@ See also:
 ************************************************************************
 -}
 
+{- Note [TyCon binders]
+~~~~~~~~~~~~~~~~~~~~~~~
+
+data TyConBinder = TCB TyVar TcConBinderVis
+
+data TyConBinderVis = NamedTCB VisiblityFlag
+                    | AnonTCB
+-}
+
 -- | TyCons represent type constructors. Type constructors are introduced by
 -- things such as:
 --
@@ -811,7 +820,7 @@ data FamTyConFlav
 All TyCons have this group of fields
   tyConBinders :: [TyBinder]
   tyConResKind :: Kind
-  tyConKind    :: Kind   -- Cached = mkForAllTys tyConBinders tyConResKind
+  tyConKind    :: Kind   -- Cached = mkPiTys tyConBinders tyConResKind
   tyConArity   :: Arity  -- Cached = length tyConBinders
 
 They fit together like so:
@@ -832,8 +841,8 @@ They fit together like so:
   considered saturated.  Here we mean "applied to in the actual Type",
   not surface syntax; i.e. including implicit kind variables.
 
-Note [tyConBinders and tyConTyVars]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+Note [tyConTyVars and tyConBinders]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 Consider
   type App a (b :: k) = a b
     -- App :: forall {k}; (k->*) -> k -> *
@@ -1238,7 +1247,7 @@ mkFunTyCon name binders rep_nm
         tyConName    = name,
         tyConBinders = binders,
         tyConResKind = liftedTypeKind,
-        tyConKind    = mkForAllTys binders liftedTypeKind,
+        tyConKind    = mkPiTys binders liftedTypeKind,
         tyConArity   = 2,
         tcRepName    = rep_nm
     }
@@ -1269,7 +1278,7 @@ mkAlgTyCon name binders res_kind tyvars roles cType stupid rhs parent is_rec gad
         tyConUnique      = nameUnique name,
         tyConBinders     = binders,
         tyConResKind     = res_kind,
-        tyConKind        = mkForAllTys binders res_kind,
+        tyConKind        = mkPiTys binders res_kind,
         tyConArity       = length tyvars,
         tyConTyVars      = tyvars,
         tcRoles          = roles,
@@ -1306,7 +1315,7 @@ mkTupleTyCon name binders res_kind arity tyvars con sort parent
         tyConUnique      = nameUnique name,
         tyConBinders     = binders,
         tyConResKind     = res_kind,
-        tyConKind        = mkForAllTys binders res_kind,
+        tyConKind        = mkPiTys binders res_kind,
         tyConArity       = arity,
         tyConTyVars      = tyvars,
         tcRoles          = replicate arity Representational,
@@ -1337,7 +1346,7 @@ mkTcTyCon name tvs binders res_kind unsat scoped_tvs
             , tyConTyVars  = tvs
             , tyConBinders = binders
             , tyConResKind = res_kind
-            , tyConKind    = mkForAllTys binders res_kind
+            , tyConKind    = mkPiTys binders res_kind
             , tyConUnsat   = unsat
             , tyConArity   = length binders
             , tcTyConScopedTyVars = scoped_tvs }
@@ -1376,7 +1385,7 @@ mkPrimTyCon' name binders res_kind roles is_unlifted rep_nm
         tyConUnique  = nameUnique name,
         tyConBinders = binders,
         tyConResKind = res_kind,
-        tyConKind    = mkForAllTys binders res_kind,
+        tyConKind    = mkPiTys binders res_kind,
         tyConArity   = length roles,
         tcRoles      = roles,
         isUnlifted   = is_unlifted,
@@ -1392,7 +1401,7 @@ mkSynonymTyCon name binders res_kind tyvars roles rhs
         tyConUnique  = nameUnique name,
         tyConBinders = binders,
         tyConResKind = res_kind,
-        tyConKind    = mkForAllTys binders res_kind,
+        tyConKind    = mkPiTys binders res_kind,
         tyConArity   = length tyvars,
         tyConTyVars  = tyvars,
         tcRoles      = roles,
@@ -1409,7 +1418,7 @@ mkFamilyTyCon name binders res_kind tyvars resVar flav parent inj
       , tyConName    = name
       , tyConBinders = binders
       , tyConResKind = res_kind
-      , tyConKind    = mkForAllTys binders res_kind
+      , tyConKind    = mkPiTys binders res_kind
       , tyConArity   = length tyvars
       , tyConTyVars  = tyvars
       , famTcResVar  = resVar
@@ -1433,7 +1442,7 @@ mkPromotedDataCon con name rep_name binders res_kind roles rep_info
         tcRoles       = roles,
         tyConBinders  = binders,
         tyConResKind  = res_kind,
-        tyConKind     = mkForAllTys binders res_kind,
+        tyConKind     = mkPiTys binders res_kind,
         dataCon       = con,
         tcRepName     = rep_name,
         promDcRepInfo = rep_info
index 8ce60a5..c20a158 100644 (file)
@@ -15,7 +15,7 @@ module Type (
 
         -- $representation_types
         TyThing(..), Type, VisibilityFlag(..), KindOrType, PredType, ThetaType,
-        Var, TyVar, isTyVar, TyCoVar, TyBinder,
+        Var, TyVar, isTyVar, TyCoVar, TyBinder, TyVarBinder,
 
         -- ** Constructing and deconstructing types
         mkTyVarTy, mkTyVarTys, getTyVar, getTyVar_maybe, repGetTyVar_maybe,
@@ -35,12 +35,12 @@ module Type (
         repSplitTyConApp_maybe,
 
         mkForAllTy, mkForAllTys, mkInvForAllTys, mkSpecForAllTys,
-        mkVisForAllTys,
-        mkNamedForAllTy,
-        splitForAllTy_maybe, splitForAllTys, splitForAllTy,
-        splitPiTy_maybe, splitPiTys, splitPiTy,
-        splitNamedPiTys,
-        mkPiType, mkPiTypes, mkTyBindersPreferAnon,
+        mkVisForAllTys, mkInvForAllTy,
+        splitForAllTys, splitForAllTyVarBndrs,
+        splitForAllTy_maybe, splitForAllTy,
+        splitPiTy_maybe, splitPiTy, splitPiTys,
+        mkPiTy, mkPiTys, mkTyBindersPreferAnon,
+        mkLamType, mkLamTypes,
         piResultTy, piResultTys,
         applyTysX, dropForAlls,
 
@@ -82,13 +82,14 @@ module Type (
         predTypeEqRel,
 
         -- ** Binders
-        sameVis,
-        mkNamedBinder, mkNamedBinders,
-        mkAnonBinder, isNamedBinder, isAnonBinder,
-        isIdLikeBinder, binderVisibility, binderVar_maybe,
-        binderVar, binderRelevantType_maybe, caseBinder,
-        partitionBinders, partitionBindersIntoBinders,
-        binderType, isVisibleBinder, isInvisibleBinder,
+        sameVis, mkNamedTyBinders,
+        mkTyVarBinder, mkTyVarBinders,
+        mkAnonBinder, mkNamedBinder,
+        isAnonTyBinder, isNamedTyBinder,
+        binderVar, binderType, binderVisibility,
+        tyBinderType, tyBinderVisibility,
+        binderRelevantType_maybe, caseBinder,
+        isVisible, isInvisible, isVisibleBinder, isInvisibleBinder,
 
         -- ** Common type constructors
         funTyCon,
@@ -115,7 +116,8 @@ module Type (
         liftedTypeKind,
 
         -- * Type free variables
-        tyCoVarsOfType, tyCoVarsOfTypes, tyCoFVsOfType,
+        tyCoFVsOfType, tyCoFVsBndr,
+        tyCoVarsOfType, tyCoVarsOfTypes,
         tyCoVarsOfTypeDSet,
         coVarsOfType,
         coVarsOfTypes, closeOverKinds, closeOverKindsList,
@@ -172,7 +174,7 @@ module Type (
         cloneTyVarBndr, cloneTyVarBndrs, lookupTyVar,
 
         -- * Pretty-printing
-        pprType, pprParendType, pprTypeApp, pprTyThingCategory, pprTyThing,
+        pprType, pprParendType, pprTypeApp, pprTyThingCategory, pprShortTyThing,
         pprTvBndr, pprTvBndrs, pprForAll, pprForAllImplicit, pprUserForAll,
         pprSigmaType, ppSuggestExplicitKinds,
         pprTheta, pprThetaArrowTy, pprClassPred,
@@ -189,7 +191,7 @@ module Type (
         tidyTyVarOcc,
         tidyTopType,
         tidyKind,
-        tidyTyBinder, tidyTyBinders
+        tidyTyVarBinder, tidyTyVarBinders
     ) where
 
 #include "HsVersions.h"
@@ -353,11 +355,11 @@ expandTypeSynonyms ty
     go _     (LitTy l)     = LitTy l
     go subst (TyVarTy tv)  = substTyVar subst tv
     go subst (AppTy t1 t2) = mkAppTy (go subst t1) (go subst t2)
-    go subst (ForAllTy (Anon arg) res)
+    go subst (FunTy arg res)
       = mkFunTy (go subst arg) (go subst res)
-    go subst (ForAllTy (Named tv vis) t)
+    go subst (ForAllTy (TvBndr tv vis) t)
       = let (subst', tv') = substTyVarBndrCallback go subst tv in
-        ForAllTy (Named tv' vis) (go subst' t)
+        ForAllTy (TvBndr 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)
 
@@ -475,18 +477,18 @@ mapType mapper@(TyCoMapper { tcm_smart = smart, tcm_tyvar = tyvar
     go t@(TyConApp _ []) = return t  -- avoid allocation in this exceedingly
                                      -- common case (mostly, for *)
     go (TyConApp tc tys) = mktyconapp tc <$> mapM go tys
-    go (ForAllTy (Anon arg) res) = mkfunty <$> go arg <*> go res
-    go (ForAllTy (Named tv vis) inner)
+    go (FunTy arg res)   = FunTy <$> go arg <*> go res
+    go (ForAllTy (TvBndr tv vis) inner)
       = do { (env', tv') <- tybinder env tv vis
            ; inner' <- mapType mapper env' inner
-           ; return $ ForAllTy (Named tv' vis) inner' }
-    go ty@(LitTy {}) = return ty
-    go (CastTy ty co) = mkcastty <$> go ty <*> mapCoercion mapper env co
+           ; return $ ForAllTy (TvBndr 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
 
-    (mktyconapp, mkappty, mkcastty, mkfunty)
-      | smart     = (mkTyConApp, mkAppTy, mkCastTy, mkFunTy)
-      | otherwise = (TyConApp,   AppTy,   CastTy,   ForAllTy . Anon)
+    (mktyconapp, mkappty, mkcastty)
+      | smart     = (mkTyConApp, mkAppTy, mkCastTy)
+      | otherwise = (TyConApp,   AppTy,   CastTy)
 
 {-# INLINABLE mapCoercion #-}  -- See Note [Specialising mappers]
 mapCoercion :: Monad m
@@ -646,8 +648,7 @@ splitAppTy_maybe ty = repSplitAppTy_maybe ty
 repSplitAppTy_maybe :: Type -> Maybe (Type,Type)
 -- ^ Does the AppTy split as in 'splitAppTy_maybe', but assumes that
 -- any Core view stuff is already done
-repSplitAppTy_maybe (ForAllTy (Anon ty1) ty2)
-                                      = Just (TyConApp funTyCon [ty1], ty2)
+repSplitAppTy_maybe (FunTy ty1 ty2)   = Just (TyConApp funTyCon [ty1], ty2)
 repSplitAppTy_maybe (AppTy ty1 ty2)   = Just (ty1, ty2)
 repSplitAppTy_maybe (TyConApp tc tys)
   | mightBeUnsaturatedTyCon tc || tys `lengthExceeds` tyConArity tc
@@ -661,7 +662,7 @@ repSplitAppTy_maybe _other = Nothing
 tcRepSplitAppTy_maybe :: Type -> Maybe (Type,Type)
 -- ^ Does the AppTy split as in 'tcSplitAppTy_maybe', but assumes that
 -- any coreView stuff is already done. Refuses to look through (c => t)
-tcRepSplitAppTy_maybe (ForAllTy (Anon ty1) ty2)
+tcRepSplitAppTy_maybe (FunTy ty1 ty2)
   | isConstraintKind (typeKind ty1)     = Nothing  -- See Note [Decomposing fat arrow c=>t]
   | otherwise                           = Just (TyConApp funTyCon [ty1], ty2)
 tcRepSplitAppTy_maybe (AppTy ty1 ty2)   = Just (ty1, ty2)
@@ -694,9 +695,9 @@ splitAppTys ty = split ty ty []
             (tc_args1, tc_args2) = splitAt n tc_args
         in
         (TyConApp tc tc_args1, tc_args2 ++ args)
-    split _   (ForAllTy (Anon ty1) ty2) args = ASSERT( null args )
-                                               (TyConApp funTyCon [], [ty1,ty2])
-    split orig_ty _                     args = (orig_ty, args)
+    split _   (FunTy ty1 ty2) args = ASSERT( null args )
+                                     (TyConApp funTyCon [], [ty1,ty2])
+    split orig_ty _           args = (orig_ty, args)
 
 -- | Like 'splitAppTys', but doesn't look through type synonyms
 repSplitAppTys :: Type -> (Type, [Type])
@@ -709,8 +710,8 @@ repSplitAppTys ty = split ty []
             (tc_args1, tc_args2) = splitAt n tc_args
         in
         (TyConApp tc tc_args1, tc_args2 ++ args)
-    split (ForAllTy (Anon ty1) ty2) args = ASSERT( null args )
-                                           (TyConApp funTyCon [], [ty1, ty2])
+    split (FunTy ty1 ty2) args = ASSERT( null args )
+                                 (TyConApp funTyCon [], [ty1, ty2])
     split ty args = (ty, args)
 
 {-
@@ -782,8 +783,6 @@ pprUserTypeErrorTy ty =
 ---------------------------------------------------------------------
                                 FunTy
                                 ~~~~~
-
-Function types are represented with (ForAllTy (Anon ...) ...)
 -}
 
 isFunTy :: Type -> Bool
@@ -793,33 +792,33 @@ splitFunTy :: Type -> (Type, Type)
 -- ^ Attempts to extract the argument and result types from a type, and
 -- panics if that is not possible. See also 'splitFunTy_maybe'
 splitFunTy ty | Just ty' <- coreView ty = splitFunTy ty'
-splitFunTy (ForAllTy (Anon arg) res)    = (arg, res)
-splitFunTy other                        = pprPanic "splitFunTy" (ppr other)
+splitFunTy (FunTy arg res) = (arg, res)
+splitFunTy other           = pprPanic "splitFunTy" (ppr other)
 
 splitFunTy_maybe :: Type -> Maybe (Type, Type)
 -- ^ Attempts to extract the argument and result types from a type
 splitFunTy_maybe ty | Just ty' <- coreView ty = splitFunTy_maybe ty'
-splitFunTy_maybe (ForAllTy (Anon arg) res) = Just (arg, res)
-splitFunTy_maybe _                         = Nothing
+splitFunTy_maybe (FunTy arg res) = Just (arg, res)
+splitFunTy_maybe _               = Nothing
 
 splitFunTys :: Type -> ([Type], Type)
 splitFunTys ty = split [] ty ty
   where
     split args orig_ty ty | Just ty' <- coreView ty = split args orig_ty ty'
-    split args _       (ForAllTy (Anon arg) res) = split (arg:args) res res
-    split args orig_ty _                         = (reverse args, orig_ty)
+    split args _       (FunTy arg res) = split (arg:args) res res
+    split args orig_ty _               = (reverse args, orig_ty)
 
 funResultTy :: Type -> Type
 -- ^ Extract the function result type and panic if that is not possible
 funResultTy ty | Just ty' <- coreView ty = funResultTy ty'
-funResultTy (ForAllTy (Anon {}) res)     = res
-funResultTy ty                           = pprPanic "funResultTy" (ppr ty)
+funResultTy (FunTy _ res) = res
+funResultTy ty            = pprPanic "funResultTy" (ppr ty)
 
 funArgTy :: Type -> Type
 -- ^ Extract the function argument type and panic if that is not possible
 funArgTy ty | Just ty' <- coreView ty = funArgTy ty'
-funArgTy (ForAllTy (Anon arg) _res) = arg
-funArgTy ty                         = pprPanic "funArgTy" (ppr ty)
+funArgTy (FunTy arg _res) = arg
+funArgTy ty               = pprPanic "funArgTy" (ppr ty)
 
 piResultTy :: Type -> Type ->  Type
 piResultTy ty arg = case piResultTy_maybe ty arg of
@@ -834,13 +833,14 @@ piResultTy_maybe :: Type -> Type -> Maybe Type
 piResultTy_maybe ty arg
   | Just ty' <- coreView ty = piResultTy_maybe ty' arg
 
-  | ForAllTy bndr res <- ty
-  = case bndr of
-      Anon {}    -> Just res
-      Named tv _ -> Just (substTy (extendTvSubst empty_subst tv arg) res)
-        where
-          empty_subst = mkEmptyTCvSubst $ mkInScopeSet $
-                        tyCoVarsOfTypes [arg,res]
+  | FunTy _ res <- ty
+  = Just res
+
+  | ForAllTy (TvBndr tv _) res <- ty
+  = let empty_subst = mkEmptyTCvSubst $ mkInScopeSet $
+                      tyCoVarsOfTypes [arg,res]
+    in Just (substTy (extendTvSubst empty_subst tv arg) res)
+
   | otherwise
   = Nothing
 
@@ -871,10 +871,11 @@ piResultTys ty orig_args@(arg:args)
   | Just ty' <- coreView ty
   = piResultTys ty' orig_args
 
-  | ForAllTy bndr res <- ty
-  = case bndr of
-      Anon {}    -> piResultTys res args
-      Named tv _ -> go (extendVarEnv emptyTvSubstEnv tv arg) res args
+  | FunTy _ res <- ty
+  = piResultTys res args
+
+  | ForAllTy (TvBndr tv _) res <- ty
+  = go (extendVarEnv emptyTvSubstEnv tv arg) res args
 
   | otherwise
   = pprPanic "piResultTys1" (ppr ty $$ ppr orig_args)
@@ -888,10 +889,11 @@ piResultTys ty orig_args@(arg:args)
       | Just ty' <- coreView ty
       = go tv_env ty' all_args
 
-      | ForAllTy bndr res <- ty
-      = case bndr of
-          Anon _     -> go tv_env res args
-          Named tv _ -> go (extendVarEnv tv_env tv arg) res args
+      | FunTy _ res <- ty
+      = go tv_env res args
+
+      | ForAllTy (TvBndr tv _) res <- ty
+      = go (extendVarEnv tv_env tv arg) res args
 
       | TyVarTy tv <- ty
       , Just ty' <- lookupVarEnv tv_env tv
@@ -924,7 +926,7 @@ applyTysX tvs body_ty arg_tys
 mkTyConApp :: TyCon -> [Type] -> Type
 mkTyConApp tycon tys
   | isFunTyCon tycon, [ty1,ty2] <- tys
-  = ForAllTy (Anon ty1) ty2
+  = FunTy ty1 ty2
 
   | otherwise
   = TyConApp tycon tys
@@ -936,17 +938,17 @@ mkTyConApp tycon tys
 -- | Retrieve the tycon heading this type, if there is one. Does /not/
 -- look through synonyms.
 tyConAppTyConPicky_maybe :: Type -> Maybe TyCon
-tyConAppTyConPicky_maybe (TyConApp tc _)       = Just tc
-tyConAppTyConPicky_maybe (ForAllTy (Anon _) _) = Just funTyCon
-tyConAppTyConPicky_maybe _                     = Nothing
+tyConAppTyConPicky_maybe (TyConApp tc _) = Just tc
+tyConAppTyConPicky_maybe (FunTy {})      = Just funTyCon
+tyConAppTyConPicky_maybe _               = Nothing
 
 
 -- | The same as @fst . splitTyConApp@
 tyConAppTyCon_maybe :: Type -> Maybe TyCon
 tyConAppTyCon_maybe ty | Just ty' <- coreView ty = tyConAppTyCon_maybe ty'
-tyConAppTyCon_maybe (TyConApp tc _)       = Just tc
-tyConAppTyCon_maybe (ForAllTy (Anon _) _) = Just funTyCon
-tyConAppTyCon_maybe _                     = Nothing
+tyConAppTyCon_maybe (TyConApp tc _) = Just tc
+tyConAppTyCon_maybe (FunTy {})      = Just funTyCon
+tyConAppTyCon_maybe _               = Nothing
 
 tyConAppTyCon :: Type -> TyCon
 tyConAppTyCon ty = tyConAppTyCon_maybe ty `orElse` pprPanic "tyConAppTyCon" (ppr ty)
@@ -954,9 +956,9 @@ tyConAppTyCon ty = tyConAppTyCon_maybe ty `orElse` pprPanic "tyConAppTyCon" (ppr
 -- | The same as @snd . splitTyConApp@
 tyConAppArgs_maybe :: Type -> Maybe [Type]
 tyConAppArgs_maybe ty | Just ty' <- coreView ty = tyConAppArgs_maybe ty'
-tyConAppArgs_maybe (TyConApp _ tys)          = Just tys
-tyConAppArgs_maybe (ForAllTy (Anon arg) res) = Just [arg,res]
-tyConAppArgs_maybe _                         = Nothing
+tyConAppArgs_maybe (TyConApp _ tys) = Just tys
+tyConAppArgs_maybe (FunTy arg res)  = Just [arg,res]
+tyConAppArgs_maybe _                = Nothing
 
 tyConAppArgs :: Type -> [Type]
 tyConAppArgs ty = tyConAppArgs_maybe ty `orElse` pprPanic "tyConAppArgs" (ppr ty)
@@ -985,9 +987,9 @@ splitTyConApp_maybe ty                           = repSplitTyConApp_maybe ty
 -- | Like 'splitTyConApp_maybe', but doesn't look through synonyms. This
 -- assumes the synonyms have already been dealt with.
 repSplitTyConApp_maybe :: Type -> Maybe (TyCon, [Type])
-repSplitTyConApp_maybe (TyConApp tc tys)         = Just (tc, tys)
-repSplitTyConApp_maybe (ForAllTy (Anon arg) res) = Just (funTyCon, [arg,res])
-repSplitTyConApp_maybe _                         = Nothing
+repSplitTyConApp_maybe (TyConApp tc tys) = Just (tc, tys)
+repSplitTyConApp_maybe (FunTy arg res)   = Just (funTyCon, [arg,res])
+repSplitTyConApp_maybe _                 = Nothing
 
 -- | Attempts to tease a list type apart and gives the type of the elements if
 -- successful (looks through type synonyms)
@@ -1071,14 +1073,16 @@ mkCastTy ty co | isReflexiveCo co = ty
 -- in test dependent/should_compile/dynamic-paper.
 
 mkCastTy (CastTy ty co1) co2 = mkCastTy ty (co1 `mkTransCo` co2)
--- See Note [Weird typing rule for ForAllTy]
-mkCastTy outer_ty@(ForAllTy (Named tv vis) inner_ty) co
-  = -- have to make sure that pushing the co in doesn't capture the bound var
-    let fvs = tyCoVarsOfCo co `unionVarSet` tyCoVarsOfType outer_ty
-        empty_subst = mkEmptyTCvSubst (mkInScopeSet fvs)
-        (subst, tv') = substTyVarBndr empty_subst tv
-    in
-    ForAllTy (Named tv' vis) (substTy subst inner_ty `mkCastTy` co)
+
+mkCastTy outer_ty@(ForAllTy (TvBndr tv vis) inner_ty) co
+  = ForAllTy (TvBndr tv' vis) (substTy subst inner_ty `mkCastTy` co)
+  where
+    -- See Note [Weird typing rule for ForAllTy]
+    -- have to make sure that pushing the co in doesn't capture the bound var
+    fvs = tyCoVarsOfCo co `unionVarSet` tyCoVarsOfType outer_ty
+    empty_subst = mkEmptyTCvSubst (mkInScopeSet fvs)
+    (subst, tv') = substTyVarBndr empty_subst tv
+
 mkCastTy ty co = -- NB: don't check if the coercion "from" type matches here;
                  -- there may be unzonked variables about
                  let result = split_apps [] ty co in
@@ -1102,24 +1106,25 @@ mkCastTy ty co = -- NB: don't check if the coercion "from" type matches here;
         affix_co (fst $ splitPiTys $ typeKind saturated_tc)
                  saturated_tc (decomp_args `chkAppend` args) co
 
-    split_apps args (ForAllTy (Anon arg) res) co
+    split_apps args (FunTy arg res) co
       = affix_co (tyConBinders funTyCon) (mkTyConTy funTyCon)
                  (arg : res : args) co
     split_apps args ty co
       = affix_co (fst $ splitPiTys $ typeKind ty)
                  ty args co
 
-    -- having broken everything apart, this figures out the point at which there
+    -- Having broken everything apart, this figures out the point at which there
     -- are no more dependent quantifications, and puts the cast there
-    affix_co _ ty [] co = no_double_casts ty co
+    affix_co _ ty [] co
+      = no_double_casts ty co
     affix_co bndrs ty args co
       -- if kind contains any dependent quantifications, we can't push.
       -- apply arguments until it doesn't
-      = let (no_dep_bndrs, some_dep_bndrs) = spanEnd isAnonBinder bndrs
+      = let (no_dep_bndrs, some_dep_bndrs) = spanEnd isAnonTyBinder bndrs
             (some_dep_args, rest_args) = splitAtList some_dep_bndrs args
             dep_subst = zipTyBinderSubst some_dep_bndrs some_dep_args
             used_no_dep_bndrs = takeList rest_args no_dep_bndrs
-            rest_arg_tys = substTys dep_subst (map binderType used_no_dep_bndrs)
+            rest_arg_tys = substTys dep_subst (map tyBinderType used_no_dep_bndrs)
             co' = mkFunCos Nominal
                            (map (mkReflCo Nominal) rest_arg_tys)
                            co
@@ -1177,61 +1182,58 @@ interfaces.  Notably this plays a role in tcTySigs in TcBinds.hs.
                                 ~~~~~~~~
 -}
 
-mkForAllTy :: TyBinder -> Type -> Type
-mkForAllTy = ForAllTy
-
 -- | Make a dependent forall.
-mkNamedForAllTy :: TyVar -> VisibilityFlag -> Type -> Type
-mkNamedForAllTy tv vis = ASSERT( isTyVar tv )
-                         ForAllTy (Named tv vis)
+mkInvForAllTy :: TyVar -> Type -> Type
+mkInvForAllTy tv ty = ASSERT( isTyVar tv )
+                      ForAllTy (TvBndr tv Invisible) ty
 
 -- | Like mkForAllTys, but assumes all variables are dependent and invisible,
 -- a common case
 mkInvForAllTys :: [TyVar] -> Type -> Type
-mkInvForAllTys tvs = ASSERT( all isTyVar tvs )
-                     mkForAllTys (map (flip Named Invisible) tvs)
+mkInvForAllTys tvs ty = ASSERT( all isTyVar tvs )
+                        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 (map (flip Named Specified) tvs)
+                     mkForAllTys [ TvBndr 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 (map (flip Named Visible) tvs)
+                     mkForAllTys [ TvBndr tv Visible | tv <- tvs ]
 
-mkPiType  :: Var -> Type -> Type
+mkLamType  :: Var -> Type -> Type
 -- ^ Makes a @(->)@ type or an implicit forall type, depending
 -- on whether it is given a type variable or a term variable.
 -- This is used, for example, when producing the type of a lambda.
 -- Always uses Invisible binders.
-mkPiTypes :: [Var] -> Type -> Type
--- ^ 'mkPiType' for multiple type or value arguments
+mkLamTypes :: [Var] -> Type -> Type
+-- ^ 'mkLamType' for multiple type or value arguments
 
-mkPiType v ty
-   | isTyVar v = mkForAllTy (Named v Invisible) ty
-   | otherwise = mkForAllTy (Anon (varType v)) ty
+mkLamType v ty
+   | isTyVar v = ForAllTy (TvBndr v Invisible) ty
+   | otherwise = FunTy    (varType v)          ty
 
-mkPiTypes vs ty = foldr mkPiType ty vs
+mkLamTypes vs ty = foldr mkLamType ty vs
 
 -- | Given a list of type-level vars and a result type, makes TyBinders, preferring
 -- anonymous binders if the variable is, in fact, not dependent.
 -- All binders are /visible/.
 mkTyBindersPreferAnon :: [TyVar] -> Type -> [TyBinder]
-mkTyBindersPreferAnon vars inner_ty = fst $ go vars inner_ty
+mkTyBindersPreferAnon vars inner_ty = fst (go vars)
   where
-    go :: [TyVar] -> Type -> ([TyBinder], VarSet) -- also returns the free vars
-    go [] ty = ([], tyCoVarsOfType ty)
-    go (v:vs) ty |  v `elemVarSet` fvs
-                 = ( Named v Visible : binders
-                   , fvs `delVarSet` v `unionVarSet` kind_vars )
-                 | otherwise
-                 = ( Anon (tyVarKind v) : binders
-                   , fvs `unionVarSet` kind_vars )
+    go :: [TyVar] -> ([TyBinder], VarSet) -- also returns the free vars
+    go [] = ([], tyCoVarsOfType inner_ty)
+    go (v:vs) |  v `elemVarSet` fvs
+              = ( Named (TvBndr v Visible) : binders
+                , fvs `delVarSet` v `unionVarSet` kind_vars )
+              | otherwise
+              = ( Anon (tyVarKind v) : binders
+                , fvs `unionVarSet` kind_vars )
       where
-        (binders, fvs) = go vs ty
+        (binders, fvs) = go vs
         kind_vars      = tyCoVarsOfType $ tyVarKind v
 
 -- | Take a ForAllTy apart, returning the list of tyvars and the result type.
@@ -1241,34 +1243,26 @@ splitForAllTys :: Type -> ([TyVar], Type)
 splitForAllTys ty = split ty ty []
   where
     split orig_ty ty tvs | Just ty' <- coreView ty = split orig_ty ty' tvs
-    split _       (ForAllTy (Named tv _) ty) tvs = split ty ty (tv:tvs)
-    split orig_ty _                          tvs = (reverse tvs, orig_ty)
+    split _       (ForAllTy (TvBndr tv _) ty) tvs = split ty ty (tv:tvs)
+    split orig_ty _                           tvs = (reverse tvs, orig_ty)
 
--- | Split off all TyBinders to a type, splitting both proper foralls
--- and functions
-splitPiTys :: Type -> ([TyBinder], Type)
-splitPiTys ty = split ty ty []
+-- | Like 'splitPiTys' but split off only /named/ binders.
+splitForAllTyVarBndrs :: Type -> ([TyVarBinder], Type)
+splitForAllTyVarBndrs 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)
 
--- | Like 'splitPiTys' but split off only /named/ binders.
-splitNamedPiTys :: Type -> ([TyBinder], Type)
-splitNamedPiTys ty = split ty ty []
-  where
-    split orig_ty ty bs | Just ty' <- coreView ty = split orig_ty ty' bs
-    split _       (ForAllTy b@(Named {}) res) bs  = split res res (b:bs)
-    split orig_ty _                           bs  = (reverse bs, orig_ty)
-
 -- | Checks whether this is a proper forall (with a named binder)
 isForAllTy :: Type -> Bool
-isForAllTy (ForAllTy (Named {}) _) = True
-isForAllTy _                       = False
+isForAllTy (ForAllTy {}) = True
+isForAllTy _             = False
 
 -- | Is this a function or forall?
 isPiTy :: Type -> Bool
 isPiTy (ForAllTy {}) = True
+isPiTy (FunTy {})    = True
 isPiTy _             = False
 
 -- | Take a forall type apart, or panics if that is not possible.
@@ -1277,14 +1271,22 @@ splitForAllTy ty
   | Just answer <- splitForAllTy_maybe ty = answer
   | otherwise                             = pprPanic "splitForAllTy" (ppr ty)
 
+-- | Drops all ForAllTys
+dropForAlls :: Type -> Type
+dropForAlls ty = go ty
+  where
+    go ty | Just ty' <- coreView ty = go ty'
+    go (ForAllTy _ res)            = go res
+    go res                         = res
+
 -- | 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 ty = splitFAT_m ty
+splitForAllTy_maybe ty = go ty
   where
-    splitFAT_m ty | Just ty' <- coreView ty = splitFAT_m ty'
-    splitFAT_m (ForAllTy (Named tv _) ty) = Just (tv, ty)
-    splitFAT_m _                          = Nothing
+    go ty | Just ty' <- coreView ty = go ty'
+    go (ForAllTy (TvBndr tv _) ty) = Just (tv, ty)
+    go _                           = Nothing
 
 -- | Attempts to take a forall type apart; works with proper foralls and
 -- functions
@@ -1292,7 +1294,8 @@ splitPiTy_maybe :: Type -> Maybe (TyBinder, Type)
 splitPiTy_maybe ty = go ty
   where
     go ty | Just ty' <- coreView ty = go ty'
-    go (ForAllTy bndr ty) = Just (bndr, ty)
+    go (ForAllTy bndr ty) = Just (Named bndr, ty)
+    go (FunTy arg res)    = Just (Anon arg, res)
     go _                  = Nothing
 
 -- | Takes a forall type apart, or panics
@@ -1301,13 +1304,27 @@ splitPiTy ty
   | Just answer <- splitPiTy_maybe ty = answer
   | otherwise                         = pprPanic "splitPiTy" (ppr ty)
 
--- | Drops all non-anonymous ForAllTys
-dropForAlls :: Type -> Type
-dropForAlls ty | Just ty' <- coreView ty = dropForAlls ty'
-               | otherwise = go ty
+-- | Split off all TyBinders to a type, splitting both proper foralls
+-- and functions
+splitPiTys :: Type -> ([TyBinder], Type)
+splitPiTys ty = split ty ty []
   where
-    go (ForAllTy (Named {}) res) = go res
-    go res                       = res
+    split orig_ty ty bs | Just ty' <- coreView ty = split orig_ty ty' bs
+    split _       (ForAllTy b res) bs  = split res res (Named b  : bs)
+    split _       (FunTy arg res)  bs  = split res res (Anon arg : bs)
+    split orig_ty _                bs  = (reverse bs, orig_ty)
+
+-- Like splitPiTys, but returns only *invisible* binders, including constraints
+-- Stops at the first visible binder
+splitPiTysInvisible :: Type -> ([TyBinder], 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
+      | isInvisible vis                = split res res (Named b  : bs)
+    split _       (FunTy arg res)  bs
+      | isPredTy arg                   = split res res (Anon arg : bs)
+    split orig_ty _                bs  = (reverse bs, orig_ty)
 
 -- | Given a tycon and its arguments, filters out any invisible arguments
 filterOutInvisibleTypes :: TyCon -> [Type] -> [Type]
@@ -1338,28 +1355,16 @@ partitionInvisibles :: TyCon -> (a -> Type) -> [a] -> ([a], [a])
 partitionInvisibles tc get_ty = go emptyTCvSubst (tyConKind tc)
   where
     go _ _ [] = ([], [])
-    go subst (ForAllTy bndr res_ki) (x:xs)
-      | isVisibleBinder bndr = second (x :) (go subst' res_ki xs)
-      | otherwise            = first  (x :) (go subst' res_ki xs)
+    go subst (ForAllTy (TvBndr tv vis) res_ki) (x:xs)
+      | isVisible vis = second (x :) (go subst' res_ki xs)
+      | otherwise     = first  (x :) (go subst' res_ki xs)
       where
-        subst' = extendTvSubstBinder subst bndr (get_ty x)
+        subst' = extendTvSubst 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
                           -- when printing errors. Assume everything is visible.
 
--- like splitPiTys, but returns only *invisible* binders, including constraints
-splitPiTysInvisible :: Type -> ([TyBinder], Type)
-splitPiTysInvisible ty = split ty ty []
-   where
-     split orig_ty ty bndrs
-       | Just ty' <- coreView ty = split orig_ty ty' bndrs
-     split _       (ForAllTy bndr ty) bndrs
-       |  isInvisibleBinder bndr
-       = split ty ty (bndr:bndrs)
-
-     split orig_ty _ bndrs
-       = (reverse bndrs, orig_ty)
 
 {-
 %************************************************************************
@@ -1370,45 +1375,46 @@ splitPiTysInvisible ty = split ty ty []
 -}
 
 -- | Make a named binder
-mkNamedBinder :: VisibilityFlag -> Var -> TyBinder
-mkNamedBinder vis var = Named var vis
+mkTyVarBinder :: VisibilityFlag -> Var -> TyVarBinder
+mkTyVarBinder vis var = TvBndr var vis
 
 -- | Make many named binders
-mkNamedBinders :: VisibilityFlag -> [TyVar] -> [TyBinder]
-mkNamedBinders vis = map (mkNamedBinder vis)
+mkTyVarBinders :: VisibilityFlag -> [TyVar] -> [TyVarBinder]
+mkTyVarBinders vis = map (mkTyVarBinder vis)
+
+mkNamedTyBinders :: VisibilityFlag -> [TyVar] -> [TyBinder]
+mkNamedTyBinders vis tvs
+  = map (mkNamedBinder . mkTyVarBinder vis) tvs
 
 -- | Make an anonymous binder
 mkAnonBinder :: Type -> TyBinder
 mkAnonBinder = Anon
 
+-- | Make a Named TyBinder
+mkNamedBinder :: TyVarBinder -> TyBinder
+mkNamedBinder = Named
+
 -- | Does this binder bind a variable that is /not/ erased? Returns
 -- 'True' for anonymous binders.
-isIdLikeBinder :: TyBinder -> Bool
-isIdLikeBinder (Named {}) = False
-isIdLikeBinder (Anon {})  = True
-
--- | Does this type, when used to the left of an arrow, require
--- a visible argument? This checks to see if the kind of the type
--- is constraint.
-isVisibleType :: Type -> Bool
-isVisibleType = not . isPredTy
-
-binderVisibility :: TyBinder -> VisibilityFlag
-binderVisibility (Named _ vis) = vis
-binderVisibility (Anon ty)
-  | isVisibleType ty = Visible
-  | otherwise        = Invisible
-
--- | Extract a bound variable in a binder, if any
-binderVar_maybe :: TyBinder -> Maybe Var
-binderVar_maybe (Named v _) = Just v
-binderVar_maybe (Anon {})   = Nothing
-
--- | Extract a bound variable in a binder, or panics
-binderVar :: String   -- ^ printed if there is a panic
-          -> TyBinder -> Var
-binderVar _ (Named v _) = v
-binderVar e (Anon t)    = pprPanic ("binderVar (" ++ e ++ ")") (ppr t)
+isAnonTyBinder :: TyBinder -> Bool
+isAnonTyBinder (Named {}) = False
+isAnonTyBinder (Anon {})  = True
+
+isNamedTyBinder :: TyBinder -> Bool
+isNamedTyBinder (Named {}) = True
+isNamedTyBinder (Anon {})  = False
+
+tyBinderType :: TyBinder -> Type
+-- Barely used
+tyBinderType (Named tvb) = binderType tvb
+tyBinderType (Anon ty)   = ty
+
+tyBinderVisibility :: TyBinder -> VisibilityFlag
+-- Barely used
+tyBinderVisibility (Named tvb) = binderVisibility tvb
+tyBinderVisibility (Anon ty)
+                 | isPredTy ty = Invisible
+                 | otherwise   = Visible
 
 -- | Extract a relevant type, if there is one.
 binderRelevantType_maybe :: TyBinder -> Maybe Type
@@ -1416,25 +1422,19 @@ binderRelevantType_maybe (Named {}) = Nothing
 binderRelevantType_maybe (Anon ty)  = Just ty
 
 -- | Like 'maybe', but for binders.
-caseBinder :: TyBinder       -- ^ binder to scrutinize
-           -> (TyVar -> a) -- ^ named case
-           -> (Type -> a)  -- ^ anonymous case
+caseBinder :: TyBinder           -- ^ binder to scrutinize
+           -> (TyVarBinder -> a) -- ^ named case
+           -> (Type -> a)        -- ^ anonymous case
            -> a
-caseBinder (Named v _) f _ = f v
-caseBinder (Anon t) _ d    = d t
+caseBinder (Named v) f _ = f v
+caseBinder (Anon t)  _ d = d t
 
--- | Break apart a list of binders into tyvars and anonymous types.
-partitionBinders :: [TyBinder] -> ([TyVar], [Type])
-partitionBinders = partitionWith named_or_anon
-  where
-    named_or_anon bndr = caseBinder bndr Left Right
-
--- | Break apart a list of binders into a list of named binders and
--- a list of anonymous types.
-partitionBindersIntoBinders :: [TyBinder] -> ([TyBinder], [Type])
-partitionBindersIntoBinders = partitionWith named_or_anon
-  where
-    named_or_anon bndr = caseBinder bndr (\_ -> Left bndr) Right
+-- | Create a TCvSubst combining the binders and types provided.
+-- NB: It is specifically OK if the lists are of different lengths.
+-- Barely used
+zipTyBinderSubst :: [TyBinder] -> [Type] -> TCvSubst
+zipTyBinderSubst bndrs tys
+  = mkTvSubstPrs [ (tv, ty) | (Named (TvBndr tv _), ty) <- zip bndrs tys ]
 
 {-
 %************************************************************************
@@ -1477,10 +1477,10 @@ isPredTy ty = go ty []
     go (TyVarTy tv)      args       = go_k (tyVarKind tv) args
     go (TyConApp tc tys) args       = ASSERT( null args )  -- TyConApp invariant
                                       go_tc tc tys
-    go (ForAllTy (Anon arg) res) []
+    go (FunTy arg res) []
       | isPredTy arg                = isPredTy res   -- (Eq a => C a)
       | otherwise                   = False          -- (Int -> Bool)
-    go (ForAllTy (Named {}) ty) []  = go ty []
+    go (ForAllTy _ ty) []           = go ty []
     go (CastTy _ co) args           = go_k (pSnd (coercionKind co)) args
     go _ _ = False
 
@@ -1715,13 +1715,14 @@ predTypeEqRel ty
 -- are `eqType` may return different sizes. This is OK, because this
 -- function is used only in reporting, not decision-making.
 typeSize :: Type -> Int
-typeSize (LitTy {})       = 1
-typeSize (TyVarTy {})     = 1
-typeSize (AppTy t1 t2)    = typeSize t1 + typeSize t2
-typeSize (ForAllTy b t)   = typeSize (binderType b) + typeSize t
-typeSize (TyConApp _ ts)  = 1 + sum (map typeSize ts)
-typeSize (CastTy ty co)   = typeSize ty + coercionSize co
-typeSize (CoercionTy co)  = coercionSize co
+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 (TyConApp _ ts)            = 1 + sum (map typeSize ts)
+typeSize (CastTy ty co)             = typeSize ty + coercionSize co
+typeSize (CoercionTy co)            = coercionSize co
 
 
 {- **********************************************************************
@@ -1941,9 +1942,9 @@ isUnliftedType :: Type -> Bool
         -- construct them
 
 isUnliftedType ty | Just ty' <- coreView ty = isUnliftedType ty'
-isUnliftedType (ForAllTy (Named {}) ty) = isUnliftedType ty
-isUnliftedType (TyConApp tc _)          = isUnliftedTyCon tc
-isUnliftedType _                        = False
+isUnliftedType (ForAllTy _ ty) = isUnliftedType ty
+isUnliftedType (TyConApp tc _) = isUnliftedTyCon tc
+isUnliftedType _               = False
 
 -- | Extract the RuntimeRep classifier of a type. Panics if this is not possible.
 getRuntimeRep :: String   -- ^ Printed in case of an error
@@ -2015,13 +2016,14 @@ isPrimitiveType ty = case splitTyConApp_maybe ty of
 -}
 
 seqType :: Type -> ()
-seqType (LitTy n)            = n `seq` ()
-seqType (TyVarTy tv)         = tv `seq` ()
-seqType (AppTy t1 t2)        = seqType t1 `seq` seqType t2
-seqType (TyConApp tc tys)    = tc `seq` seqTypes tys
-seqType (ForAllTy bndr ty)   = seqType (binderType bndr) `seq` seqType ty
-seqType (CastTy ty co)       = seqType ty `seq` seqCo co
-seqType (CoercionTy co)      = seqCo co
+seqType (LitTy n)                   = n `seq` ()
+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 (CastTy ty co)              = seqType ty `seq` seqCo co
+seqType (CoercionTy co)             = seqCo co
 
 seqTypes :: [Type] -> ()
 seqTypes []       = ()
@@ -2160,7 +2162,7 @@ nonDetCmpTypeX env orig_t1 orig_t2 =
 
     go env (TyVarTy tv1)       (TyVarTy tv2)
       = liftOrdering $ rnOccL env tv1 `nonDetCmpVar` rnOccR env tv2
-    go env (ForAllTy (Named tv1 _) t1) (ForAllTy (Named tv2 _) t2)
+    go env (ForAllTy (TvBndr tv1 _) t1) (ForAllTy (TvBndr tv2 _) t2)
       = go env (tyVarKind tv1) (tyVarKind tv2)
         `thenCmpTy` go (rnBndr2 env tv1 tv2) t1 t2
         -- See Note [Equality on AppTys]
@@ -2170,7 +2172,7 @@ nonDetCmpTypeX env orig_t1 orig_t2 =
     go env ty1 (AppTy s2 t2)
       | Just (s1, t1) <- repSplitAppTy_maybe ty1
       = go env s1 s2 `thenCmpTy` go env t1 t2
-    go env (ForAllTy (Anon s1) t1) (ForAllTy (Anon s2) t2)
+    go env (FunTy s1 t1) (FunTy s2 t2)
       = go env s1 s2 `thenCmpTy` go env t1 t2
     go env (TyConApp tc1 tys1) (TyConApp tc2 tys2)
       = liftOrdering (tc1 `nonDetCmpTc` tc2) `thenCmpTy` gos env tys1 tys2
@@ -2185,13 +2187,13 @@ nonDetCmpTypeX env orig_t1 orig_t2 =
       where get_rank :: Type -> Int
             get_rank (CastTy {})
               = pprPanic "nonDetCmpTypeX.get_rank" (ppr [ty1,ty2])
-            get_rank (TyVarTy {})            = 0
-            get_rank (CoercionTy {})         = 1
-            get_rank (AppTy {})              = 3
-            get_rank (LitTy {})              = 4
-            get_rank (TyConApp {})           = 5
-            get_rank (ForAllTy (Anon {}) _)  = 6
-            get_rank (ForAllTy (Named {}) _) = 7
+            get_rank (TyVarTy {})    = 0
+            get_rank (CoercionTy {}) = 1
+            get_rank (AppTy {})      = 3
+            get_rank (LitTy {})      = 4
+            get_rank (TyConApp {})   = 5
+            get_rank (FunTy {})      = 6
+            get_rank (ForAllTy {})   = 7
 
     gos :: RnEnv2 -> [Type] -> [Type] -> TypeOrdering
     gos _   []         []         = TEQ
@@ -2232,7 +2234,7 @@ typeKind :: Type -> Kind
 typeKind (TyConApp tc tys)     = piResultTys (tyConKind tc) tys
 typeKind (AppTy fun arg)       = piResultTy (typeKind fun) arg
 typeKind (LitTy l)             = typeLiteralKind l
-typeKind (ForAllTy (Anon _) _) = liftedTypeKind
+typeKind (FunTy {})            = liftedTypeKind
 typeKind (ForAllTy _ ty)       = typeKind ty
 typeKind (TyVarTy tyvar)       = tyVarKind tyvar
 typeKind (CastTy _ty co)       = pSnd $ coercionKind co
@@ -2265,14 +2267,14 @@ tyConsOfType ty
   where
      go :: Type -> NameEnv TyCon  -- The NameEnv does duplicate elim
      go ty | Just ty' <- coreView ty = go ty'
-     go (TyVarTy {})               = emptyNameEnv
-     go (LitTy {})                 = emptyNameEnv
-     go (TyConApp tc tys)          = go_tc tc `plusNameEnv` go_s tys
-     go (AppTy a b)                = go a `plusNameEnv` go b
-     go (ForAllTy (Anon a) b)      = go a `plusNameEnv` go b `plusNameEnv` go_tc funTyCon
-     go (ForAllTy (Named tv _) ty) = go ty `plusNameEnv` go (tyVarKind tv)
-     go (CastTy ty co)             = go ty `plusNameEnv` go_co co
-     go (CoercionTy co)            = go_co co
+     go (TyVarTy {})                = emptyNameEnv
+     go (LitTy {})                  = emptyNameEnv
+     go (TyConApp tc tys)           = go_tc tc `plusNameEnv` go_s tys
+     go (AppTy a b)                 = go a `plusNameEnv` go b
+     go (FunTy a b)                 = go a `plusNameEnv` go b `plusNameEnv` go_tc funTyCon
+     go (ForAllTy (TvBndr tv _) ty) = go ty `plusNameEnv` go (tyVarKind tv)
+     go (CastTy ty co)              = go ty `plusNameEnv` go_co co
+     go (CoercionTy co)             = go_co co
 
      go_co (Refl _ ty)             = go ty
      go_co (TyConAppCo _ tc args)  = go_tc tc `plusNameEnv` go_cos args
@@ -2321,11 +2323,11 @@ splitVisVarsOfType orig_ty = Pair invis_vars vis_vars
     Pair invis_vars1 vis_vars = go orig_ty
     invis_vars = invis_vars1 `minusVarSet` vis_vars
 
-    go (TyVarTy tv)  = Pair (tyCoVarsOfType $ tyVarKind tv) (unitVarSet tv)
-    go (AppTy t1 t2) = go t1 `mappend` go t2
+    go (TyVarTy tv)      = Pair (tyCoVarsOfType $ tyVarKind tv) (unitVarSet tv)
+    go (AppTy t1 t2)     = go t1 `mappend` go t2
     go (TyConApp tc tys) = go_tc tc tys
-    go (ForAllTy (Anon t1) t2) = go t1 `mappend` go t2
-    go (ForAllTy (Named tv _) ty)
+    go (FunTy t1 t2)     = go t1 `mappend` go t2
+    go (ForAllTy (TvBndr tv _) ty)
       = ((`delVarSet` tv) <$> go ty) `mappend`
         (invisible (tyCoVarsOfType $ tyVarKind tv))
     go (LitTy {}) = mempty
index 7c16bc0..9436d19 100644 (file)
@@ -3,7 +3,7 @@ import TyCon
 import Var ( TyVar )
 import {-# SOURCE #-} TyCoRep( Type, Kind )
 
-isPredTy :: Type -> Bool
+isPredTy     :: Type -> Bool
 isCoercionTy :: Type -> Bool
 
 mkAppTy :: Type -> Type -> Type
index 859403d..3993369 100644 (file)
@@ -753,7 +753,7 @@ unify_ty ty1 (AppTy ty2a ty2b) _kco
 
 unify_ty (LitTy x) (LitTy y) _kco | x == y = return ()
 
-unify_ty (ForAllTy (Named tv1 _) ty1) (ForAllTy (Named tv2 _) ty2) kco
+unify_ty (ForAllTy (TvBndr tv1 _) ty1) (ForAllTy (TvBndr tv2 _) ty2) kco
   = do { unify_ty (tyVarKind tv1) (tyVarKind tv2) (mkNomReflCo liftedTypeKind)
        ; umRnBndr2 tv1 tv2 $ unify_ty ty1 ty2 kco }
 
@@ -1194,10 +1194,10 @@ ty_co_match menv subst ty1 (AppCo co2 arg2) _lkco _rkco
 
 ty_co_match menv subst (TyConApp tc1 tys) (TyConAppCo _ tc2 cos) _lkco _rkco
   = ty_co_match_tc menv subst tc1 tys tc2 cos
-ty_co_match menv subst (ForAllTy (Anon ty1) ty2) (TyConAppCo _ tc cos) _lkco _rkco
+ty_co_match menv subst (FunTy ty1 ty2) (TyConAppCo _ tc cos) _lkco _rkco
   = ty_co_match_tc menv subst funTyCon [ty1, ty2] tc cos
 
-ty_co_match menv subst (ForAllTy (Named tv1 _) ty1)
+ty_co_match menv subst (ForAllTy (TvBndr tv1 _) ty1)
                        (ForAllCo tv2 kind_co2 co2)
                        lkco rkco
   = do { subst1 <- ty_co_match menv subst (tyVarKind tv1) kind_co2
@@ -1258,11 +1258,11 @@ ty_co_match_args _    _     _        _          _ _ = Nothing
 pushRefl :: Coercion -> Maybe Coercion
 pushRefl (Refl Nominal (AppTy ty1 ty2))
   = Just (AppCo (Refl Nominal ty1) (mkNomReflCo ty2))
-pushRefl (Refl r (ForAllTy (Anon ty1) ty2))
+pushRefl (Refl r (FunTy ty1 ty2))
   = Just (TyConAppCo r funTyCon [mkReflCo r ty1, mkReflCo r ty2])
 pushRefl (Refl r (TyConApp tc tys))
   = Just (TyConAppCo r tc (zipWith mkReflCo (tyConRolesX r tc) tys))
-pushRefl (Refl r (ForAllTy (Named tv _) ty))
+pushRefl (Refl r (ForAllTy (TvBndr tv _) ty))
   = Just (mkHomoForAllCos_NoRefl [tv] (Refl r ty))
     -- NB: NoRefl variant. Otherwise, we get a loop!
 pushRefl (Refl r (CastTy ty co))  = Just (castCoercionKind (Refl r ty) co co)
index af807c8..b3b7098 100644 (file)
@@ -44,7 +44,7 @@ fromVect ty expr
 
 -- For each function constructor in the original type we add an outer
 -- lambda to bind the parameter variable, and an inner application of it.
-fromVect (ForAllTy (Anon arg_ty) res_ty) expr
+fromVect (FunTy arg_ty res_ty) expr
   = do
       arg     <- newLocalVar (fsLit "x") arg_ty
       varg    <- toVect arg_ty (Var arg)
@@ -84,6 +84,7 @@ identityConv (TyConApp tycon tys)
 identityConv (LitTy {})      = noV $ text "identityConv: not sure about literal types under vectorisation"
 identityConv (TyVarTy {})    = noV $ text "identityConv: type variable changes under vectorisation"
 identityConv (AppTy {})      = noV $ text "identityConv: type appl. changes under vectorisation"
+identityConv (FunTy {})      = noV $ text "identityConv: function type changes under vectorisation"
 identityConv (ForAllTy {})   = noV $ text "identityConv: quantified type changes under vectorisation"
 identityConv (CastTy {})     = noV $ text "identityConv: not sure about casted types under vectorisation"
 identityConv (CoercionTy {}) = noV $ text "identityConv: not sure about coercions under vectorisation"
index 2c403bf..23cd0a2 100644 (file)
@@ -85,8 +85,8 @@ buildPDataDataCon orig_name vect_tc repr_tc repr
                             (map (const no_bang) comp_tys)
                             (Just $ map (const HsLazy) comp_tys)
                             []                     -- no field labels
-                            tvs (mkNamedBinders Specified tvs)
-                            [] []                  -- no existentials
+                            tvs (map (mkNamedBinder . mkTyVarBinder Specified) tvs)
+                            []                     -- no existentials
                             []                     -- no eq spec
                             []                     -- no context
                             comp_tys
@@ -129,8 +129,8 @@ buildPDatasDataCon orig_name vect_tc repr_tc repr
                             (map (const no_bang) comp_tys)
                             (Just $ map (const HsLazy) comp_tys)
                             []                     -- no field labels
-                            tvs (mkNamedBinders Specified tvs)
-                            [] []                  -- no existentials
+                            tvs (map (mkNamedBinder . mkTyVarBinder Specified) tvs)
+                            []                     -- no existentials
                             []                     -- no eq spec
                             []                     -- no context
                             comp_tys
index 4bf6515..052eced 100644 (file)
@@ -192,7 +192,7 @@ vectDataCon dc
                     (Just $ dataConImplBangs dc)
                     []                             -- no labelled fields for now
                     univ_tvs univ_bndrs            -- universally quantified vars
-                    [] []                          -- no existential tvs for now
+                    []                             -- no existential tvs for now
                     []                             -- no equalities for now
                     []                             -- no context for now
                     arg_tys                        -- argument types
@@ -204,4 +204,4 @@ vectDataCon dc
     rep_arg_tys = dataConRepArgTys dc
     tycon       = dataConTyCon dc
     (univ_tvs, ex_tvs, eq_spec, theta, _arg_tys, _res_ty) = dataConFullSig dc
-    univ_bndrs  = dataConUnivTyBinders dc
+    univ_bndrs  = map mkNamedBinder (dataConUnivTyVarBinders dc)
index 0882691..88d3f56 100644 (file)
@@ -58,7 +58,7 @@ vectType (TyVarTy tv)      = return $ TyVarTy tv
 vectType (LitTy l)         = return $ LitTy l
 vectType (AppTy ty1 ty2)   = AppTy <$> vectType ty1 <*> vectType ty2
 vectType (TyConApp tc tys) = TyConApp <$> vectTyCon tc <*> mapM vectType tys
-vectType (ForAllTy (Anon ty1) ty2)
+vectType (FunTy ty1 ty2)
   | isPredTy ty1
   = mkFunTy <$> vectType ty1 <*> vectType ty2   -- don't build a closure for dictionary abstraction
   | otherwise
index ca2006b..9cd740c 100644 (file)
@@ -33,7 +33,7 @@ import Control.Monad
 paDictArgType :: TyVar -> VM (Maybe Type)
 paDictArgType tv = go (mkTyVarTy tv) (tyVarKind tv)
   where
-    go ty (ForAllTy (Anon k1) k2)
+    go ty (FunTy k1 k2)
       = do
           tv   <- if isCoercionType k1
                   then newCoVar (fsLit "c") k1
@@ -42,7 +42,7 @@ paDictArgType tv = go (mkTyVarTy tv) (tyVarKind tv)
           case mty1 of
             Just ty1 -> do
                           mty2 <- go (mkAppTy ty (mkTyVarTy tv)) k2
-                          return $ fmap (mkNamedForAllTy tv Invisible . mkFunTy ty1) mty2
+                          return $ fmap (mkInvForAllTy tv . mkFunTy ty1) mty2
             Nothing  -> go ty k2
 
     go ty k
index bb9469e..fec966e 160000 (submodule)
@@ -1 +1 @@
-Subproject commit bb9469ece0b882017fa7f3b51e8db1d2985d6720
+Subproject commit fec966e6d77a5e7f4a586de6096954137a1fe914
index 84253da..3d6d0f6 160000 (submodule)
@@ -1 +1 @@
-Subproject commit 84253da85952765dd7631e467cc2b1d1bba03f24
+Subproject commit 3d6d0f60ac25736cc87a6f598886fe77e7b6ad90
index d8b5381..fbe2b7b 160000 (submodule)
@@ -1 +1 @@
-Subproject commit d8b5381bd5d03a3a75f4a1b91f1ede6fe0fd0ce9
+Subproject commit fbe2b7b9e163daa8fbe3c8f2dddc1132aa4e735f
index 52e0f5e..a73564c 160000 (submodule)
@@ -1 +1 @@
-Subproject commit 52e0f5e85ffbaab77b155d48720fb216021c8a73
+Subproject commit a73564c366b15f7057b614188662d7b7a8eaab19
index 224eccb..6c17dd6 160000 (submodule)
@@ -1 +1 @@
-Subproject commit 224eccbac0125b7bd302f24063bbb473b2c2e1dc
+Subproject commit 6c17dd6fadc5e7e3e09f7892380ce1339f296efd
diff --git a/nofib b/nofib
index 35fc121..dfa9f91 160000 (submodule)
--- a/nofib
+++ b/nofib
@@ -1 +1 @@
-Subproject commit 35fc121fc8cc501ea2713c579a053be7ea65b16e
+Subproject commit dfa9f9158943d2c441add8ccd4309c1b93fb347a
index 4fcc593..8f4251b 100644 (file)
@@ -1,7 +1,7 @@
 
 T11334b.hs:8:14: error:
     • Cannot default kind variable ‘f0’
-      of kind: k10 -> *
+      of kind: k0 -> *
       Perhaps enable PolyKinds or add a kind signature
     • In an expression type signature: Proxy Compose
       In the expression: Proxy :: Proxy Compose
@@ -9,7 +9,7 @@ T11334b.hs:8:14: error:
 
 T11334b.hs:8:14: error:
     • Cannot default kind variable ‘g0’
-      of kind: k0 -> k10
+      of kind: k10 -> k0
       Perhaps enable PolyKinds or add a kind signature
     • In an expression type signature: Proxy Compose
       In the expression: Proxy :: Proxy Compose
@@ -17,7 +17,7 @@ T11334b.hs:8:14: error:
 
 T11334b.hs:8:14: error:
     • Cannot default kind variable ‘a0’
-      of kind: k0
+      of kind: k10
       Perhaps enable PolyKinds or add a kind signature
     • In an expression type signature: Proxy Compose
       In the expression: Proxy :: Proxy Compose
index 94837b4..fcf9e4c 100644 (file)
@@ -1,7 +1,7 @@
 type role A phantom phantom
-data A (x :: k1) (y :: k)
+data A (x :: k) (y :: k1)
        -- Defined at <interactive>:2:1
-A :: k1 -> k -> *
+A :: k -> k1 -> *
 type role T phantom
 data T (a :: k) where
   MkT :: forall k (a :: k) a1. a1 -> T a
index 753b983..3cebd8f 100644 (file)
@@ -1,77 +1,82 @@
-\r
-T10403.hs:15:7: warning: [-Wpartial-type-signatures (in -Wdefault)]\r
-    • Found type wildcard ‘_’ standing for ‘Functor f’\r
-      Where: ‘f’ is a rigid type variable bound by\r
-               the inferred type of h1 :: Functor f => (a -> b) -> f a -> H f\r
-               at T10403.hs:17:1-41\r
-    • In the type signature: h1 :: _ => _\r
-\r
-T10403.hs:15:12: warning: [-Wpartial-type-signatures (in -Wdefault)]\r
-    • Found type wildcard ‘_’ standing for ‘(a -> b) -> f a -> H f’\r
-      Where: ‘f’ is a rigid type variable bound by\r
-               the inferred type of h1 :: Functor f => (a -> b) -> f a -> H f\r
-               at T10403.hs:17:1-41\r
-             ‘b’ is a rigid type variable bound by\r
-               the inferred type of h1 :: Functor f => (a -> b) -> f a -> H f\r
-               at T10403.hs:17:1-41\r
-             ‘a’ is a rigid type variable bound by\r
-               the inferred type of h1 :: Functor f => (a -> b) -> f a -> H f\r
-               at T10403.hs:17:1-41\r
-    • In the type signature: h1 :: _ => _\r
-\r
-T10403.hs:19:7: warning: [-Wpartial-type-signatures (in -Wdefault)]\r
-    • Found type wildcard ‘_’ standing for ‘(a -> b) -> f0 a -> H f0’\r
-      Where: ‘f0’ is an ambiguous type variable\r
-             ‘b’ is a rigid type variable bound by\r
-               the inferred type of h2 :: (a -> b) -> f0 a -> H f0\r
-               at T10403.hs:22:1-41\r
-             ‘a’ is a rigid type variable bound by\r
-               the inferred type of h2 :: (a -> b) -> f0 a -> H f0\r
-               at T10403.hs:22:1-41\r
-    • In the type signature: h2 :: _\r
-\r
-T10403.hs:22:15: warning: [-Wdeferred-type-errors (in -Wdefault)]\r
-    • Ambiguous type variable ‘f0’ arising from a use of ‘fmap’\r
-      prevents the constraint ‘(Functor f0)’ from being solved.\r
-      Relevant bindings include\r
-        b :: f0 a (bound at T10403.hs:22:6)\r
-        h2 :: (a -> b) -> f0 a -> H f0 (bound at T10403.hs:22:1)\r
-      Probable fix: use a type annotation to specify what ‘f0’ should be.\r
-      These potential instances exist:\r
-        instance Functor IO -- Defined in ‘GHC.Base’\r
-        instance Functor (B t) -- Defined at T10403.hs:10:10\r
-        instance Functor I -- Defined at T10403.hs:6:10\r
-        ...plus four others\r
-        (use -fprint-potential-instances to see them all)\r
-    • In the second argument of ‘(.)’, namely ‘fmap (const ())’\r
-      In the expression: H . fmap (const ())\r
-      In the expression: (H . fmap (const ())) (fmap f b)\r
-\r
-T10403.hs:28:8: warning: [-Wdeferred-type-errors (in -Wdefault)]\r
-    • Couldn't match type ‘f0’ with ‘B t’\r
-        because type variable ‘t’ would escape its scope\r
-      This (rigid, skolem) type variable is bound by\r
-        the type signature for:\r
-          app2 :: H (B t)\r
-        at T10403.hs:27:1-15\r
-      Expected type: H (B t)\r
-        Actual type: H f0\r
-    • In the expression: h2 (H . I) (B ())\r
-      In an equation for ‘app2’: app2 = h2 (H . I) (B ())\r
-    • Relevant bindings include\r
-        app2 :: H (B t) (bound at T10403.hs:28:1)\r
-\r
-T10403.hs:28:20: warning: [-Wdeferred-type-errors (in -Wdefault)]\r
-    • Couldn't match type ‘f0’ with ‘B t’\r
-        because type variable ‘t’ would escape its scope\r
-      This (rigid, skolem) type variable is bound by\r
-        the type signature for:\r
-          app2 :: H (B t)\r
-        at T10403.hs:27:1-15\r
-      Expected type: f0 ()\r
-        Actual type: B t ()\r
-    • In the second argument of ‘h2’, namely ‘(B ())’\r
-      In the expression: h2 (H . I) (B ())\r
-      In an equation for ‘app2’: app2 = h2 (H . I) (B ())\r
-    • Relevant bindings include\r
-        app2 :: H (B t) (bound at T10403.hs:28:1)\r
+
+T10403.hs:15:7: warning: [-Wpartial-type-signatures (in -Wdefault)]
+    Found constraint wildcard ‘_’ standing for ‘Functor f’
+    In the type signature:
+      h1 :: _ => _
+
+T10403.hs:15:12: warning: [-Wpartial-type-signatures (in -Wdefault)]
+    • Found type wildcard ‘_’ standing for ‘(a -> b) -> f a -> H f’
+      Where: ‘b’ is a rigid type variable bound by
+               the inferred type of h1 :: Functor f => (a -> b) -> f a -> H f
+               at T10403.hs:17:1
+             ‘a’ is a rigid type variable bound by
+               the inferred type of h1 :: Functor f => (a -> b) -> f a -> H f
+               at T10403.hs:17:1
+             ‘f’ is a rigid type variable bound by
+               the inferred type of h1 :: Functor f => (a -> b) -> f a -> H f
+               at T10403.hs:17:1
+    • In the type signature:
+        h1 :: _ => _
+    • Relevant bindings include
+        h1 :: (a -> b) -> f a -> H f (bound at T10403.hs:17:1)
+
+T10403.hs:19:7: warning: [-Wpartial-type-signatures (in -Wdefault)]
+    • Found type wildcard ‘_’ standing for ‘(a -> b) -> f0 a -> H f0’
+      Where: ‘b’ is a rigid type variable bound by
+               the inferred type of h2 :: (a -> b) -> f0 a -> H f0
+               at T10403.hs:22:1
+             ‘a’ is a rigid type variable bound by
+               the inferred type of h2 :: (a -> b) -> f0 a -> H f0
+               at T10403.hs:22:1
+             ‘f0’ is an ambiguous type variable
+    • In the type signature:
+        h2 :: _
+    • Relevant bindings include
+        h2 :: (a -> b) -> f0 a -> H f0 (bound at T10403.hs:22:1)
+
+T10403.hs:22:15: warning: [-Wdeferred-type-errors (in -Wdefault)]
+    • Ambiguous type variable ‘f0’ arising from a use of ‘fmap’
+      prevents the constraint ‘(Functor f0)’ from being solved.
+      Relevant bindings include
+        b :: f0 a (bound at T10403.hs:22:6)
+        h2 :: (a -> b) -> f0 a -> H f0 (bound at T10403.hs:22:1)
+      Probable fix: use a type annotation to specify what ‘f0’ should be.
+      These potential instances exist:
+        instance Functor IO -- Defined in ‘GHC.Base’
+        instance Functor (B t) -- Defined at T10403.hs:10:10
+        instance Functor I -- Defined at T10403.hs:6:10
+        ...plus four others
+        (use -fprint-potential-instances to see them all)
+    • In the second argument of ‘(.)’, namely ‘fmap (const ())’
+      In the expression: H . fmap (const ())
+      In the expression: (H . fmap (const ())) (fmap f b)
+
+T10403.hs:28:8: warning: [-Wdeferred-type-errors (in -Wdefault)]
+    • Couldn't match type ‘f0’ with ‘B t’
+        because type variable ‘t’ would escape its scope
+      This (rigid, skolem) type variable is bound by
+        the type signature for:
+          app2 :: H (B t)
+        at T10403.hs:27:1-15
+      Expected type: H (B t)
+        Actual type: H f0
+    • In the expression: h2 (H . I) (B ())
+      In an equation for ‘app2’: app2 = h2 (H . I) (B ())
+    • Relevant bindings include
+        app2 :: H (B t) (bound at T10403.hs:28:1)
+
+T10403.hs:28:20: warning: [-Wdeferred-type-errors (in -Wdefault)]
+    • Couldn't match type ‘f0’ with ‘B t’
+        because type variable ‘t’ would escape its scope
+      This (rigid, skolem) type variable is bound by
+        the type signature for:
+          app2 :: H (B t)
+        at T10403.hs:27:1-15
+      Expected type: f0 ()
+        Actual type: B t ()
+    • In the second argument of ‘h2’, namely ‘(B ())’
+      In the expression: h2 (H . I) (B ())
+      In an equation for ‘app2’: app2 = h2 (H . I) (B ())
+    • Relevant bindings include
+        app2 :: H (B t) (bound at T10403.hs:28:1)
+
index c2a9db5..c7420eb 100644 (file)
@@ -1,38 +1,45 @@
-\r
-T11192.hs:7:14: warning: [-Wpartial-type-signatures (in -Wdefault)]\r
-    • Found type wildcard ‘_’ standing for ‘Int -> t -> t’\r
-      Where: ‘t’ is a rigid type variable bound by\r
-               the inferred type of go :: Int -> t -> t at T11192.hs:8:8-17\r
-    • In the type signature: go :: _\r
-      In the expression:\r
-        let\r
-          go :: _\r
-          go 0 a = a\r
-        in go (0 :: Int) undefined\r
-      In an equation for ‘fails’:\r
-          fails\r
-            = let\r
-                go :: _\r
-                go 0 a = a\r
-              in go (0 :: Int) undefined\r
-    • Relevant bindings include fails :: a (bound at T11192.hs:6:1)\r
-\r
-T11192.hs:13:14: warning: [-Wpartial-type-signatures (in -Wdefault)]\r
-    • Found type wildcard ‘_’ standing for ‘t1 -> t -> t’\r
-      Where: ‘t’ is a rigid type variable bound by\r
-               the inferred type of go :: t1 -> t -> t at T11192.hs:14:8-17\r
-             ‘t1’ is a rigid type variable bound by\r
-               the inferred type of go :: t1 -> t -> t at T11192.hs:14:8-17\r
-    • In the type signature: go :: _\r
-      In the expression:\r
-        let\r
-          go :: _\r
-          go _ a = a\r
-        in go (0 :: Int) undefined\r
-      In an equation for ‘succeeds’:\r
-          succeeds\r
-            = let\r
-                go :: _\r
-                go _ a = a\r
-              in go (0 :: Int) undefined\r
-    • Relevant bindings include succeeds :: a (bound at T11192.hs:12:1)\r
+
+T11192.hs:7:14: warning: [-Wpartial-type-signatures (in -Wdefault)]
+    • Found type wildcard ‘_’ standing for ‘Int -> t -> t’
+      Where: ‘t’ is a rigid type variable bound by
+               the inferred type of go :: Int -> t -> t at T11192.hs:8:8
+    • In the type signature:
+        go :: _
+      In the expression:
+        let
+          go :: _
+          go 0 a = a
+        in go (0 :: Int) undefined
+      In an equation for ‘fails’:
+          fails
+            = let
+                go :: _
+                go 0 a = a
+              in go (0 :: Int) undefined
+    • Relevant bindings include
+        go :: Int -> t -> t (bound at T11192.hs:8:8)
+        fails :: a (bound at T11192.hs:6:1)
+
+T11192.hs:13:14: warning: [-Wpartial-type-signatures (in -Wdefault)]
+    • Found type wildcard ‘_’ standing for ‘t -> t1 -> t1’
+      Where: ‘t’ is a rigid type variable bound by
+               the inferred type of go :: t -> t1 -> t1 at T11192.hs:14:8
+             ‘t1’ is a rigid type variable bound by
+               the inferred type of go :: t -> t1 -> t1 at T11192.hs:14:8
+    • In the type signature:
+        go :: _
+      In the expression:
+        let
+          go :: _
+          go _ a = a
+        in go (0 :: Int) undefined
+      In an equation for ‘succeeds’:
+          succeeds
+            = let
+                go :: _
+                go _ a = a
+              in go (0 :: Int) undefined
+    • Relevant bindings include
+        go :: t -> t1 -> t1 (bound at T11192.hs:14:8)
+        succeeds :: a (bound at T11192.hs:12:1)
+
index 74bfaae..e9cac55 100644 (file)
@@ -1,23 +1,26 @@
-\r
-T10045.hs:6:18: error:\r
-    • Found type wildcard ‘_’ standing for ‘t2 -> Bool -> t1’\r
-      Where: ‘t1’ is a rigid type variable bound by\r
-               the inferred type of copy :: t2 -> Bool -> t1 at T10045.hs:7:10-34\r
-             ‘t2’ is a rigid type variable bound by\r
-               the inferred type of copy :: t2 -> Bool -> t1 at T10045.hs:7:10-34\r
-      To use the inferred type, enable PartialTypeSignatures\r
-    • In the type signature: copy :: _\r
-      In the expression:\r
-        let\r
-          copy :: _\r
-          copy w from = copy w True\r
-        in copy ws1 False\r
-      In an equation for ‘foo’:\r
-          foo (Meta ws1)\r
-            = let\r
-                copy :: _\r
-                copy w from = copy w True\r
-              in copy ws1 False\r
-    • Relevant bindings include\r
-        ws1 :: () (bound at T10045.hs:5:11)\r
-        foo :: Meta -> t (bound at T10045.hs:5:1)\r
+
+T10045.hs:6:18: error:
+    • Found type wildcard ‘_’ standing for ‘t1 -> Bool -> t2’
+      Where: ‘t1’ is a rigid type variable bound by
+               the inferred type of copy :: t1 -> Bool -> t2 at T10045.hs:7:10
+             ‘t2’ is a rigid type variable bound by
+               the inferred type of copy :: t1 -> Bool -> t2 at T10045.hs:7:10
+      To use the inferred type, enable PartialTypeSignatures
+    • In the type signature:
+        copy :: _
+      In the expression:
+        let
+          copy :: _
+          copy w from = copy w True
+        in copy ws1 False
+      In an equation for ‘foo’:
+          foo (Meta ws1)
+            = let
+                copy :: _
+                copy w from = copy w True
+              in copy ws1 False
+    • Relevant bindings include
+        copy :: t1 -> Bool -> t2 (bound at T10045.hs:7:10)
+        ws1 :: () (bound at T10045.hs:5:11)
+        foo :: Meta -> t (bound at T10045.hs:5:1)
+
index 3e7f60e..409e66a 100644 (file)
@@ -1,13 +1,14 @@
-\r
-T9017.hs:8:7: error:\r
-    • Couldn't match kind ‘k1’ with ‘*’\r
-      ‘k1’ is a rigid type variable bound by\r
-        the type signature for:\r
-          foo :: forall k k1 (a :: k1 -> k -> *) (b :: k1) (m :: k1 -> k).\r
-                 a b (m b)\r
-        at T9017.hs:7:1-16\r
-      When matching the kind of ‘a’\r
-    • In the expression: arr return\r
-      In an equation for ‘foo’: foo = arr return\r
-    • Relevant bindings include\r
-        foo :: a b (m b) (bound at T9017.hs:8:1)\r
+
+T9017.hs:8:7: error:
+    • Couldn't match kind ‘k1’ with ‘*’
+      ‘k1’ is a rigid type variable bound by
+        the type signature for:
+          foo :: forall k k1 (a :: k -> k1 -> *) (b :: k) (m :: k -> k1).
+                 a b (m b)
+        at T9017.hs:7:8
+      When matching the kind of ‘a’
+    • In the expression: arr return
+      In an equation for ‘foo’: foo = arr return
+    • Relevant bindings include
+        foo :: a b (m b) (bound at T9017.hs:8:1)
+
index ff15398..03671b0 100644 (file)
@@ -1,6 +1,6 @@
 
 VtaFail.hs:7:16: error:
-    • Cannot apply expression of type ‘t1 -> t0 -> (t1, t0)’
+    • Cannot apply expression of type ‘t0 -> t1 -> (t0, t1)’
       to a visible type argument ‘Int’
     • In the expression: pairup_nosig @Int @Bool 5 True
       In an equation for ‘answer_nosig’:
index 09054c2..f833ba8 160000 (submodule)
@@ -1 +1 @@
-Subproject commit 09054c2c6ac346b19d0dec9a43956fcea1c272fb
+Subproject commit f833ba8cdbe6ea9436f9f7bf79494a968e8394f0