Major patch to introduce TyConBinder
authorSimon Peyton Jones <simonpj@microsoft.com>
Wed, 15 Jun 2016 12:27:12 +0000 (13:27 +0100)
committerSimon Peyton Jones <simonpj@microsoft.com>
Wed, 15 Jun 2016 16:36:02 +0000 (17:36 +0100)
Before this patch, following the TypeInType innovations,
each TyCon had two lists:
  - tyConBinders :: [TyBinder]
  - tyConTyVars  :: [TyVar]

They were in 1-1 correspondence and contained
overlapping information.  More broadly, there were many
places where we had to pass around this pair of lists,
instead of a single list.

This commit tidies all that up, by having just one list of
binders in a TyCon:

  - tyConBinders :: [TyConBinder]

The new data types look like this:

  Var.hs:
     data TyVarBndr tyvar vis = TvBndr tyvar vis
     data VisibilityFlag = Visible | Specified | Invisible
     type TyVarBinder = TyVarBndr TyVar VisibilityFlag

  TyCon.hs:
     type TyConBinder = TyVarBndr TyVar TyConBndrVis

     data TyConBndrVis
       = NamedTCB VisibilityFlag
       | AnonTCB

  TyCoRep.hs:
     data TyBinder
       = Named TyVarBinder
       | Anon Type

Note that Var.TyVarBdr has moved from TyCoRep and has been
made polymorphic in the tyvar and visiblity fields:

     type TyVarBinder = TyVarBndr TyVar VisibilityFlag
        -- Used in ForAllTy
     type TyConBinder = TyVarBndr TyVar TyConBndrVis
        -- Used in TyCon

     type IfaceForAllBndr  = TyVarBndr IfaceTvBndr VisibilityFlag
     type IfaceTyConBinder = TyVarBndr IfaceTvBndr TyConBndrVis
         -- Ditto, in interface files

There are a zillion knock-on changes, but everything
arises from these types.  It was a bit fiddly to get the
module loops to work out right!

Some smaller points
~~~~~~~~~~~~~~~~~~~
* Nice new functions
    TysPrim.mkTemplateKiTyVars
    TysPrim.mkTemplateTyConBinders
  which help you make the tyvar binders for dependently-typed
  TyCons.  See comments with their definition.

* The change showed up a bug in TcGenGenerics.tc_mkRepTy, where the code
  was making an assumption about the order of the kind variables in the
  kind of GHC.Generics.(:.:).  I fixed this; see TcGenGenerics.mkComp.

104 files changed:
compiler/basicTypes/DataCon.hs
compiler/basicTypes/DataCon.hs-boot
compiler/basicTypes/MkId.hs
compiler/basicTypes/PatSyn.hs
compiler/basicTypes/Var.hs
compiler/coreSyn/CoreFVs.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/prelude/TysWiredIn.hs-boot
compiler/typecheck/Inst.hs
compiler/typecheck/TcBinds.hs
compiler/typecheck/TcCanonical.hs
compiler/typecheck/TcDeriv.hs
compiler/typecheck/TcFlatten.hs
compiler/typecheck/TcForeign.hs
compiler/typecheck/TcGenGenerics.hs
compiler/typecheck/TcHsSyn.hs
compiler/typecheck/TcHsType.hs
compiler/typecheck/TcInstDcls.hs
compiler/typecheck/TcInteract.hs
compiler/typecheck/TcMType.hs
compiler/typecheck/TcPatSyn.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/TcTypeNats.hs
compiler/typecheck/TcUnify.hs
compiler/typecheck/TcValidity.hs
compiler/types/Class.hs
compiler/types/TyCoRep.hs
compiler/types/TyCoRep.hs-boot
compiler/types/TyCon.hs
compiler/types/TyCon.hs-boot
compiler/types/Type.hs
compiler/types/Type.hs-boot
compiler/vectorise/Vectorise/Generic/PData.hs
compiler/vectorise/Vectorise/Type/Env.hs
compiler/vectorise/Vectorise/Type/TyConDecl.hs
testsuite/tests/ado/ado002.stderr
testsuite/tests/driver/werror.stderr
testsuite/tests/gadt/gadt13.stderr
testsuite/tests/gadt/gadt7.stderr
testsuite/tests/generics/T10604/T10604_deriving.stderr
testsuite/tests/ghci.debugger/scripts/break003.stderr
testsuite/tests/ghci.debugger/scripts/break003.stdout
testsuite/tests/ghci.debugger/scripts/break005.stdout
testsuite/tests/ghci.debugger/scripts/break006.stderr
testsuite/tests/ghci.debugger/scripts/break006.stdout
testsuite/tests/ghci.debugger/scripts/hist001.stdout
testsuite/tests/ghci/prog010/ghci.prog010.stdout
testsuite/tests/ghci/scripts/T11524a.stdout
testsuite/tests/ghci/scripts/T6018ghcifail.stderr
testsuite/tests/ghci/scripts/T7627.stdout
testsuite/tests/ghci/scripts/T8535.stdout
testsuite/tests/ghci/scripts/T8776.stdout
testsuite/tests/ghci/scripts/ghci013.stdout
testsuite/tests/ghci/scripts/ghci020.stdout
testsuite/tests/ghci/scripts/ghci059.stdout
testsuite/tests/ghci/should_run/T10145.stdout
testsuite/tests/indexed-types/should_compile/T3017.stderr
testsuite/tests/indexed-types/should_fail/ExtraTcsUntch.stderr
testsuite/tests/parser/should_fail/T7848.stderr
testsuite/tests/partial-sigs/should_compile/T10403.stderr
testsuite/tests/partial-sigs/should_compile/T11192.stderr
testsuite/tests/partial-sigs/should_compile/T12033.stderr
testsuite/tests/partial-sigs/should_compile/WarningWildcardInstantiations.stderr
testsuite/tests/partial-sigs/should_fail/T10045.stderr
testsuite/tests/partial-sigs/should_fail/WildcardInstantiations.stderr
testsuite/tests/patsyn/should_compile/T11213.stderr
testsuite/tests/patsyn/should_fail/T11053.stderr
testsuite/tests/patsyn/should_run/ghci.stdout
testsuite/tests/polykinds/T7328.stderr
testsuite/tests/polykinds/T7438.stderr
testsuite/tests/polykinds/T9017.stderr
testsuite/tests/rebindable/rebindable6.stderr
testsuite/tests/rename/should_fail/T10618.stderr
testsuite/tests/typecheck/should_compile/tc141.stderr
testsuite/tests/typecheck/should_fail/FailDueToGivenOverlapping.stderr
testsuite/tests/typecheck/should_fail/T10351.stderr
testsuite/tests/typecheck/should_fail/T11355.stderr
testsuite/tests/typecheck/should_fail/T5858.stderr
testsuite/tests/typecheck/should_fail/T6018fail.stderr
testsuite/tests/typecheck/should_fail/T8142.stderr
testsuite/tests/typecheck/should_fail/T9109.stderr
testsuite/tests/typecheck/should_fail/VtaFail.stderr
testsuite/tests/typecheck/should_fail/tcfail001.stderr
testsuite/tests/typecheck/should_fail/tcfail010.stderr
testsuite/tests/typecheck/should_fail/tcfail012.stderr
testsuite/tests/typecheck/should_fail/tcfail013.stderr
testsuite/tests/typecheck/should_fail/tcfail016.stderr
testsuite/tests/typecheck/should_fail/tcfail033.stderr
testsuite/tests/typecheck/should_fail/tcfail069.stderr
testsuite/tests/typecheck/should_fail/tcfail182.stderr
testsuite/tests/typecheck/should_fail/tcfail201.stderr

index b5a2263..670754d 100644 (file)
@@ -77,7 +77,9 @@ import BasicTypes
 import FastString
 import Module
 import Binary
+import UniqSet
 import UniqFM
+import Unique( mkAlphaTyVarUnique )
 
 import qualified Data.Data as Data
 import Data.Char
@@ -797,20 +799,50 @@ mkDataCon name declared_infix prom_info
 
     rep_ty = mkForAllTys univ_tvs $ mkForAllTys ex_tvs $
              mkFunTys rep_arg_tys $
-             mkTyConApp rep_tycon (mkTyVarTys (map binderVar univ_tvs))
+             mkTyConApp rep_tycon (mkTyVarTys (binderVars univ_tvs))
 
       -- See Note [Promoted data constructors] in TyCon
-    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
+    prom_tv_bndrs = [ mkNamedTyConBinder vis tv
+                    | TvBndr tv vis <- filterEqSpec eq_spec univ_tvs ++ ex_tvs ]
+
+    prom_arg_bndrs = mkCleanAnonTyConBinders prom_tv_bndrs (theta ++ orig_arg_tys)
+    prom_res_kind  = orig_res_ty
+    promoted       = mkPromotedDataCon con name prom_info
+                                       (prom_tv_bndrs ++ prom_arg_bndrs)
+                                       prom_res_kind roles rep_info
 
     roles = map (const Nominal) (univ_tvs ++ ex_tvs) ++
             map (const Representational) orig_arg_tys
 
+mkCleanAnonTyConBinders :: [TyConBinder] -> [Type] -> [TyConBinder]
+-- Make sure that the "anonymous" tyvars don't clash in
+-- name or unique with the universal/existential ones.
+-- Tiresome!  And unnecessary because these tyvars are never looked at
+mkCleanAnonTyConBinders tc_bndrs tys
+  = [ mkAnonTyConBinder (mkTyVar name ty)
+    | (name, ty) <- fresh_names `zip` tys ]
+  where
+    fresh_names = freshNames (map getName (binderVars tc_bndrs))
+
+freshNames :: [Name] -> [Name]
+-- Make names whose Uniques and OccNames differ from
+-- those in the 'avoid' list
+freshNames avoids
+  = [ mkSystemName uniq occ
+    | n <- [0..]
+    , let uniq = mkAlphaTyVarUnique n
+          occ = mkTyVarOccFS (mkFastString ('x' : show n))
+
+    , not (uniq `elementOfUniqSet` avoid_uniqs)
+    , not (occ `elemOccSet` avoid_occs) ]
+
+  where
+    avoid_uniqs :: UniqSet Unique
+    avoid_uniqs = mkUniqSet (map getUnique avoids)
+
+    avoid_occs :: OccSet
+    avoid_occs = mkOccSet (map getOccName avoids)
+
 -- | The 'Name' of the 'DataCon', giving it a unique, rooted identification
 dataConName :: DataCon -> Name
 dataConName = dcName
@@ -842,7 +874,7 @@ dataConIsInfix = dcInfix
 
 -- | The universally-quantified type variables of the constructor
 dataConUnivTyVars :: DataCon -> [TyVar]
-dataConUnivTyVars (MkData { dcUnivTyVars = tvbs }) = map binderVar tvbs
+dataConUnivTyVars (MkData { dcUnivTyVars = tvbs }) = binderVars tvbs
 
 -- | 'TyBinder's for the universally-quantified type variables
 dataConUnivTyVarBinders :: DataCon -> [TyVarBinder]
@@ -850,7 +882,7 @@ dataConUnivTyVarBinders = dcUnivTyVars
 
 -- | The existentially-quantified type variables of the constructor
 dataConExTyVars :: DataCon -> [TyVar]
-dataConExTyVars (MkData { dcExTyVars = tvbs }) = map binderVar tvbs
+dataConExTyVars (MkData { dcExTyVars = tvbs }) = binderVars tvbs
 
 -- | 'TyBinder's for the existentially-quantified type variables
 dataConExTyVarBinders :: DataCon -> [TyVarBinder]
@@ -859,7 +891,7 @@ dataConExTyVarBinders = dcExTyVars
 -- | Both the universal and existentiatial type variables of the constructor
 dataConAllTyVars :: DataCon -> [TyVar]
 dataConAllTyVars (MkData { dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs })
-  = map binderVar (univ_tvs ++ ex_tvs)
+  = binderVars (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
@@ -1014,9 +1046,9 @@ dataConInstSig (MkData { dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs
     , substTheta subst (eqSpecPreds eq_spec ++ theta)
     , substTys   subst arg_tys)
   where
-    univ_subst = zipTvSubst (map binderVar univ_tvs) univ_tys
+    univ_subst = zipTvSubst (binderVars univ_tvs) univ_tys
     (subst, ex_tvs') = mapAccumL Type.substTyVarBndr univ_subst $
-                       map binderVar ex_tvs
+                       binderVars ex_tvs
 
 
 -- | The \"full signature\" of the 'DataCon' returns, in order:
@@ -1038,7 +1070,7 @@ dataConFullSig :: DataCon
 dataConFullSig (MkData {dcUnivTyVars = univ_tvs, dcExTyVars = ex_tvs,
                         dcEqSpec = eq_spec, dcOtherTheta = theta,
                         dcOrigArgTys = arg_tys, dcOrigResTy = res_ty})
-  = (map binderVar univ_tvs, map binderVar ex_tvs, eq_spec, theta, arg_tys, res_ty)
+  = (binderVars univ_tvs, binderVars ex_tvs, eq_spec, theta, arg_tys, res_ty)
 
 dataConOrigResTy :: DataCon -> Type
 dataConOrigResTy dc = dcOrigResTy dc
@@ -1086,7 +1118,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 (map binderVar univ_tvs) inst_tys) (dataConRepArgTys dc)
+   map (substTyWith (binderVars univ_tvs) inst_tys) (dataConRepArgTys dc)
 
 -- | Returns just the instantiated /value/ argument types of a 'DataCon',
 -- (excluding dictionary args)
@@ -1104,7 +1136,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 = map binderVar (univ_tvs ++ ex_tvs)
+    tyvars = binderVars (univ_tvs ++ ex_tvs)
 
 -- | Returns the argument types of the wrapper, excluding all dictionary arguments
 -- and without substituting for any type variables
@@ -1265,7 +1297,7 @@ buildAlgTyCon :: Name
 
 buildAlgTyCon tc_name ktvs roles cType stupid_theta rhs
               is_rec gadt_syn parent
-  = mkAlgTyCon tc_name binders liftedTypeKind ktvs roles cType stupid_theta
+  = mkAlgTyCon tc_name binders liftedTypeKind roles cType stupid_theta
                rhs parent is_rec gadt_syn
   where
-    binders = mkTyBindersPreferAnon ktvs liftedTypeKind
+    binders = mkTyConBindersPreferAnon ktvs liftedTypeKind
index 6de1f27..7f512c2 100644 (file)
@@ -1,12 +1,12 @@
 module DataCon where
-import Var( TyVar )
+import Var( TyVar, TyVarBinder )
 import Name( Name, NamedThing )
 import {-# SOURCE #-} TyCon( TyCon )
 import FieldLabel ( FieldLabel )
 import Unique ( Uniquable )
 import Outputable ( Outputable, OutputableBndr )
 import BasicTypes (Arity)
-import {-# SOURCE #-} TyCoRep (Type, ThetaType, TyVarBinder)
+import {-# SOURCE #-} TyCoRep ( Type, ThetaType )
 
 data DataCon
 data DataConRep
index 1ac5597..e146c66 100644 (file)
@@ -280,7 +280,7 @@ mkDictSelId name clas
     val_index      = assoc "MkId.mkDictSelId" (sel_names `zip` [0..]) name
 
     sel_ty = mkForAllTys tyvars $
-             mkFunTy (mkClassPred clas (mkTyVarTys (map binderVar tyvars))) $
+             mkFunTy (mkClassPred clas (mkTyVarTys (binderVars tyvars))) $
              getNth arg_tys val_index
 
     base_info = noCafIdInfo
@@ -1066,22 +1066,17 @@ dollarId = pcMiscPrelId dollarName ty
              App (Var f) (Var x)
 
 ------------------------------------------------
--- proxy# :: forall a. Proxy# a
 proxyHashId :: Id
 proxyHashId
   = pcMiscPrelId proxyName ty
        (noCafIdInfo `setUnfoldingInfo` evaldUnfolding) -- Note [evaldUnfoldings]
   where
-    ty      = mkSpecForAllTys [kv, tv] (mkProxyPrimTy k t)
-    kv      = kKiVar
-    k       = mkTyVarTy kv
-    [tv]    = mkTemplateTyVars [k]
-    t       = mkTyVarTy tv
+    -- proxy# :: forall k (a:k). Proxy# k a
+    bndrs   = mkTemplateKiTyVars [liftedTypeKind] (\ks -> ks)
+    [k,t]   = mkTyVarTys bndrs
+    ty      = mkSpecForAllTys bndrs (mkProxyPrimTy k t)
 
 ------------------------------------------------
--- unsafeCoerce# :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep)
---                         (a :: TYPE r1) (b :: TYPE r2).
---                         a -> b
 unsafeCoerceId :: Id
 unsafeCoerceId
   = pcMiscPrelId unsafeCoerceName ty info
@@ -1089,14 +1084,19 @@ unsafeCoerceId
     info = noCafIdInfo `setInlinePragInfo` alwaysInlinePragma
                        `setUnfoldingInfo`  mkCompulsoryUnfolding rhs
 
-    tvs = [ runtimeRep1TyVar, runtimeRep2TyVar
-          , openAlphaTyVar, openBetaTyVar ]
+    -- unsafeCoerce# :: forall (r1 :: RuntimeRep) (r2 :: RuntimeRep)
+    --                         (a :: TYPE r1) (b :: TYPE r2).
+    --                         a -> b
+    bndrs = mkTemplateKiTyVars [runtimeRepTy, runtimeRepTy]
+                               (\ks -> map tYPE ks)
 
-    ty  = mkSpecForAllTys tvs $ mkFunTy openAlphaTy openBetaTy
+    [_, _, a, b] = mkTyVarTys bndrs
 
-    [x] = mkTemplateLocals [openAlphaTy]
-    rhs = mkLams (tvs ++ [x]) $
-          Cast (Var x) (mkUnsafeCo Representational openAlphaTy openBetaTy)
+    ty  = mkSpecForAllTys bndrs (mkFunTy a b)
+
+    [x] = mkTemplateLocals [a]
+    rhs = mkLams (bndrs ++ [x]) $
+          Cast (Var x) (mkUnsafeCo Representational a b)
 
 ------------------------------------------------
 nullAddrId :: Id
index 2510d71..3b51452 100644 (file)
@@ -359,7 +359,7 @@ patSynUnivTyVarBinders :: PatSyn -> [TyVarBinder]
 patSynUnivTyVarBinders = psUnivTyVars
 
 patSynExTyVars :: PatSyn -> [TyVar]
-patSynExTyVars ps = map binderVar (psExTyVars ps)
+patSynExTyVars ps = binderVars (psExTyVars ps)
 
 patSynExTyVarBinders :: PatSyn -> [TyVarBinder]
 patSynExTyVarBinders = psExTyVars
@@ -368,7 +368,7 @@ 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 })
-  = (map binderVar univ_tvs, req, map binderVar ex_tvs, prov, arg_tys, res_ty)
+  = (binderVars univ_tvs, req, binderVars ex_tvs, prov, arg_tys, res_ty)
 
 patSynMatcher :: PatSyn -> (Id,Bool)
 patSynMatcher = psMatcher
@@ -397,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 = map binderVar (univ_tvs ++ ex_tvs)
+    tyvars = binderVars (univ_tvs ++ ex_tvs)
 
 patSynInstResTy :: PatSyn -> [Type] -> Type
 -- Return the type of whole pattern
@@ -410,7 +410,7 @@ 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 (map binderVar univ_tvs) inst_tys res_ty
+    substTyWith (binderVars univ_tvs) inst_tys res_ty
 
 -- | Print the type of a pattern synonym. The foralls are printed explicitly
 pprPatSynType :: PatSyn -> SDoc
index 8d308ad..a9912d3 100644 (file)
@@ -5,7 +5,7 @@
 \section{@Vars@: Variables}
 -}
 
-{-# LANGUAGE CPP, MultiWayIf #-}
+{-# LANGUAGE CPP, MultiWayIf, FlexibleInstances, DeriveDataTypeable #-}
 
 -- |
 -- #name_types#
@@ -56,7 +56,12 @@ module Var (
         isGlobalId, isExportedId,
         mustHaveLocalBinding,
 
-        -- ** Constructing 'TyVar's
+        -- * TyVar's
+        TyVarBndr(..), VisibilityFlag(..), TyVarBinder,
+        binderVar, binderVars, binderVisibility, binderKind,
+        isVisible, isInvisible, sameVis,
+
+        -- ** Constructing TyVar's
         mkTyVar, mkTcTyVar,
 
         -- ** Taking 'TyVar's apart
@@ -77,12 +82,13 @@ import {-# SOURCE #-}   TcType( TcTyVarDetails, pprTcTyVarDetails, vanillaSkolem
 import {-# SOURCE #-}   IdInfo( IdDetails, IdInfo, coVarDetails, isCoVarDetails, vanillaIdInfo, pprIdDetails )
 
 import Name hiding (varName)
-import Unique
+import Unique ( Uniquable, Unique, getKey, getUnique
+              , mkUniqueGrimily, nonDetCmpUnique )
 import Util
+import Binary
 import DynFlags
 import Outputable
 
-import Unique (nonDetCmpUnique)
 import Data.Data
 
 {-
@@ -309,10 +315,69 @@ updateVarTypeM :: Monad m => (Type -> m Type) -> Id -> m Id
 updateVarTypeM f id = do { ty' <- f (varType id)
                          ; return (id { varType = ty' }) }
 
+{- *********************************************************************
+*                                                                      *
+*                   VisibilityFlag
+*                                                                      *
+********************************************************************* -}
+
+-- | Is something required to appear in source Haskell ('Visible'),
+-- permitted by request ('Specified') (visible type application), or
+-- prohibited entirely from appearing in source Haskell ('Invisible')?
+-- See Note [TyBinders and VisibilityFlags] in TyCoRep
+data VisibilityFlag = Visible | Specified | Invisible
+  deriving (Eq, Data)
+
+isVisible :: VisibilityFlag -> Bool
+isVisible Visible = True
+isVisible _       = False
+
+isInvisible :: VisibilityFlag -> Bool
+isInvisible v = not (isVisible v)
+
+-- | Do these denote the same level of visibility? Except that
+-- 'Specified' and 'Invisible' are considered the same. Used
+-- for printing.
+sameVis :: VisibilityFlag -> VisibilityFlag -> Bool
+sameVis Visible Visible = True
+sameVis Visible _       = False
+sameVis _       Visible = False
+sameVis _       _       = True
+
+
+{- *********************************************************************
+*                                                                      *
+*                   TyVarBndr, TyVarBinder
+*                                                                      *
+********************************************************************* -}
+
+-- TyVarBndr is polymorphic in both tyvar and visiblity fields:
+--   * tyvar can be TyVar or IfaceTv
+--   * vis   can be VisibilityFlag or TyConBndrVis
+data TyVarBndr tyvar vis = TvBndr tyvar vis
+  deriving( Data )
+
+-- | A `TyVarBinder` is the binder of a ForAllTy
+-- It's convenient to define this synonym here rather its natural
+-- home in TyCoRep, because it's used in DataCon.hs-boot
+type TyVarBinder = TyVarBndr TyVar VisibilityFlag
+
+binderVar :: TyVarBndr tv vis -> tv
+binderVar (TvBndr v _) = v
+
+binderVars :: [TyVarBndr tv vis] -> [tv]
+binderVars tvbs = map binderVar tvbs
+
+binderVisibility :: TyVarBndr tv vis -> vis
+binderVisibility (TvBndr _ vis) = vis
+
+binderKind :: TyVarBndr TyVar vis -> Kind
+binderKind (TvBndr tv _) = tyVarKind tv
+
 {-
 ************************************************************************
 *                                                                      *
-\subsection{Type and kind variables}
+*                 Type and kind variables                              *
 *                                                                      *
 ************************************************************************
 -}
@@ -363,6 +428,35 @@ tcTyVarDetails var = pprPanic "tcTyVarDetails" (ppr var <+> dcolon <+> pprKind (
 setTcTyVarDetails :: TyVar -> TcTyVarDetails -> TyVar
 setTcTyVarDetails tv details = tv { tc_tv_details = details }
 
+-------------------------------------
+instance Outputable tv => Outputable (TyVarBndr tv VisibilityFlag) where
+  ppr (TvBndr v Visible)   = ppr v
+  ppr (TvBndr v Specified) = char '@' <> ppr v
+  ppr (TvBndr v Invisible) = braces (ppr v)
+
+instance Outputable VisibilityFlag where
+  ppr Visible   = text "[vis]"
+  ppr Specified = text "[spec]"
+  ppr Invisible = text "[invis]"
+
+instance (Binary tv, Binary vis) => Binary (TyVarBndr tv vis) where
+  put_ bh (TvBndr tv vis) = do { put_ bh tv; put_ bh vis }
+
+  get bh = do { tv <- get bh; vis <- get bh; return (TvBndr tv vis) }
+
+
+instance Binary VisibilityFlag where
+  put_ bh Visible   = putByte bh 0
+  put_ bh Specified = putByte bh 1
+  put_ bh Invisible = putByte bh 2
+
+  get bh = do
+    h <- getByte bh
+    case h of
+      0 -> return Visible
+      1 -> return Specified
+      _ -> return Invisible
+
 {-
 %************************************************************************
 %*                                                                      *
index 09ef7f8..bab7f5f 100644 (file)
@@ -352,7 +352,7 @@ orphNamesOfType (TyVarTy _)          = emptyNameSet
 orphNamesOfType (LitTy {})           = emptyNameSet
 orphNamesOfType (TyConApp tycon tys) = orphNamesOfTyCon tycon
                                        `unionNameSet` orphNamesOfTypes tys
-orphNamesOfType (ForAllTy bndr res)  = orphNamesOfType (binderType bndr)
+orphNamesOfType (ForAllTy bndr res)  = orphNamesOfType (binderKind bndr)
                                        `unionNameSet` orphNamesOfType res
 orphNamesOfType (FunTy arg res)      = unitNameSet funTyConName    -- NB!  See Trac #8535
                                        `unionNameSet` orphNamesOfType arg
index c20a5ee..df52b44 100644 (file)
@@ -6,7 +6,7 @@
 {-# LANGUAGE CPP #-}
 
 module BuildTyCl (
-        buildDataCon,
+        buildDataCon, mkDataConUnivTyVarBinders,
         buildPatSyn,
         TcMethInfo, buildClass,
         distinctAbstractTyConRhs, totallyAbstractTyConRhs,
@@ -29,7 +29,6 @@ import MkId
 import Class
 import TyCon
 import Type
-import TyCoRep( TyBinder(..), TyVarBinder(..) )
 import Id
 import TcType
 
@@ -112,8 +111,8 @@ buildDataCon :: FamInstEnvs
             -> Maybe [HsImplBang]
                 -- See Note [Bangs on imported data constructors] in MkId
            -> [FieldLabel]             -- Field labels
-           -> [TyVar] -> [TyBinder]    -- Universals
-           -> [TyVarBinder]            -- existentials
+           -> [TyVarBinder]            -- Universals
+           -> [TyVarBinder]            -- Existentials
            -> [EqSpec]                 -- Equality spec
            -> ThetaType                -- Does not include the "stupid theta"
                                        -- or the GADT equalities
@@ -126,7 +125,7 @@ buildDataCon :: FamInstEnvs
 --      allocating its unique (hence monadic)
 --   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 eq_spec ctxt arg_tys res_ty rep_tycon
+             univ_tvs 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
@@ -136,11 +135,10 @@ 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    = mkDataConUnivTyVarBinders univ_tvs univ_bndrs
-              stupid_ctxt = mkDataConStupidTheta rep_tycon arg_tys univ_tvs
+        ; let stupid_ctxt = mkDataConStupidTheta rep_tycon arg_tys univ_tvs
               data_con = mkDataCon src_name declared_infix prom_info
                                    src_bangs field_lbls
-                                   dc_bndrs ex_tvs eq_spec ctxt
+                                   univ_tvs 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
@@ -155,12 +153,13 @@ buildDataCon fam_envs src_name declared_infix prom_info src_bangs impl_bangs fie
 -- the type variables mentioned in the arg_tys
 -- ToDo: Or functionally dependent on?
 --       This whole stupid theta thing is, well, stupid.
-mkDataConStupidTheta :: TyCon -> [Type] -> [TyVar] -> [PredType]
+mkDataConStupidTheta :: TyCon -> [Type] -> [TyVarBinder] -> [PredType]
 mkDataConStupidTheta tycon arg_tys univ_tvs
   | null stupid_theta = []      -- The common case
   | otherwise         = filter in_arg_tys stupid_theta
   where
-    tc_subst     = zipTvSubst (tyConTyVars tycon) (mkTyVarTys univ_tvs)
+    tc_subst     = zipTvSubst (tyConTyVars tycon)
+                              (mkTyVarTys (binderVars univ_tvs))
     stupid_theta = substTheta tc_subst (tyConStupidTheta tycon)
         -- Start by instantiating the master copy of the
         -- stupid theta, taken from the TyCon
@@ -170,18 +169,18 @@ mkDataConStupidTheta tycon arg_tys univ_tvs
                       tyCoVarsOfType pred `intersectVarSet` arg_tyvars
 
 
-mkDataConUnivTyVarBinders :: [TyVar] -> [TyBinder]   -- From the TyCon
-                          -> [TyVarBinder]           -- For the DataCon
+mkDataConUnivTyVarBinders :: [TyConBinder]   -- From the TyCon
+                          -> [TyVarBinder]   -- For the DataCon
 -- See Note [Building the TyBinders for a DataCon]
-mkDataConUnivTyVarBinders tvs bndrs
- = zipWith mk_binder tvs bndrs
+mkDataConUnivTyVarBinders tc_bndrs
+ = map mk_binder tc_bndrs
  where
-   mk_binder tv bndr = mkTyVarBinder vis tv
+   mk_binder (TvBndr tv tc_vis) = mkTyVarBinder vis tv
       where
-        vis = case bndr of
-                Anon _                   -> Specified
-                Named (TvBndr _ Visible) -> Specified
-                Named (TvBndr _ vis)     -> vis
+        vis = case tc_vis of
+                AnonTCB          -> Specified
+                NamedTCB Visible -> Specified
+                NamedTCB vis     -> vis
 
 {- Note [Building the TyBinders for a DataCon]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
@@ -272,7 +271,7 @@ buildPatSyn src_name declared_infix matcher@(matcher_id,_) builder
     (arg_tys1, _) = tcSplitFunTys cont_tau
     twiddle = char '~'
     subst = zipTvSubst (univ_tvs1 ++ ex_tvs1)
-                       (mkTyVarTys (map binderVar (univ_tvs ++ ex_tvs)))
+                       (mkTyVarTys (binderVars (univ_tvs ++ ex_tvs)))
 
 ------------------------------------------------------
 type TcMethInfo = (Name, Type, Maybe (DefMethSpec Type))
@@ -280,8 +279,8 @@ type TcMethInfo = (Name, Type, Maybe (DefMethSpec Type))
         -- tcClassSigs and buildClass.
 
 buildClass :: Name  -- Name of the class/tycon (they have the same Name)
-           -> [TyVar] -> [Role] -> ThetaType
-           -> [TyBinder]                   -- of the tycon
+           -> [TyConBinder]                -- Of the tycon
+           -> [Role] -> ThetaType
            -> [FunDep TyVar]               -- Functional dependencies
            -> [ClassATItem]                -- Associated types
            -> [TcMethInfo]                 -- Method info
@@ -289,7 +288,7 @@ buildClass :: Name  -- Name of the class/tycon (they have the same Name)
            -> RecFlag                      -- Info for type constructor
            -> TcRnIf m n Class
 
-buildClass tycon_name tvs roles sc_theta binders
+buildClass tycon_name binders roles sc_theta
            fds at_items sig_stuff mindef tc_isrec
   = fixM  $ \ rec_clas ->       -- Only name generation inside loop
     do  { traceIf (text "buildClass")
@@ -325,11 +324,13 @@ buildClass tycon_name tvs roles sc_theta binders
                 -- That means that in the case of
                 --     class C a => D a
                 -- we don't get a newtype with no arguments!
-              args      = sc_sel_names ++ op_names
-              op_tys    = [ty | (_,ty,_) <- sig_stuff]
-              op_names  = [op | (op,_,_) <- sig_stuff]
-              arg_tys   = sc_theta ++ op_tys
-              rec_tycon = classTyCon rec_clas
+              args       = sc_sel_names ++ op_names
+              op_tys     = [ty | (_,ty,_) <- sig_stuff]
+              op_names   = [op | (op,_,_) <- sig_stuff]
+              arg_tys    = sc_theta ++ op_tys
+              rec_tycon  = classTyCon rec_clas
+              univ_bndrs = mkDataConUnivTyVarBinders binders
+              univ_tvs   = binderVars univ_bndrs
 
         ; rep_nm   <- newTyConRepName datacon_name
         ; dict_con <- buildDataCon (panic "buildClass: FamInstEnvs")
@@ -339,12 +340,12 @@ buildClass tycon_name tvs roles sc_theta binders
                                    (map (const no_bang) args)
                                    (Just (map (const HsLazy) args))
                                    [{- No fields -}]
-                                   tvs binders
+                                   univ_bndrs
                                    [{- no existentials -}]
                                    [{- No GADT equalities -}]
                                    [{- No theta -}]
                                    arg_tys
-                                   (mkTyConApp rec_tycon (mkTyVarTys tvs))
+                                   (mkTyConApp rec_tycon (mkTyVarTys univ_tvs))
                                    rec_tycon
 
         ; rhs <- if use_newtype
@@ -354,7 +355,7 @@ buildClass tycon_name tvs roles sc_theta binders
                                          , tup_sort = ConstraintTuple })
                  else return (mkDataTyConRhs [dict_con])
 
-        ; let { tycon = mkClassTyCon tycon_name binders tvs roles
+        ; let { tycon = mkClassTyCon tycon_name binders roles
                                      rhs rec_clas tc_isrec tc_rep_name
                 -- A class can be recursive, and in the case of newtypes
                 -- this matters.  For example
@@ -365,7 +366,7 @@ buildClass tycon_name tvs roles sc_theta binders
                 -- newtype like a synonym, but that will lead to an infinite
                 -- type]
 
-              ; result = mkClass tvs fds
+              ; result = mkClass tycon_name univ_tvs fds
                                  sc_theta sc_sel_ids at_items
                                  op_items mindef tycon
               }
index 0ad4b0f..283da53 100644 (file)
@@ -57,6 +57,7 @@ import SrcLoc
 import Fingerprint
 import Binary
 import BooleanFormula ( BooleanFormula, pprBooleanFormula, isTrue )
+import Var( TyVarBndr(..) )
 import TyCon ( Role (..), Injectivity(..) )
 import StaticFlags (opt_PprStyle_Debug)
 import Util( filterOut, filterByList )
@@ -972,7 +973,7 @@ ppr_rough Nothing   = dot
 ppr_rough (Just tc) = ppr tc
 
 tv_to_forall_bndr :: IfaceTvBndr -> IfaceForAllBndr
-tv_to_forall_bndr tv = IfaceTv tv Specified
+tv_to_forall_bndr tv = TvBndr tv Specified
 
 {-
 Note [Result type of a data family GADT]
@@ -1158,22 +1159,22 @@ freeNamesIfDecl (IfaceId _s t d i) =
   freeNamesIfIdInfo i &&&
   freeNamesIfIdDetails d
 freeNamesIfDecl d@IfaceData{} =
-  freeNamesIfTyBinders (ifBinders d) &&&
+  freeNamesIfTyVarBndrs (ifBinders d) &&&
   freeNamesIfType (ifResKind d) &&&
   freeNamesIfaceTyConParent (ifParent d) &&&
   freeNamesIfContext (ifCtxt d) &&&
   freeNamesIfConDecls (ifCons d)
 freeNamesIfDecl d@IfaceSynonym{} =
   freeNamesIfType (ifSynRhs d) &&&
-  freeNamesIfTyBinders (ifBinders d) &&&
+  freeNamesIfTyVarBndrs (ifBinders d) &&&
   freeNamesIfKind (ifResKind d)
 freeNamesIfDecl d@IfaceFamily{} =
   freeNamesIfFamFlav (ifFamFlav d) &&&
-  freeNamesIfTyBinders (ifBinders d) &&&
+  freeNamesIfTyVarBndrs (ifBinders d) &&&
   freeNamesIfKind (ifResKind d)
 freeNamesIfDecl d@IfaceClass{} =
   freeNamesIfContext (ifCtxt d) &&&
-  freeNamesIfTyBinders (ifBinders d) &&&
+  freeNamesIfTyVarBndrs (ifBinders d) &&&
   fnList freeNamesIfAT     (ifATs d) &&&
   fnList freeNamesIfClsSig (ifSigs d)
 freeNamesIfDecl d@IfaceAxiom{} =
@@ -1182,8 +1183,8 @@ freeNamesIfDecl d@IfaceAxiom{} =
 freeNamesIfDecl d@IfacePatSyn{} =
   unitNameSet (fst (ifPatMatcher d)) &&&
   maybe emptyNameSet (unitNameSet . fst) (ifPatBuilder d) &&&
-  fnList freeNamesIfForAllBndr (ifPatUnivBndrs d) &&&
-  fnList freeNamesIfForAllBndr (ifPatExBndrs d) &&&
+  freeNamesIfTyVarBndrs (ifPatUnivBndrs d) &&&
+  freeNamesIfTyVarBndrs (ifPatExBndrs d) &&&
   freeNamesIfContext (ifPatProvCtxt d) &&&
   freeNamesIfContext (ifPatReqCtxt d) &&&
   fnList freeNamesIfType (ifPatArgs d) &&&
@@ -1194,11 +1195,11 @@ freeNamesIfAxBranch :: IfaceAxBranch -> NameSet
 freeNamesIfAxBranch (IfaceAxBranch { ifaxbTyVars   = tyvars
                                    , ifaxbCoVars   = covars
                                    , ifaxbLHS      = lhs
-                                   , ifaxbRHS      = rhs }) =
-  freeNamesIfTvBndrs tyvars &&&
-  fnList freeNamesIfIdBndr covars &&&
-  freeNamesIfTcArgs lhs &&&
-  freeNamesIfType rhs
+                                   , ifaxbRHS      = rhs })
+  = fnList freeNamesIfTvBndr tyvars &&&
+    fnList freeNamesIfIdBndr covars &&&
+    freeNamesIfTcArgs lhs &&&
+    freeNamesIfType rhs
 
 freeNamesIfIdDetails :: IfaceIdDetails -> NameSet
 freeNamesIfIdDetails (IfRecSelId tc _) =
@@ -1239,7 +1240,7 @@ freeNamesIfConDecls _                   = emptyNameSet
 
 freeNamesIfConDecl :: IfaceConDecl -> NameSet
 freeNamesIfConDecl c
-  = fnList freeNamesIfForAllBndr (ifConExTvs c) &&&
+  = freeNamesIfTyVarBndrs (ifConExTvs c) &&&
     freeNamesIfContext (ifConCtxt c) &&&
     fnList freeNamesIfType (ifConArgTys c) &&&
     fnList freeNamesIfType (map snd (ifConEqSpec c)) -- equality constraints
@@ -1258,8 +1259,7 @@ freeNamesIfType (IfaceAppTy s t)      = freeNamesIfType s &&& freeNamesIfType t
 freeNamesIfType (IfaceTyConApp tc ts) = freeNamesIfTc tc &&& freeNamesIfTcArgs ts
 freeNamesIfType (IfaceTupleTy _ _ ts) = freeNamesIfTcArgs ts
 freeNamesIfType (IfaceLitTy _)        = emptyNameSet
-freeNamesIfType (IfaceForAllTy tv t)  =
-   freeNamesIfForAllBndr tv &&& freeNamesIfType t
+freeNamesIfType (IfaceForAllTy tv t)  = freeNamesIfTyVarBndr tv &&& freeNamesIfType t
 freeNamesIfType (IfaceFunTy s t)      = freeNamesIfType s &&& freeNamesIfType t
 freeNamesIfType (IfaceDFunTy s t)     = freeNamesIfType s &&& freeNamesIfType t
 freeNamesIfType (IfaceCastTy t c)     = freeNamesIfType t &&& freeNamesIfCoercion c
@@ -1307,18 +1307,11 @@ freeNamesIfProv (IfacePhantomProv co)    = freeNamesIfCoercion co
 freeNamesIfProv (IfaceProofIrrelProv co) = freeNamesIfCoercion co
 freeNamesIfProv (IfacePluginProv _)      = emptyNameSet
 
-freeNamesIfTvBndrs :: [IfaceTvBndr] -> NameSet
-freeNamesIfTvBndrs = fnList freeNamesIfTvBndr
+freeNamesIfTyVarBndr :: TyVarBndr IfaceTvBndr vis -> NameSet
+freeNamesIfTyVarBndr (TvBndr tv _) = freeNamesIfTvBndr tv
 
-freeNamesIfForAllBndr :: IfaceForAllBndr -> NameSet
-freeNamesIfForAllBndr (IfaceTv tv _) = freeNamesIfTvBndr tv
-
-freeNamesIfTyBinder :: IfaceTyConBinder -> NameSet
-freeNamesIfTyBinder (IfaceAnon b)  = freeNamesIfTvBndr b
-freeNamesIfTyBinder (IfaceNamed b) = freeNamesIfForAllBndr b
-
-freeNamesIfTyBinders :: [IfaceTyConBinder] -> NameSet
-freeNamesIfTyBinders = fnList freeNamesIfTyBinder
+freeNamesIfTyVarBndrs :: [TyVarBndr IfaceTvBndr vis] -> NameSet
+freeNamesIfTyVarBndrs = fnList freeNamesIfTyVarBndr
 
 freeNamesIfBndr :: IfaceBndr -> NameSet
 freeNamesIfBndr (IfaceIdBndr b) = freeNamesIfIdBndr b
index fb2b3df..5a4e036 100644 (file)
@@ -17,8 +17,8 @@ module IfaceType (
         IfaceTyCon(..), IfaceTyConInfo(..),
         IfaceTyLit(..), IfaceTcArgs(..),
         IfaceContext, IfaceBndr(..), IfaceOneShot(..), IfaceLamBndr,
-        IfaceTvBndr, IfaceIdBndr, IfaceTyConBinder(..),
-        IfaceForAllBndr(..), VisibilityFlag(..),
+        IfaceTvBndr, IfaceIdBndr, IfaceTyConBinder,
+        IfaceForAllBndr, VisibilityFlag(..),
 
         ifConstraintKind, ifTyConBinderTyVar, ifTyConBinderName,
 
@@ -30,9 +30,8 @@ module IfaceType (
         toIfaceType, toIfaceTypes, toIfaceKind, toIfaceTyVar,
         toIfaceContext, toIfaceBndr, toIfaceIdBndr,
         toIfaceTyCon, toIfaceTyCon_name,
-        toIfaceTcArgs, toIfaceTvBndrs,
-        zipIfaceBinders, toDegenerateBinders,
-        binderToIfaceForAllBndr,
+        toIfaceTcArgs, toIfaceTvBndr, toIfaceTvBndrs,
+        toIfaceForAllBndr,
 
         -- Conversion from IfaceTcArgs -> IfaceType
         tcArgsIfaceTypes,
@@ -146,13 +145,8 @@ data IfaceTyLit
   | IfaceStrTyLit FastString
   deriving (Eq)
 
-data IfaceForAllBndr
-  = IfaceTv IfaceTvBndr VisibilityFlag
-
-data IfaceTyConBinder
-  = IfaceAnon  IfaceTvBndr      -- Like Anon, but it includes a name from
-                                -- which to produce a tyConTyVar
-  | IfaceNamed IfaceForAllBndr
+type IfaceTyConBinder = TyVarBndr IfaceTvBndr TyConBndrVis
+type IfaceForAllBndr  = TyVarBndr IfaceTvBndr VisibilityFlag
 
 -- See Note [Suppressing invisible arguments]
 -- We use a new list type (rather than [(IfaceType,Bool)], because
@@ -254,23 +248,17 @@ suppressIfaceInvisibles dflags tys xs
       suppress _       []      = []
       suppress []      a       = a
       suppress (k:ks) a@(_:xs)
-        | isIfaceInvisBndr k = suppress ks xs
-        | otherwise          = a
+        | isInvisibleTyConBinder k = suppress ks xs
+        | otherwise                = a
 
 stripIfaceInvisVars :: DynFlags -> [IfaceTyConBinder] -> [IfaceTyConBinder]
 stripIfaceInvisVars dflags tyvars
   | gopt Opt_PrintExplicitKinds dflags = tyvars
-  | otherwise = filterOut isIfaceInvisBndr tyvars
-
-isIfaceInvisBndr :: IfaceTyConBinder -> Bool
-isIfaceInvisBndr (IfaceNamed (IfaceTv _ Invisible)) = True
-isIfaceInvisBndr (IfaceNamed (IfaceTv _ Specified)) = True
-isIfaceInvisBndr _                                  = False
+  | otherwise = filterOut isInvisibleTyConBinder tyvars
 
 -- | Extract a IfaceTvBndr from a IfaceTyConBinder
 ifTyConBinderTyVar :: IfaceTyConBinder -> IfaceTvBndr
-ifTyConBinderTyVar (IfaceAnon tv)              = tv
-ifTyConBinderTyVar (IfaceNamed (IfaceTv tv _)) = tv
+ifTyConBinderTyVar = binderVar
 
 -- | Extract the variable name from a IfaceTyConBinder
 ifTyConBinderName :: IfaceTyConBinder -> IfLclName
@@ -299,7 +287,7 @@ ifTyVarsOfType ty
 ifTyVarsOfForAllBndr :: IfaceForAllBndr
                      -> ( UniqSet IfLclName   -- names used free in the binder
                         , [IfLclName] )       -- names bound by this binder
-ifTyVarsOfForAllBndr (IfaceTv (name, kind) _) = (ifTyVarsOfType kind, [name])
+ifTyVarsOfForAllBndr (TvBndr (name, kind) _) = (ifTyVarsOfType kind, [name])
 
 ifTyVarsOfArgs :: IfaceTcArgs -> UniqSet IfLclName
 ifTyVarsOfArgs args = argv emptyUniqSet args
@@ -484,7 +472,7 @@ eqIfaceTypes env tys1 tys2 = and (zipWith (eqIfaceType env) tys1 tys2)
 eqIfaceForAllBndr :: IfRnEnv2 -> IfaceForAllBndr -> IfaceForAllBndr
                   -> (IfRnEnv2 -> Bool)  -- continuation
                   -> Bool
-eqIfaceForAllBndr env (IfaceTv (tv1, k1) vis1) (IfaceTv (tv2, k2) vis2) k
+eqIfaceForAllBndr env (TvBndr (tv1, k1) vis1) (TvBndr (tv2, k2) vis2) k
   = eqIfaceType env k1 k2 && vis1 == vis2 &&
     k (extendIfRnEnv2 env tv1 tv2)
 
@@ -725,7 +713,7 @@ ppr_iface_forall_part show_foralls_unconditionally tvs ctxt sdoc
 -- | Render the "forall ... ." or "forall ... ->" bit of a type.
 pprIfaceForAll :: [IfaceForAllBndr] -> SDoc
 pprIfaceForAll [] = empty
-pprIfaceForAll bndrs@(IfaceTv _ vis : _)
+pprIfaceForAll bndrs@(TvBndr _ vis : _)
   = add_separator (text "forall" <+> doc) <+> pprIfaceForAll bndrs'
   where
     (bndrs', doc) = ppr_itv_bndrs bndrs vis
@@ -741,7 +729,7 @@ pprIfaceForAll bndrs@(IfaceTv _ vis : _)
 ppr_itv_bndrs :: [IfaceForAllBndr]
              -> VisibilityFlag  -- ^ visibility of the first binder in the list
              -> ([IfaceForAllBndr], SDoc)
-ppr_itv_bndrs all_bndrs@(bndr@(IfaceTv _ vis) : bndrs) vis1
+ppr_itv_bndrs all_bndrs@(bndr@(TvBndr _ vis) : bndrs) vis1
   | vis `sameVis` vis1 = let (bndrs', doc) = ppr_itv_bndrs bndrs vis1 in
                          (bndrs', pprIfaceForAllBndr bndr <+> doc)
   | otherwise   = (all_bndrs, empty)
@@ -755,11 +743,11 @@ pprIfaceForAllCoBndrs :: [(IfLclName, IfaceCoercion)] -> SDoc
 pprIfaceForAllCoBndrs bndrs = hsep $ map pprIfaceForAllCoBndr bndrs
 
 pprIfaceForAllBndr :: IfaceForAllBndr -> SDoc
-pprIfaceForAllBndr (IfaceTv tv Invisible) = sdocWithDynFlags $ \dflags ->
-                                            if gopt Opt_PrintExplicitForalls dflags
-                                            then braces $ pprIfaceTvBndr tv
-                                            else pprIfaceTvBndr tv
-pprIfaceForAllBndr (IfaceTv tv _)         = pprIfaceTvBndr tv
+pprIfaceForAllBndr (TvBndr tv Invisible) = sdocWithDynFlags $ \dflags ->
+                                           if gopt Opt_PrintExplicitForalls dflags
+                                           then braces $ pprIfaceTvBndr tv
+                                           else pprIfaceTvBndr tv
+pprIfaceForAllBndr (TvBndr tv _)         = pprIfaceTvBndr tv
 
 pprIfaceForAllCoBndr :: (IfLclName, IfaceCoercion) -> SDoc
 pprIfaceForAllCoBndr (tv, kind_co)
@@ -996,30 +984,6 @@ instance Binary IfaceTyLit where
                  ; return (IfaceStrTyLit n) }
          _ -> panic ("get IfaceTyLit " ++ show tag)
 
-instance Binary IfaceForAllBndr where
-   put_ bh (IfaceTv tv vis) = do
-     put_ bh tv
-     put_ bh vis
-
-   get bh = do
-     tv <- get bh
-     vis <- get bh
-     return (IfaceTv tv vis)
-
-instance Binary IfaceTyConBinder where
-  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
-           b  <- get bh
-           return $! IfaceAnon b
-         _ -> do
-           b <- get bh
-           return $! IfaceNamed b
-
 instance Binary IfaceTcArgs where
   put_ bh tk =
     case tk of
@@ -1340,11 +1304,7 @@ toIfaceCoVar :: CoVar -> FastString
 toIfaceCoVar = occNameFS . getOccName
 
 toIfaceForAllBndr :: TyVarBinder -> IfaceForAllBndr
-toIfaceForAllBndr (TvBndr v vis)
-  = IfaceTv (toIfaceTvBndr v) vis
-
-binderToIfaceForAllBndr :: TyVarBinder -> IfaceForAllBndr
-binderToIfaceForAllBndr (TvBndr v vis) = IfaceTv (toIfaceTvBndr v) vis
+toIfaceForAllBndr (TvBndr v vis) = TvBndr (toIfaceTvBndr v) vis
 
 ----------------
 toIfaceTyCon :: TyCon -> IfaceTyCon
@@ -1412,21 +1372,3 @@ toIfaceUnivCoProv (PhantomProv co)    = IfacePhantomProv (toIfaceCoercion co)
 toIfaceUnivCoProv (ProofIrrelProv co) = IfaceProofIrrelProv (toIfaceCoercion co)
 toIfaceUnivCoProv (PluginProv str)    = IfacePluginProv str
 toIfaceUnivCoProv (HoleProv h) = pprPanic "toIfaceUnivCoProv hit a hole" (ppr h)
-
-----------------------
--- | Zip together tidied tyConTyVars with tyConBinders to make IfaceTyConBinders
-zipIfaceBinders :: [TyVar] -> [TyBinder] -> [IfaceTyConBinder]
-zipIfaceBinders = zipWith go
-  where
-    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 tvb) = IfaceNamed (toIfaceForAllBndr tvb)
index aedec42..537d960 100644 (file)
@@ -1311,8 +1311,8 @@ patSynToIfaceDecl ps
                 , ifPatMatcher    = to_if_pr (patSynMatcher ps)
                 , ifPatBuilder    = fmap to_if_pr (patSynBuilder ps)
                 , ifPatIsInfix    = patSynIsInfix ps
-                , ifPatUnivBndrs  = map binderToIfaceForAllBndr univ_bndrs'
-                , ifPatExBndrs    = map binderToIfaceForAllBndr ex_bndrs'
+                , ifPatUnivBndrs  = map toIfaceForAllBndr univ_bndrs'
+                , ifPatExBndrs    = map toIfaceForAllBndr ex_bndrs'
                 , ifPatProvCtxt   = tidyToIfaceContext env2 prov_theta
                 , ifPatReqCtxt    = tidyToIfaceContext env2 req_theta
                 , ifPatArgs       = map (tidyToIfaceType env2) args
@@ -1361,15 +1361,14 @@ coAxBranchToIfaceBranch' :: TyCon -> CoAxBranch -> IfaceAxBranch
 coAxBranchToIfaceBranch' tc (CoAxBranch { cab_tvs = tvs, cab_cvs = cvs
                                         , cab_lhs = lhs
                                         , cab_roles = roles, cab_rhs = rhs })
-  = IfaceAxBranch { ifaxbTyVars  = toIfaceTvBndrs tv_bndrs
+  = IfaceAxBranch { ifaxbTyVars  = toIfaceTvBndrs tidy_tvs
                   , ifaxbCoVars  = map toIfaceIdBndr cvs
                   , ifaxbLHS     = tidyToIfaceTcArgs env1 tc lhs
                   , ifaxbRoles   = roles
                   , ifaxbRHS     = tidyToIfaceType env1 rhs
                   , ifaxbIncomps = [] }
   where
-
-    (env1, tv_bndrs) = tidyTyClTyCoVarBndrs emptyTidyEnv tvs
+    (env1, tidy_tvs) = tidyTyCoVarBndrs emptyTidyEnv tvs
     -- Don't re-bind in-scope tyvars
     -- See Note [CoAxBranch type variables] in CoAxiom
 
@@ -1420,10 +1419,8 @@ tyConToIfaceDecl env tycon
   -- to put them into interface files
   = ( env
     , IfaceData { ifName       = getOccName tycon,
-                  ifBinders    = if_degenerate_binders,
-                  ifResKind    = if_degenerate_res_kind,
-                    -- FunTyCon, PrimTyCon etc don't have
-                    -- `tyConTyVars`, hence "degenerate"
+                  ifBinders    = if_binders,
+                  ifResKind    = if_res_kind,
                   ifCType      = Nothing,
                   ifRoles      = tyConRoles tycon,
                   ifCtxt       = [],
@@ -1435,18 +1432,13 @@ tyConToIfaceDecl env tycon
     -- NOTE: Not all TyCons have `tyConTyVars` field. Forcing this when `tycon`
     -- is one of these TyCons (FunTyCon, PrimTyCon, PromotedDataCon) will cause
     -- an error.
-    (tc_env1, tc_tyvars) = tidyTyClTyCoVarBndrs env (tyConTyVars tycon)
-    if_binders  = zipIfaceBinders tc_tyvars (tyConBinders tycon)
-    if_res_kind = tidyToIfaceType tc_env1 (tyConResKind tycon)
+    (tc_env1, tc_binders) = tidyTyConBinders env (tyConBinders tycon)
+    tc_tyvars      = binderVars tc_binders
+    if_binders     = toIfaceTyVarBinders tc_binders
+    if_res_kind    = tidyToIfaceType tc_env1 (tyConResKind tycon)
     if_syn_type ty = tidyToIfaceType tc_env1 ty
     if_res_var     = getOccFS `fmap` tyConFamilyResVar_maybe tycon
 
-      -- Use these when you don't have tyConTyVars
-    (degenerate_binders, degenerate_res_kind)
-      = splitPiTys (tidyType env (tyConKind tycon))
-    if_degenerate_binders  = toDegenerateBinders degenerate_binders
-    if_degenerate_res_kind = toIfaceType degenerate_res_kind
-
     parent = case tyConFamInstSig_maybe tycon of
                Just (tc, ty, ax) -> IfDataInstance (coAxiomName ax)
                                                    (toIfaceTyCon tc)
@@ -1482,7 +1474,7 @@ tyConToIfaceDecl env tycon
         = IfCon   { ifConOcc     = getOccName (dataConName data_con),
                     ifConInfix   = dataConIsInfix data_con,
                     ifConWrapper = isJust (dataConWrapId_maybe data_con),
-                    ifConExTvs   = map binderToIfaceForAllBndr ex_bndrs',
+                    ifConExTvs   = map toIfaceForAllBndr ex_bndrs',
                     ifConEqSpec  = map (to_eq_spec . eqSpecPair) eq_spec,
                     ifConCtxt    = tidyToIfaceContext con_env2 theta,
                     ifConArgTys  = map (tidyToIfaceType con_env2) arg_tys,
@@ -1508,7 +1500,7 @@ tyConToIfaceDecl env tycon
                      -- A bit grimy, perhaps, but it's simple!
 
           (con_env2, ex_bndrs') = tidyTyVarBinders con_env1 ex_bndrs
-          to_eq_spec (tv,ty) = (toIfaceTyVar (tidyTyVar con_env2 tv), tidyToIfaceType con_env2 ty)
+          to_eq_spec (tv,ty) = (tidyTyVar con_env2 tv, tidyToIfaceType con_env2 ty)
 
     ifaceOverloaded flds = case dFsEnvElts flds of
                              fl:_ -> flIsOverloaded fl
@@ -1530,19 +1522,18 @@ classToIfaceDecl env clas
     , IfaceClass { ifCtxt   = tidyToIfaceContext env1 sc_theta,
                    ifName   = getOccName tycon,
                    ifRoles  = tyConRoles (classTyCon clas),
-                   ifBinders = binders,
+                   ifBinders = toIfaceTyVarBinders tc_binders,
                    ifFDs    = map toIfaceFD clas_fds,
                    ifATs    = map toIfaceAT clas_ats,
                    ifSigs   = map toIfaceClassOp op_stuff,
                    ifMinDef = fmap getOccFS (classMinimalDef clas),
                    ifRec    = boolToRecFlag (isRecursiveTyCon tycon) })
   where
-    (clas_tyvars, clas_fds, sc_theta, _, clas_ats, op_stuff)
+    (_, clas_fds, sc_theta, _, clas_ats, op_stuff)
       = classExtraBigSig clas
     tycon = classTyCon clas
 
-    (env1, clas_tyvars') = tidyTyCoVarBndrs env clas_tyvars
-    binders = zipIfaceBinders clas_tyvars' (tyConBinders tycon)
+    (env1, tc_binders) = tidyTyConBinders env (tyConBinders tycon)
 
     toIfaceAT :: ClassATItem -> IfaceAT
     toIfaceAT (ATI tc def)
@@ -1551,7 +1542,7 @@ classToIfaceDecl env clas
         (env2, if_decl) = tyConToIfaceDecl env1 tc
 
     toIfaceClassOp (sel_id, def_meth)
-        = ASSERT(sel_tyvars == clas_tyvars)
+        = ASSERT( sel_tyvars == binderVars tc_binders )
           IfaceClassOp (getOccName sel_id)
                        (tidyToIfaceType env1 op_ty)
                        (fmap toDmSpec def_meth)
@@ -1568,8 +1559,8 @@ classToIfaceDecl env clas
     toDmSpec (_, VanillaDM)       = VanillaDM
     toDmSpec (_, GenericDM dm_ty) = GenericDM (tidyToIfaceType env1 dm_ty)
 
-    toIfaceFD (tvs1, tvs2) = (map (getOccFS . tidyTyVar env1) tvs1,
-                              map (getOccFS . tidyTyVar env1) tvs2)
+    toIfaceFD (tvs1, tvs2) = (map (tidyTyVar env1) tvs1
+                             ,map (tidyTyVar env1) tvs2)
 
 --------------------------
 tidyToIfaceType :: TidyEnv -> Type -> IfaceType
@@ -1581,20 +1572,26 @@ tidyToIfaceTcArgs env tc tys = toIfaceTcArgs tc (tidyTypes env tys)
 tidyToIfaceContext :: TidyEnv -> ThetaType -> IfaceContext
 tidyToIfaceContext env theta = map (tidyToIfaceType env) theta
 
-tidyTyClTyCoVarBndrs :: TidyEnv -> [TyCoVar] -> (TidyEnv, [TyCoVar])
-tidyTyClTyCoVarBndrs env tvs = mapAccumL tidyTyClTyCoVarBndr env tvs
+toIfaceTyVarBinder :: TyVarBndr TyVar vis -> TyVarBndr IfaceTvBndr vis
+toIfaceTyVarBinder (TvBndr tv vis) = TvBndr (toIfaceTvBndr tv) vis
 
-tidyTyClTyCoVarBndr :: TidyEnv -> TyCoVar -> (TidyEnv, TyCoVar)
+toIfaceTyVarBinders :: [TyVarBndr TyVar vis] -> [TyVarBndr IfaceTvBndr vis]
+toIfaceTyVarBinders = map toIfaceTyVarBinder
+
+tidyTyConBinder :: TidyEnv -> TyConBinder -> (TidyEnv, TyConBinder)
 -- If the type variable "binder" is in scope, don't re-bind it
 -- In a class decl, for example, the ATD binders mention
 -- (amd must mention) the class tyvars
-tidyTyClTyCoVarBndr env@(_, subst) tv
- | Just tv' <- lookupVarEnv subst tv = (env, tv')
- | otherwise                         = tidyTyCoVarBndr env tv
+tidyTyConBinder env@(_, subst) tvb@(TvBndr tv vis)
+ = case lookupVarEnv subst tv of
+     Just tv' -> (env,  TvBndr tv' vis)
+     Nothing  -> tidyTyVarBinder env tvb
+
+tidyTyConBinders :: TidyEnv -> [TyConBinder] -> (TidyEnv, [TyConBinder])
+tidyTyConBinders = mapAccumL tidyTyConBinder
 
-tidyTyVar :: TidyEnv -> TyVar -> TyVar
-tidyTyVar (_, subst) tv = lookupVarEnv subst tv `orElse` tv
-   -- TcType.tidyTyVarOcc messes around with FlatSkols
+tidyTyVar :: TidyEnv -> TyVar -> FastString
+tidyTyVar (_, subst) tv = toIfaceTyVar (lookupVarEnv subst tv `orElse` tv)
 
 --------------------------
 instanceToIfaceInst :: ClsInst -> IfaceClsInst
index 35d8325..2d592bc 100644 (file)
@@ -49,7 +49,7 @@ import DataCon
 import PrelNames
 import TysWiredIn
 import Literal
-import qualified Var
+import Var
 import VarEnv
 import VarSet
 import Name
@@ -321,16 +321,17 @@ tc_iface_decl _ _ (IfaceData {ifName = occ_name,
                           ifCtxt = ctxt, ifGadtSyntax = gadt_syn,
                           ifCons = rdr_cons,
                           ifRec = is_rec, ifParent = mb_parent })
-  = bindIfaceTyConBinders_AT binders $ \ tyvars binders' -> do
+  = bindIfaceTyConBinders_AT binders $ \ binders' -> do
     { tc_name <- lookupIfaceTop occ_name
     ; res_kind' <- tcIfaceType res_kind
 
     ; tycon <- fixM $ \ tycon -> do
             { stupid_theta <- tcIfaceCtxt ctxt
             ; parent' <- tc_parent tc_name mb_parent
-            ; cons <- tcIfaceDataCons tc_name tycon tyvars binders' rdr_cons
-            ; return (mkAlgTyCon tc_name binders' res_kind' tyvars roles cType stupid_theta
-                                    cons parent' is_rec gadt_syn) }
+            ; cons <- tcIfaceDataCons tc_name tycon binders' rdr_cons
+            ; return (mkAlgTyCon tc_name binders' res_kind'
+                                 roles cType stupid_theta
+                                 cons parent' is_rec gadt_syn) }
     ; traceIf (text "tcIfaceDecl4" <+> ppr tycon)
     ; return (ATyCon tycon) }
   where
@@ -350,12 +351,12 @@ tc_iface_decl _ _ (IfaceSynonym {ifName = occ_name,
                                       ifSynRhs = rhs_ty,
                                       ifBinders = binders,
                                       ifResKind = res_kind })
-   = bindIfaceTyConBinders_AT binders $ \ tyvars binders' -> do
+   = bindIfaceTyConBinders_AT binders $ \ binders' -> do
      { tc_name  <- lookupIfaceTop occ_name
      ; res_kind' <- tcIfaceType res_kind     -- Note [Synonym kind loop]
      ; rhs      <- forkM (mk_doc tc_name) $
                    tcIfaceType rhs_ty
-     ; let tycon = mkSynonymTyCon tc_name binders' res_kind' tyvars roles rhs
+     ; let tycon = mkSynonymTyCon tc_name binders' res_kind' roles rhs
      ; return (ATyCon tycon) }
    where
      mk_doc n = text "Type synonym" <+> ppr n
@@ -365,13 +366,13 @@ tc_iface_decl parent _ (IfaceFamily {ifName = occ_name,
                                      ifBinders = binders,
                                      ifResKind = res_kind,
                                      ifResVar = res, ifFamInj = inj })
-   = bindIfaceTyConBinders_AT binders $ \ tyvars binders' -> do
+   = bindIfaceTyConBinders_AT binders $ \ binders' -> do
      { tc_name   <- lookupIfaceTop occ_name
      ; res_kind' <- tcIfaceType res_kind    -- Note [Synonym kind loop]
      ; rhs      <- forkM (mk_doc tc_name) $
                    tc_fam_flav tc_name fam_flav
      ; res_name <- traverse (newIfaceName . mkTyVarOccFS) res
-     ; let tycon = mkFamilyTyCon tc_name binders' res_kind' tyvars res_name rhs parent inj
+     ; let tycon = mkFamilyTyCon tc_name binders' res_kind' res_name rhs parent inj
      ; return (ATyCon tycon) }
    where
      mk_doc n = text "Type synonym" <+> ppr n
@@ -399,7 +400,7 @@ tc_iface_decl _parent ignore_prags
                          ifMinDef = mindef_occ, ifRec = tc_isrec })
 -- ToDo: in hs-boot files we should really treat abstract classes specially,
 --       as we do abstract tycons
-  = bindIfaceTyConBinders binders $ \ tyvars binders' -> do
+  = bindIfaceTyConBinders binders $ \ binders' -> do
     { tc_name <- lookupIfaceTop tc_occ
     ; traceIf (text "tc-iface-class1" <+> ppr tc_occ)
     ; ctxt <- mapM tc_sc rdr_ctxt
@@ -411,7 +412,7 @@ tc_iface_decl _parent ignore_prags
     ; cls  <- fixM $ \ cls -> do
               { ats  <- mapM (tc_at cls) rdr_ats
               ; traceIf (text "tc-iface-class4" <+> ppr tc_occ)
-              ; buildClass tc_name tyvars roles ctxt binders' fds ats sigs mindef tc_isrec }
+              ; buildClass tc_name binders' roles ctxt fds ats sigs mindef tc_isrec }
     ; return (ATyCon (classTyCon cls)) }
   where
    tc_sc pred = forkM (mk_sc_doc pred) (tcIfaceType pred)
@@ -520,13 +521,13 @@ tc_ax_branch prev_branches
                             , ifaxbLHS = lhs, ifaxbRHS = rhs
                             , ifaxbRoles = roles, ifaxbIncomps = incomps })
   = bindIfaceTyConBinders_AT
-      (map (\b -> IfaceNamed (IfaceTv b Invisible)) tv_bndrs) $ \ tvs _ ->
+      (map (\b -> TvBndr b (NamedTCB Invisible)) tv_bndrs) $ \ tvs ->
          -- The _AT variant is needed here; see Note [CoAxBranch type variables] in CoAxiom
     bindIfaceIds cv_bndrs $ \ cvs -> do
     { tc_lhs <- tcIfaceTcArgs lhs
     ; tc_rhs <- tcIfaceType rhs
     ; let br = CoAxBranch { cab_loc     = noSrcSpan
-                          , cab_tvs     = tvs
+                          , cab_tvs     = binderVars tvs
                           , cab_cvs     = cvs
                           , cab_lhs     = tc_lhs
                           , cab_roles   = roles
@@ -534,8 +535,8 @@ tc_ax_branch prev_branches
                           , cab_incomps = map (prev_branches `getNth`) incomps }
     ; return (prev_branches ++ [br]) }
 
-tcIfaceDataCons :: Name -> TyCon -> [TyVar] -> [TyBinder] -> IfaceConDecls -> IfL AlgTyConRhs
-tcIfaceDataCons tycon_name tycon tc_tyvars tc_tybinders if_cons
+tcIfaceDataCons :: Name -> TyCon -> [TyConBinder] -> IfaceConDecls -> IfL AlgTyConRhs
+tcIfaceDataCons tycon_name tycon tc_tybinders if_cons
   = case if_cons of
         IfAbstractTyCon dis -> return (AbstractTyCon dis)
         IfDataTyCon cons _ _ -> do  { field_lbls <- mapM (traverse lookupIfaceTop) (ifaceConDeclFields if_cons)
@@ -545,6 +546,9 @@ tcIfaceDataCons tycon_name tycon tc_tyvars tc_tybinders if_cons
                                     ; data_con  <- tc_con_decl field_lbls con
                                     ; mkNewTyConRhs tycon_name tycon data_con }
   where
+    univ_tv_bndrs :: [TyVarBinder]
+    univ_tv_bndrs = mkDataConUnivTyVarBinders tc_tybinders
+
     tc_con_decl field_lbls (IfCon { ifConInfix = is_infix,
                          ifConExTvs = ex_bndrs,
                          ifConOcc = occ, ifConCtxt = ctxt, ifConEqSpec = spec,
@@ -553,7 +557,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 -> do
+       bindIfaceForAllBndrs ex_bndrs    $ \ ex_tv_bndrs -> do
         { traceIf (text "Start interface-file tc_con_decl" <+> ppr occ)
         ; dc_name  <- lookupIfaceTop occ
 
@@ -581,7 +585,7 @@ tcIfaceDataCons tycon_name tycon tc_tyvars tc_tybinders if_cons
         -- Remember, tycon is the representation tycon
         ; let orig_res_ty = mkFamilyTyConApp tycon
                                 (substTyVars (mkTvSubstPrs (map eqSpecPair eq_spec))
-                                             tc_tyvars)
+                                             (binderVars tc_tybinders))
 
         ; prom_rep_name <- newTyConRepName dc_name
 
@@ -595,7 +599,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
+                       univ_tv_bndrs ex_tv_bndrs
                        eq_spec theta
                        arg_tys orig_res_ty tycon
         ; traceIf (text "Done interface-file tc_con_decl" <+> ppr dc_name)
@@ -1445,7 +1449,7 @@ bindIfaceForAllBndrs (bndr:bndrs) thing_inside
     thing_inside (mkTyVarBinder vis tv : bndrs')
 
 bindIfaceForAllBndr :: IfaceForAllBndr -> (TyVar -> VisibilityFlag -> IfL a) -> IfL a
-bindIfaceForAllBndr (IfaceTv tv vis) thing_inside
+bindIfaceForAllBndr (TvBndr tv vis) thing_inside
   = bindIfaceTyVar tv $ \tv' -> thing_inside tv' vis
 
 bindIfaceTyVar :: IfaceTvBndr -> (TyVar -> IfL a) -> IfL a
@@ -1460,25 +1464,25 @@ mk_iface_tyvar name ifKind
         ; return (Var.mkTyVar name kind) }
 
 bindIfaceTyConBinders :: [IfaceTyConBinder]
-                      -> ([TyVar] -> [TyBinder] -> IfL a) -> IfL a
-bindIfaceTyConBinders [] thing_inside = thing_inside [] []
+                      -> ([TyConBinder] -> IfL a) -> IfL a
+bindIfaceTyConBinders [] thing_inside = thing_inside []
 bindIfaceTyConBinders (b:bs) thing_inside
-  = bindIfaceTyConBinderX bindIfaceTyVar b $ \ tv'  b'  ->
-    bindIfaceTyConBinders bs               $ \ tvs' bs' ->
-    thing_inside (tv':tvs') (b':bs')
+  = bindIfaceTyConBinderX bindIfaceTyVar b $ \ b'  ->
+    bindIfaceTyConBinders bs               $ \ bs' ->
+    thing_inside (b':bs')
 
 bindIfaceTyConBinders_AT :: [IfaceTyConBinder]
-                         -> ([TyVar] -> [TyBinder] -> IfL a) -> IfL a
+                         -> ([TyConBinder] -> IfL a) -> IfL a
 -- Used for type variable in nested associated data/type declarations
 -- where some of the type variables are already in scope
 --    class C a where { data T a b }
 -- Here 'a' is in scope when we look at the 'data T'
 bindIfaceTyConBinders_AT [] thing_inside
-  = thing_inside [] []
+  = thing_inside []
 bindIfaceTyConBinders_AT (b : bs) thing_inside
-  = bindIfaceTyConBinderX bind_tv b  $ \tv'  b'  ->
-    bindIfaceTyConBinders_AT      bs $ \tvs' bs' ->
-    thing_inside (tv':tvs') (b':bs')
+  = bindIfaceTyConBinderX bind_tv b  $ \b'  ->
+    bindIfaceTyConBinders_AT      bs $ \bs' ->
+    thing_inside (b':bs')
   where
     bind_tv tv thing
       = do { mb_tv <- lookupIfaceTyVar tv
@@ -1488,10 +1492,7 @@ bindIfaceTyConBinders_AT (b : bs) thing_inside
 
 bindIfaceTyConBinderX :: (IfaceTvBndr -> (TyVar -> IfL a) -> IfL a)
                       -> IfaceTyConBinder
-                      -> (TyVar -> TyBinder -> IfL a) -> IfL a
-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
+                      -> (TyConBinder -> IfL a) -> IfL a
+bindIfaceTyConBinderX bind_tv (TvBndr tv vis) thing_inside
   = bind_tv tv $ \tv' ->
-    thing_inside tv' (Named (mkTyVarBinder vis tv'))
+    thing_inside (TvBndr tv' vis)
index 4529353..200f642 100644 (file)
@@ -139,6 +139,7 @@ import ByteCodeTypes
 import InteractiveEvalTypes ( Resume )
 import GHCi.Message         ( Pipe )
 import GHCi.RemoteTypes
+import UniqFM
 #endif
 
 import HsSyn
@@ -179,7 +180,6 @@ import Maybes
 import Outputable
 import SrcLoc
 import Unique
-import UniqFM
 import UniqDFM
 import UniqSupply
 import FastString
index e0be093..376a0bb 100644 (file)
 module TysPrim(
         mkPrimTyConName, -- For implicit parameters in TysWiredIn only
 
-        mkTemplateTyVars,
+        mkTemplateKindVars, mkTemplateTyVars, mkTemplateTyVarsFrom,
+        mkTemplateKiTyVars,
+
+        mkTemplateTyConBinders, mkTemplateKindTyConBinders,
+        mkTemplateAnonTyConBinders,
+
         alphaTyVars, alphaTyVar, betaTyVar, gammaTyVar, deltaTyVar,
         alphaTys, alphaTy, betaTy, gammaTy, deltaTy,
         runtimeRep1TyVar, runtimeRep2TyVar, runtimeRep1Ty, runtimeRep2Ty,
         openAlphaTy, openBetaTy, openAlphaTyVar, openBetaTyVar,
-        kKiVar,
 
         -- Kind constructors...
         tYPETyConName, unliftedTypeKindTyConName,
@@ -88,7 +92,7 @@ import {-# SOURCE #-} TysWiredIn
   , word32ElemRepDataConTy, word64ElemRepDataConTy, floatElemRepDataConTy
   , doubleElemRepDataConTy )
 
-import Var              ( TyVar, KindVar, mkTyVar )
+import Var              ( TyVar, mkTyVar )
 import Name
 import TyCon
 import SrcLoc
@@ -96,8 +100,8 @@ import Unique
 import PrelNames
 import FastString
 import Outputable
-import TyCoRep   -- doesn't need special access, but this is easier to avoid
-                 -- import loops
+import TyCoRep   -- Doesn't need special access, but this is easier to avoid
+                 -- import loops which show up if you import Type instead
 
 import Data.Char
 
@@ -212,16 +216,76 @@ alphaTyVars is a list of type variables for use in templates:
         ["a", "b", ..., "z", "t1", "t2", ... ]
 -}
 
+mkTemplateKindVars :: [Kind] -> [TyVar]
+-- k0  with unique (mkAlphaTyVarUnique 0)
+-- k1  with unique (mkAlphaTyVarUnique 1)
+-- ... etc
+mkTemplateKindVars kinds
+  = [ mkTyVar name kind
+    | (kind, u) <- kinds `zip` [0..]
+    , let occ = mkTyVarOccFS (mkFastString ('k' : show u))
+          name = mkInternalName (mkAlphaTyVarUnique u) occ noSrcSpan
+    ]
+
+mkTemplateTyVarsFrom :: Int -> [Kind] -> [TyVar]
+-- a  with unique (mkAlphaTyVarUnique n)
+-- b  with unique (mkAlphaTyVarUnique n+1)
+-- ... etc
+-- Typically called as
+--   mkTemplateTyVarsFrom (legth kv_bndrs) kinds
+-- where kv_bndrs are the kind-level binders of a TyCon
+mkTemplateTyVarsFrom n kinds
+  = [ mkTyVar name kind
+    | (kind, index) <- zip kinds [0..],
+      let ch_ord = index + ord 'a'
+          name_str | ch_ord <= ord 'z' = [chr ch_ord]
+                   | otherwise         = 't':show index
+          uniq = mkAlphaTyVarUnique (index + n)
+          name = mkInternalName uniq occ noSrcSpan
+          occ  = mkTyVarOccFS (mkFastString name_str)
+    ]
+
 mkTemplateTyVars :: [Kind] -> [TyVar]
-mkTemplateTyVars kinds =
-  [ mkTyVar (mkInternalName (mkAlphaTyVarUnique u)
-                            (mkTyVarOccFS (mkFastString name))
-                            noSrcSpan) k
-  | (k,u) <- zip kinds [2..],
-    let name | c <= 'z'  = [c]
-             | otherwise = 't':show u
-          where c = chr (u-2 + ord 'a')
-  ]
+mkTemplateTyVars = mkTemplateTyVarsFrom 1
+
+mkTemplateTyConBinders
+    :: [Kind]                -- [k1, .., kn]   Kinds of kind-forall'd vars
+    -> ([Kind] -> [Kind])    -- Arg is [kv1:k1, ..., kvn:kn]
+                             --     same length as first arg
+                             -- Result is anon arg kinds
+    -> [TyConBinder]
+mkTemplateTyConBinders kind_var_kinds mk_anon_arg_kinds
+  = kv_bndrs ++ tv_bndrs
+  where
+    kv_bndrs   = mkTemplateKindTyConBinders kind_var_kinds
+    anon_kinds = mk_anon_arg_kinds (mkTyVarTys (binderVars kv_bndrs))
+    tv_bndrs   = mkTemplateAnonTyConBindersFrom (length kv_bndrs) anon_kinds
+
+mkTemplateKiTyVars
+    :: [Kind]                -- [k1, .., kn]   Kinds of kind-forall'd vars
+    -> ([Kind] -> [Kind])    -- Arg is [kv1:k1, ..., kvn:kn]
+                             --     same length as first arg
+                             -- Result is anon arg kinds [ak1, .., akm]
+    -> [TyVar]   -- [kv1:k1, ..., kvn:kn, av1:ak1, ..., avm:akm]
+-- Example: if you want the tyvars for
+--   forall (r:RuntimeRep) (a:TYPE r) (b:*). blah
+-- call mkTemplateKiTyVars [RuntimeRep] (\[r]. [TYPE r, *)
+mkTemplateKiTyVars kind_var_kinds mk_arg_kinds
+  = kv_bndrs ++ tv_bndrs
+  where
+    kv_bndrs   = mkTemplateKindVars kind_var_kinds
+    anon_kinds = mk_arg_kinds (mkTyVarTys kv_bndrs)
+    tv_bndrs   = mkTemplateTyVarsFrom (length kv_bndrs) anon_kinds
+
+mkTemplateKindTyConBinders :: [Kind] -> [TyConBinder]
+-- Makes named, Specified binders
+mkTemplateKindTyConBinders kinds = [mkNamedTyConBinder Specified tv | tv <- mkTemplateKindVars kinds]
+
+mkTemplateAnonTyConBinders :: [Kind] -> [TyConBinder]
+mkTemplateAnonTyConBinders kinds = map mkAnonTyConBinder (mkTemplateTyVars kinds)
+
+mkTemplateAnonTyConBindersFrom :: Int -> [Kind] -> [TyConBinder]
+mkTemplateAnonTyConBindersFrom n kinds = map mkAnonTyConBinder (mkTemplateTyVarsFrom n kinds)
 
 alphaTyVars :: [TyVar]
 alphaTyVars = mkTemplateTyVars $ repeat liftedTypeKind
@@ -250,10 +314,6 @@ openAlphaTy, openBetaTy :: Type
 openAlphaTy = mkTyVarTy openAlphaTyVar
 openBetaTy  = mkTyVarTy openBetaTyVar
 
-kKiVar :: KindVar
-kKiVar = (mkTemplateTyVars $ repeat liftedTypeKind) !! 10
-  -- the 10 selects the 11th letter in the alphabet: 'k'
-
 {-
 ************************************************************************
 *                                                                      *
@@ -266,9 +326,10 @@ funTyConName :: Name
 funTyConName = mkPrimTyConName (fsLit "(->)") funTyConKey funTyCon
 
 funTyCon :: TyCon
-funTyCon = mkFunTyCon funTyConName (map Anon [liftedTypeKind, liftedTypeKind])
-                                   tc_rep_nm
+funTyCon = mkFunTyCon funTyConName tc_bndrs tc_rep_nm
   where
+    tc_bndrs = mkTemplateAnonTyConBinders [liftedTypeKind, liftedTypeKind]
+
         -- You might think that (->) should have type (?? -> ? -> *), and you'd be right
         -- But if we do that we get kind errors when saying
         --      instance Control.Arrow (->)
@@ -331,7 +392,7 @@ tYPETyCon, unliftedTypeKindTyCon :: TyCon
 tYPETyConName, unliftedTypeKindTyConName :: Name
 
 tYPETyCon = mkKindTyCon tYPETyConName
-                        [Anon runtimeRepTy]
+                        (mkTemplateAnonTyConBinders [runtimeRepTy])
                         liftedTypeKind
                         [Nominal]
                         (mkPrelTyConRepName tYPETyConName)
@@ -340,8 +401,7 @@ tYPETyCon = mkKindTyCon tYPETyConName
    -- NB: unlifted is wired in because there is no way to parse it in
    -- Haskell. That's the only reason for wiring it in.
 unliftedTypeKindTyCon = mkSynonymTyCon unliftedTypeKindTyConName
-                          [] liftedTypeKind
-                          [] []
+                          [] liftedTypeKind []
                           (tYPE (TyConApp ptrRepUnliftedDataConTyCon []))
 
 --------------------------
@@ -379,7 +439,7 @@ pcPrimTyCon :: Name -> [Role] -> PrimRep -> TyCon
 pcPrimTyCon name roles rep
   = mkPrimTyCon name binders result_kind roles
   where
-    binders     = map (const (Anon liftedTypeKind)) roles
+    binders     = mkTemplateAnonTyConBinders (map (const liftedTypeKind) roles)
     result_kind = tYPE rr
 
     rr = case rep of
@@ -682,11 +742,10 @@ mkProxyPrimTy k ty = TyConApp proxyPrimTyCon [k, ty]
 
 proxyPrimTyCon :: TyCon
 proxyPrimTyCon = mkPrimTyCon proxyPrimTyConName binders res_kind [Nominal,Nominal]
-  where binders  = [ Named (TvBndr kv Specified)
-                   , Anon k ]
-        res_kind = tYPE voidRepDataConTy
-        kv       = kKiVar
-        k        = mkTyVarTy kv
+  where
+     -- Kind: forall k. k -> Void#
+     binders = mkTemplateTyConBinders [liftedTypeKind] (\ks-> ks)
+     res_kind = tYPE voidRepDataConTy
 
 
 {- *********************************************************************
@@ -699,46 +758,33 @@ 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 (TvBndr kv1 Specified)
-                  , Named (TvBndr kv2 Specified)
-                  , Anon k1
-                  , Anon k2 ]
-        res_kind = tYPE voidRepDataConTy
-        [kv1, kv2] = mkTemplateTyVars [liftedTypeKind, liftedTypeKind]
-        k1 = mkTyVarTy kv1
-        k2 = mkTyVarTy kv2
-        roles = [Nominal, Nominal, Nominal, Nominal]
+  where
+    -- Kind :: forall k1 k2. k1 -> k2 -> Void#
+    binders  = mkTemplateTyConBinders [liftedTypeKind, liftedTypeKind] (\ks -> ks)
+    res_kind = tYPE voidRepDataConTy
+    roles    = [Nominal, Nominal, Nominal, Nominal]
 
 -- like eqPrimTyCon, but the type for *Representational* coercions
 -- this should only ever appear as the type of a covar. Its role is
 -- interpreted in coercionRole
 eqReprPrimTyCon :: TyCon   -- See Note [The equality types story]
 eqReprPrimTyCon = mkPrimTyCon eqReprPrimTyConName binders res_kind roles
-  where binders = [ Named (TvBndr kv1 Specified)
-                  , Named (TvBndr kv2 Specified)
-                  , Anon k1
-                  , Anon k2 ]
-        res_kind = tYPE voidRepDataConTy
-        [kv1, kv2]    = mkTemplateTyVars [liftedTypeKind, liftedTypeKind]
-        k1            = mkTyVarTy kv1
-        k2            = mkTyVarTy kv2
-        roles         = [Nominal, Nominal, Representational, Representational]
+  where
+    -- Kind :: forall k1 k2. k1 -> k2 -> Void#
+    binders  = mkTemplateTyConBinders [liftedTypeKind, liftedTypeKind] (\ks -> ks)
+    res_kind = tYPE voidRepDataConTy
+    roles    = [Nominal, Nominal, Representational, Representational]
 
 -- like eqPrimTyCon, but the type for *Phantom* coercions.
 -- This is only used to make higher-order equalities. Nothing
 -- should ever actually have this type!
 eqPhantPrimTyCon :: TyCon
-eqPhantPrimTyCon = mkPrimTyCon eqPhantPrimTyConName binders res_kind
-                               [Nominal, Nominal, Phantom, Phantom]
-  where binders = [ Named (TvBndr kv1 Specified)
-                  , Named (TvBndr kv2 Specified)
-                  , Anon k1
-                  , Anon k2 ]
-        res_kind = tYPE voidRepDataConTy
-        [kv1, kv2]    = mkTemplateTyVars [liftedTypeKind, liftedTypeKind]
-        k1            = mkTyVarTy kv1
-        k2            = mkTyVarTy kv2
-
+eqPhantPrimTyCon = mkPrimTyCon eqPhantPrimTyConName binders res_kind roles
+  where
+    -- Kind :: forall k1 k2. k1 -> k2 -> Void#
+    binders  = mkTemplateTyConBinders [liftedTypeKind, liftedTypeKind] (\ks -> ks)
+    res_kind = tYPE voidRepDataConTy
+    roles    = [Nominal, Nominal, Phantom, Phantom]
 
 {- *********************************************************************
 *                                                                      *
index 82c5bfb..15cb7a1 100644 (file)
@@ -9,6 +9,14 @@
 -- | This module is about types that can be defined in Haskell, but which
 --   must be wired into the compiler nonetheless.  C.f module TysPrim
 module TysWiredIn (
+        -- * Helper functions defined here
+        mkWiredInTyConName, -- This is used in TcTypeNats to define the
+                            -- built-in functions for evaluation.
+
+        mkWiredInIdName,    -- used in MkId
+
+        mkFunKind, mkForAllKind,
+
         -- * All wired in things
         wiredInTyCons, isBuiltInOcc_maybe,
 
@@ -50,7 +58,6 @@ module TysWiredIn (
         nilDataCon, nilDataConName, nilDataConKey,
         consDataCon_RDR, consDataCon, consDataConName,
         promotedNilDataCon, promotedConsDataCon,
-
         mkListTy,
 
         -- * Maybe
@@ -86,11 +93,6 @@ module TysWiredIn (
         heqTyCon, heqClass, heqDataCon,
         coercibleTyCon, coercibleDataCon, coercibleClass,
 
-        mkWiredInTyConName, -- This is used in TcTypeNats to define the
-                            -- built-in functions for evaluation.
-
-        mkWiredInIdName,    -- used in MkId
-
         -- * RuntimeRep and friends
         runtimeRepTyCon, vecCountTyCon, vecElemTyCon,
 
@@ -347,13 +349,13 @@ anyTyConName =
     mkWiredInTyConName UserSyntax gHC_TYPES (fsLit "Any") anyTyConKey anyTyCon
 
 anyTyCon :: TyCon
-anyTyCon = mkFamilyTyCon anyTyConName binders res_kind [kKiVar] Nothing
+anyTyCon = mkFamilyTyCon anyTyConName binders res_kind Nothing
                          (ClosedSynFamilyTyCon Nothing)
                          Nothing
                          NotInjective
   where
-    binders  = [mkNamedBinder (mkTyVarBinder Specified kKiVar)]
-    res_kind = mkTyVarTy kKiVar
+    binders@[kv] = mkTemplateKindTyConBinders [liftedTypeKind]
+    res_kind = mkTyVarTy (binderVar kv)
 
 anyTy :: Type
 anyTy = mkTyConTy anyTyCon
@@ -453,9 +455,8 @@ pcNonRecDataTyCon = pcTyCon False NonRecursive
 pcTyCon :: Bool -> RecFlag -> Name -> Maybe CType -> [TyVar] -> [DataCon] -> TyCon
 pcTyCon is_enum is_rec name cType tyvars cons
   = mkAlgTyCon name
-                (map (mkAnonBinder . tyVarKind) tyvars)
+                (mkAnonTyConBinders tyvars)
                 liftedTypeKind
-                tyvars
                 (map (const Representational) tyvars)
                 cType
                 []              -- No stupid theta
@@ -550,6 +551,14 @@ liftedTypeKind   = tYPE ptrRepLiftedTy
 constraintKind   = mkTyConApp constraintKindTyCon []
 unboxedTupleKind = tYPE unboxedTupleRepDataConTy
 
+-- mkFunKind and mkForAllKind are defined here
+-- solely so that TyCon can use them via a SOURCE import
+mkFunKind :: Kind -> Kind -> Kind
+mkFunKind = mkFunTy
+
+mkForAllKind :: TyVar -> VisibilityFlag -> Kind -> Kind
+mkForAllKind = mkForAllTy
+
 {-
 ************************************************************************
 *                                                                      *
@@ -729,50 +738,54 @@ boxedTupleArr   = listArray (0,mAX_TUPLE_SIZE) [mk_tuple Boxed   i | i <- [0..mA
 unboxedTupleArr = listArray (0,mAX_TUPLE_SIZE) [mk_tuple Unboxed i | i <- [0..mAX_TUPLE_SIZE]]
 
 mk_tuple :: Boxity -> Int -> (TyCon,DataCon)
-mk_tuple boxity arity = (tycon, tuple_con)
+mk_tuple Boxed arity = (tycon, tuple_con)
+  where
+    tycon = mkTupleTyCon tc_name tc_binders tc_res_kind tc_arity tuple_con
+                         BoxedTuple flavour
+
+    tc_binders  = mkTemplateAnonTyConBinders (nOfThem arity liftedTypeKind)
+    tc_res_kind = liftedTypeKind
+    tc_arity    = arity
+    flavour     = VanillaAlgTyCon (mkPrelTyConRepName tc_name)
+
+    dc_tvs     = binderVars tc_binders
+    dc_arg_tys = mkTyVarTys dc_tvs
+    tuple_con  = pcDataCon dc_name dc_tvs dc_arg_tys tycon
+
+    boxity  = Boxed
+    modu    = gHC_TUPLE
+    tc_name = mkWiredInName modu (mkTupleOcc tcName boxity arity) tc_uniq
+                         (ATyCon tycon) BuiltInSyntax
+    dc_name = mkWiredInName modu (mkTupleOcc dataName boxity arity) dc_uniq
+                            (AConLike (RealDataCon tuple_con)) BuiltInSyntax
+    tc_uniq = mkTupleTyConUnique   boxity arity
+    dc_uniq = mkTupleDataConUnique boxity arity
+
+mk_tuple Unboxed arity = (tycon, tuple_con)
   where
-        tycon   = mkTupleTyCon tc_name tc_binders tc_res_kind tc_arity tyvars tuple_con
-                               tup_sort flavour
-
-        (tup_sort, modu, tc_binders, tc_res_kind, tc_arity, tyvars, tyvar_tys, flavour)
-          = case boxity of
-          Boxed ->
-            let boxed_tyvars = take arity alphaTyVars in
-            ( BoxedTuple
-            , gHC_TUPLE
-            , nOfThem arity (mkAnonBinder liftedTypeKind)
-            , liftedTypeKind
-            , arity
-            , boxed_tyvars
-            , mkTyVarTys boxed_tyvars
-            , VanillaAlgTyCon (mkPrelTyConRepName tc_name)
-            )
-            -- See Note [Unboxed tuple RuntimeRep vars] in TyCon
-          Unboxed ->
-            let all_tvs = mkTemplateTyVars (replicate arity runtimeRepTy ++
-                                            map (tYPE . mkTyVarTy) (take arity all_tvs))
-                   -- NB: This must be one call to mkTemplateTyVars, to make
-                   -- sure that all the uniques are different
-                (rr_tvs, open_tvs) = splitAt arity all_tvs
-            in
-            ( UnboxedTuple
-            , gHC_PRIM
-            , map (mkNamedBinder . mkTyVarBinder Specified) rr_tvs ++
-              map (mkAnonBinder . tyVarKind) open_tvs
-            , unboxedTupleKind
-            , arity * 2
-            , all_tvs
-            , mkTyVarTys open_tvs
-            , UnboxedAlgTyCon
-            )
-
-        tc_name = mkWiredInName modu (mkTupleOcc tcName boxity arity) tc_uniq
-                                (ATyCon tycon) BuiltInSyntax
-        tuple_con = pcDataCon dc_name tyvars tyvar_tys tycon
-        dc_name   = mkWiredInName modu (mkTupleOcc dataName boxity arity) dc_uniq
-                                  (AConLike (RealDataCon tuple_con)) BuiltInSyntax
-        tc_uniq   = mkTupleTyConUnique   boxity arity
-        dc_uniq   = mkTupleDataConUnique boxity arity
+    tycon = mkTupleTyCon tc_name tc_binders tc_res_kind tc_arity tuple_con
+                         UnboxedTuple flavour
+
+    -- See Note [Unboxed tuple RuntimeRep vars] in TyCon
+    -- Kind:  forall (k1:RuntimeRep) (k2:RuntimeRep). TYPE k2 -> TYPE k2 -> #
+    tc_binders = mkTemplateTyConBinders (nOfThem arity runtimeRepTy)
+                                        (\ks -> map tYPE ks)
+    tc_res_kind = unboxedTupleKind
+    tc_arity    = arity * 2
+    flavour     = UnboxedAlgTyCon
+
+    dc_tvs     = binderVars tc_binders
+    dc_arg_tys = mkTyVarTys (drop arity dc_tvs)
+    tuple_con  = pcDataCon dc_name dc_tvs dc_arg_tys tycon
+
+    boxity  = Unboxed
+    modu    = gHC_PRIM
+    tc_name = mkWiredInName modu (mkTupleOcc tcName boxity arity) tc_uniq
+                         (ATyCon tycon) BuiltInSyntax
+    dc_name = mkWiredInName modu (mkTupleOcc dataName boxity arity) dc_uniq
+                            (AConLike (RealDataCon tuple_con)) BuiltInSyntax
+    tc_uniq = mkTupleTyConUnique   boxity arity
+    dc_uniq = mkTupleDataConUnique boxity arity
 
 unitTyCon :: TyCon
 unitTyCon = tupleTyCon Boxed 0
@@ -812,48 +825,43 @@ heqSCSelId, coercibleSCSelId :: Id
 (heqTyCon, heqClass, heqDataCon, heqSCSelId)
   = (tycon, klass, datacon, sc_sel_id)
   where
-    tycon     = mkClassTyCon heqTyConName binders tvs roles
+    tycon     = mkClassTyCon heqTyConName binders roles
                              rhs klass NonRecursive
                              (mkPrelTyConRepName heqTyConName)
-    klass     = mkClass tvs [] [sc_pred] [sc_sel_id] [] [] (mkAnd []) tycon
+    klass     = mk_class tycon sc_pred sc_sel_id
     datacon   = pcDataCon heqDataConName tvs [sc_pred] tycon
 
-    binders   = [ mkNamedBinder (mkTyVarBinder Specified kv1)
-                , mkNamedBinder (mkTyVarBinder Specified kv2)
-                , mkAnonBinder k1
-                , mkAnonBinder k2 ]
-    kv1:kv2:_ = drop 9 alphaTyVars -- gets "j" and "k"
-    k1        = mkTyVarTy kv1
-    k2        = mkTyVarTy kv2
-    [av,bv]   = mkTemplateTyVars [k1, k2]
-    tvs       = [kv1, kv2, av, bv]
+    -- Kind: forall k1 k2. k1 -> k2 -> Constraint
+    binders   = mkTemplateTyConBinders [liftedTypeKind, liftedTypeKind] (\ks -> ks)
     roles     = [Nominal, Nominal, Nominal, Nominal]
     rhs       = DataTyCon { data_cons = [datacon], is_enum = False }
 
+    tvs       = binderVars binders
     sc_pred   = mkTyConApp eqPrimTyCon (mkTyVarTys tvs)
     sc_sel_id = mkDictSelId heqSCSelIdName klass
 
 (coercibleTyCon, coercibleClass, coercibleDataCon, coercibleSCSelId)
   = (tycon, klass, datacon, sc_sel_id)
   where
-    tycon     = mkClassTyCon coercibleTyConName binders tvs roles
+    tycon     = mkClassTyCon coercibleTyConName binders roles
                              rhs klass NonRecursive
                              (mkPrelTyConRepName coercibleTyConName)
-    klass     = mkClass tvs [] [sc_pred] [sc_sel_id] [] [] (mkAnd []) tycon
+    klass     = mk_class tycon sc_pred sc_sel_id
     datacon   = pcDataCon coercibleDataConName tvs [sc_pred] tycon
 
-    binders   = [ mkNamedBinder (mkTyVarBinder Specified kKiVar)
-                , mkAnonBinder k
-                , mkAnonBinder k ]
-    k         = mkTyVarTy kKiVar
-    [av,bv]   = mkTemplateTyVars [k, k]
-    tvs       = [kKiVar, av, bv]
+    -- Kind: forall k. k -> k -> Constraint
+    binders   = mkTemplateTyConBinders [liftedTypeKind] (\[k] -> [k,k])
     roles     = [Nominal, Representational, Representational]
     rhs       = DataTyCon { data_cons = [datacon], is_enum = False }
 
-    sc_pred   = mkTyConApp eqReprPrimTyCon [k, k, mkTyVarTy av, mkTyVarTy bv]
-    sc_sel_id = mkDictSelId coercibleSCSelIdName klass
+    tvs@[k,a,b] = binderVars binders
+    sc_pred     = mkTyConApp eqReprPrimTyCon (mkTyVarTys [k, k, a, b])
+    sc_sel_id   = mkDictSelId coercibleSCSelIdName klass
 
+mk_class :: TyCon -> PredType -> Id -> Class
+mk_class tycon sc_pred sc_sel_id
+  = mkClass (tyConName tycon) (tyConTyVars tycon) [] [sc_pred] [sc_sel_id]
+            [] [] (mkAnd []) tycon
 
 {- *********************************************************************
 *                                                                      *
@@ -870,18 +878,15 @@ liftedTypeKindTyCon, starKindTyCon, unicodeStarKindTyCon :: TyCon
 
    -- See Note [TYPE] in TysPrim
 liftedTypeKindTyCon   = mkSynonymTyCon liftedTypeKindTyConName
-                                       [] liftedTypeKind
-                                       [] []
+                                       [] liftedTypeKind []
                                        (tYPE ptrRepLiftedTy)
 
 starKindTyCon         = mkSynonymTyCon starKindTyConName
-                                       [] liftedTypeKind
-                                       [] []
+                                       [] liftedTypeKind []
                                        (tYPE ptrRepLiftedTy)
 
 unicodeStarKindTyCon  = mkSynonymTyCon unicodeStarKindTyConName
-                                       [] liftedTypeKind
-                                       [] []
+                                       [] liftedTypeKind []
                                        (tYPE ptrRepLiftedTy)
 
 runtimeRepTyCon :: TyCon
index 0c8ed7e..d1debba 100644 (file)
@@ -1,9 +1,13 @@
 module TysWiredIn where
 
+import Var( TyVar, VisibilityFlag )
 import {-# SOURCE #-} TyCon      ( TyCon )
 import {-# SOURCE #-} TyCoRep    (Type, Kind)
 
 
+mkFunKind :: Kind -> Kind -> Kind
+mkForAllKind :: TyVar -> VisibilityFlag -> Kind -> Kind
+
 listTyCon :: TyCon
 typeNatKind, typeSymbolKind :: Type
 mkBoxedTupleTy :: [Type] -> Type
index 7ed98de..a92c709 100644 (file)
@@ -46,14 +46,14 @@ import CoreSyn     ( isOrphan )
 import FunDeps
 import TcMType
 import Type
-import TyCoRep     ( TyBinder(..), TyVarBinder(..) )
+import TyCoRep     ( TyBinder(..) )
 import TcType
 import HscTypes
 import Class( Class )
 import MkId( mkDictFunId )
 import Id
 import Name
-import Var      ( EvVar, mkTyVar )
+import Var      ( EvVar, mkTyVar, TyVarBndr(..) )
 import DataCon
 import TyCon
 import VarEnv
index fb89416..20abdc3 100644 (file)
@@ -35,7 +35,7 @@ import FamInstEnv( normaliseType )
 import FamInst( tcGetFamInstEnvs )
 import TyCon
 import TcType
-import Type( mkStrLitTy, tidyOpenType, TyVarBinder, mkTyVarBinder )
+import Type( mkStrLitTy, tidyOpenType, mkTyVarBinder )
 import TysPrim
 import TysWiredIn( cTupleTyConName )
 import Id
index 3d05a55..256cf94 100644 (file)
@@ -607,7 +607,7 @@ can_eq_nc' _flat _rdr_env _envs ev eq_rel
         else
           do { traceTcS "Creating implication for polytype equality" $ ppr ev
              ; kind_cos <- zipWithM (unifyWanted loc Nominal)
-                             (map binderType bndrs1) (map binderType bndrs2)
+                             (map binderKind bndrs1) (map binderKind bndrs2)
              ; all_co <- deferTcSForAllEq (eqRelRole eq_rel) loc
                                            kind_cos (bndrs1,body1) (bndrs2,body2)
              ; setWantedEq orig_dest all_co
@@ -1138,7 +1138,7 @@ canDecomposableTyConAppOK ev eq_rel tc tys1 tys2
       -- in error messages
     bndrs      = tyConBinders tc
     kind_loc   = toKindLoc loc
-    is_kinds   = map isNamedTyBinder bndrs
+    is_kinds   = map isNamedTyConBinder bndrs
     new_locs | Just KindLevel <- ctLocTypeOrKind_maybe loc
              = repeat loc
              | otherwise
index 2418517..16aecdc 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
-      | isNamedTyBinder bndr = KindLevel
-      | otherwise            = TypeLevel
+      | isNamedTyConBinder bndr = KindLevel
+      | otherwise               = TypeLevel
     t_or_ks = map choose_level tc_binders ++ repeat TypeLevel
        -- want to report *kind* errors when possible
 
index f31c122..4e02e99 100644 (file)
@@ -986,7 +986,7 @@ flatten_one ty@(ForAllTy {})
 -- We allow for-alls when, but only when, no type function
 -- applications inside the forall involve the bound type variables.
   = do { let (bndrs, rho) = splitForAllTyVarBndrs ty
-             tvs          = map binderVar bndrs
+             tvs          = binderVars bndrs
        ; (rho', co) <- setMode FM_SubstOnly $ flatten_one rho
                          -- Substitute only under a forall
                          -- See Note [Flattening under a forall]
index 99838fe..02227c7 100644 (file)
@@ -131,7 +131,7 @@ normaliseFfiType' env ty0 = go initRecTc ty0
       | (bndrs, inner_ty) <- splitForAllTyVarBndrs ty
       , not (null bndrs)
       = do (coi, nty1, gres1) <- go rec_nts inner_ty
-           return ( mkHomoForAllCos (map binderVar bndrs) coi
+           return ( mkHomoForAllCos (binderVars bndrs) coi
                   , mkForAllTys bndrs nty1, gres1 )
 
       | otherwise -- see Note [Don't recur in normaliseFfiType']
index 4443ed7..a192357 100644 (file)
@@ -540,9 +540,6 @@ tc_mkRepTy gk_ tycon k =
 
     let mkSum' a b = mkTyConApp plus  [k,a,b]
         mkProd a b = mkTyConApp times [k,a,b]
-        -- The second kind variable of (:.:) must always be *.
-        -- See Note [Handling kinds in a Rep instance]
-        mkComp a b = mkTyConApp comp  [k,liftedTypeKind,a,b]
         mkRec0 a   = mkBoxTy uAddr uChar uDouble uFloat uInt uWord rec0 k a
         mkRec1 a   = mkTyConApp rec1  [k,a]
         mkPar1     = mkTyConTy  par1
@@ -582,7 +579,7 @@ tc_mkRepTy gk_ tycon k =
             -- the presence of composition).
             argPar argVar = argTyFold argVar $ ArgTyAlg
               {ata_rec0 = mkRec0, ata_par1 = mkPar1,
-               ata_rec1 = mkRec1, ata_comp = mkComp}
+               ata_rec1 = mkRec1, ata_comp = mkComp comp k}
 
         tyConName_user = case tyConFamInst_maybe tycon of
                            Just (ptycon, _) -> tyConName ptycon
@@ -640,6 +637,21 @@ tc_mkRepTy gk_ tycon k =
 
     return (mkD tycon)
 
+mkComp :: TyCon -> Kind -> Type -> Type -> Type
+mkComp comp k f g
+  | k1_first  = mkTyConApp comp  [k,liftedTypeKind,f,g]
+  | otherwise = mkTyConApp comp  [liftedTypeKind,k,f,g]
+  where
+    -- Which of these is the case?
+    --     newtype (:.:) {k1} {k2} (f :: k2->*) (g :: k1->k2) (p :: k1) = ...
+    -- or  newtype (:.:) {k2} {k1} (f :: k2->*) (g :: k1->k2) (p :: k1) = ...
+    -- We want to instantiate with k1=k, and k2=*
+    --    Reason for k2=*: see Note [Handling kinds in a Rep instance]
+    -- But we need to know which way round!
+    k1_first = k_first == p_kind_var
+    [k_first,_,_,_,p] = tyConTyVars comp
+    Just p_kind_var = getTyVar_maybe (tyVarKind p)
+
 -- Given the TyCons for each URec-related type synonym, check to see if the
 -- given type is an unlifted type that generics understands. If so, return
 -- its representation type. Otherwise, return Rec0.
index 87f333b..a50cb4d 100644 (file)
@@ -26,10 +26,11 @@ module TcHsSyn (
         -- | For a description of "zonking", see Note [What is zonking?]
         -- in TcMType
         zonkTopDecls, zonkTopExpr, zonkTopLExpr,
-        zonkTopBndrs, zonkTyBndrsX, zonkTyBinders,
+        zonkTopBndrs, zonkTyBndrsX,
+        zonkTyConBinders,
         emptyZonkEnv, mkEmptyZonkEnv,
         zonkTcTypeToType, zonkTcTypeToTypes, zonkTyVarOcc,
-        zonkCoToCo, zonkTcKindToKind,
+        zonkCoToCo,
         zonkEvBinds,
 
         -- * Validity checking
@@ -48,7 +49,6 @@ import TcEvidence
 import TysPrim
 import TysWiredIn
 import Type
-import TyCoRep  ( TyBinder(..), TyVarBinder(..) )
 import TyCon
 import Coercion
 import ConLike
@@ -340,14 +340,13 @@ zonkTyBndrX env tv
        ; let tv' = mkTyVar (tyVarName tv) ki
        ; return (extendTyZonkEnv1 env tv', tv') }
 
-zonkTyBinders :: ZonkEnv -> [TcTyBinder] -> TcM (ZonkEnv, [TyBinder])
-zonkTyBinders = mapAccumLM zonkTyBinder
+zonkTyConBinders :: ZonkEnv -> [TyConBinder] -> TcM (ZonkEnv, [TyConBinder])
+zonkTyConBinders = mapAccumLM zonkTyConBinderX
 
-zonkTyBinder :: ZonkEnv -> TcTyBinder -> TcM (ZonkEnv, TyBinder)
-zonkTyBinder env (Anon ty) = (env, ) <$> (Anon <$> zonkTcTypeToType env ty)
-zonkTyBinder env (Named (TvBndr tv vis))
+zonkTyConBinderX :: ZonkEnv -> TyConBinder -> TcM (ZonkEnv, TyConBinder)
+zonkTyConBinderX env (TvBndr tv vis)
   = do { (env', tv') <- zonkTyBndrX env tv
-       ; return (env', Named (TvBndr tv' vis)) }
+       ; return (env', TvBndr tv' vis) }
 
 zonkTopExpr :: HsExpr TcId -> TcM (HsExpr Id)
 zonkTopExpr e = zonkExpr emptyZonkEnv e
@@ -1576,14 +1575,6 @@ zonkTcTypeToType = mapType zonk_tycomapper
 zonkTcTypeToTypes :: ZonkEnv -> [TcType] -> TcM [Type]
 zonkTcTypeToTypes env tys = mapM (zonkTcTypeToType env) tys
 
--- | Used during kind-checking in TcTyClsDecls, where it's more convenient
--- to keep the binders and result kind separate.
-zonkTcKindToKind :: [TcTyBinder] -> TcKind -> TcM ([TyBinder], Kind)
-zonkTcKindToKind binders res_kind
-  = do { (env, binders') <- zonkTyBinders emptyZonkEnv binders
-       ; res_kind' <- zonkTcTypeToType env res_kind
-       ; return (binders', res_kind') }
-
 zonkCoToCo :: ZonkEnv -> Coercion -> TcM Coercion
 zonkCoToCo = mapCoercion zonk_tycomapper
 
index 7297066..eba5e18 100644 (file)
@@ -741,14 +741,15 @@ bigConstraintTuple arity
 -- the visible ones.
 tcInferArgs :: Outputable fun
             => fun                      -- ^ the function
-            -> [TyBinder]               -- ^ function kind's binders
+            -> [TyConBinder]            -- ^ function kind's binders
             -> Maybe (VarEnv Kind)      -- ^ possibly, kind info (see above)
             -> [LHsType Name]           -- ^ args
             -> TcM (TCvSubst, [TyBinder], [TcType], [LHsType Name], Int)
                -- ^ (instantiating subst, un-insted leftover binders,
                --   typechecked args, untypechecked args, n)
-tcInferArgs fun binders mb_kind_info args
-  = do { (subst, leftover_binders, args', leftovers, n)
+tcInferArgs fun tc_binders mb_kind_info args
+  = do { let binders = tyConBindersTyBinders tc_binders  -- UGH!
+       ; (subst, leftover_binders, args', leftovers, n)
            <- tc_infer_args typeLevelMode fun binders mb_kind_info args 1
         -- now, we need to instantiate any remaining invisible arguments
        ; let (invis_bndrs, other_binders) = span isInvisibleBinder leftover_binders
@@ -1241,14 +1242,15 @@ kcHsTyVarBndrs name cusk open_fam all_kind_vars
   = do { kv_kinds <- mk_kv_kinds
        ; let scoped_kvs = zipWith mk_skolem_tv kv_ns kv_kinds
        ; tcExtendTyVarEnv2 (kv_ns `zip` scoped_kvs) $
-    do { (tvs, binders, res_kind, stuff) <- solveEqualities $
-                                            bind_telescope hs_tvs thing_inside
+    do { (tc_binders, res_kind, stuff) <- solveEqualities $
+                                          bind_telescope hs_tvs thing_inside
 
            -- Now, because we're in a CUSK, quantify over the mentioned
            -- kind vars, in dependency order.
-       ; binders  <- mapM zonkTcTyBinder binders
+       ; tc_binders  <- mapM zonkTyConBinder tc_binders
        ; res_kind <- zonkTcType res_kind
-       ; let qkvs = tyCoVarsOfTypeWellScoped (mkPiTys binders res_kind)
+       ; let tc_tvs = binderVars tc_binders
+             qkvs   = tyCoVarsOfTypeWellScoped (mkTyConKind tc_binders res_kind)
                    -- the visibility of tvs doesn't matter here; we just
                    -- want the free variables not to include the tvs
 
@@ -1256,41 +1258,40 @@ kcHsTyVarBndrs name cusk open_fam all_kind_vars
           -- 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)
+         report_non_cusk_tvs (qkvs ++ tc_tvs)
 
-          -- if any of the scoped_kvs aren't actually mentioned in a binder's
+          -- If any of the scoped_kvs aren't actually mentioned in a binder's
           -- kind (or the return kind), then we're in the CUSK case from
           -- Note [Free-floating kind vars]
-       ; let tycon_tyvars      = good_tvs ++ tvs
+       ; let all_tc_tvs        = good_tvs ++ tc_tvs
              all_mentioned_tvs = mapUnionVarSet (tyCoVarsOfType . tyVarKind)
-                                                tycon_tyvars
+                                                all_tc_tvs
                                  `unionVarSet` tyCoVarsOfType res_kind
              unmentioned_kvs   = filterOut (`elemVarSet` all_mentioned_tvs)
                                            scoped_kvs
-       ; reportFloatingKvs name tycon_tyvars unmentioned_kvs
-
-       ; let final_binders      = mkNamedTyBinders Specified good_tvs ++ binders
-             mk_tctc unsat      = mkTcTyCon name tycon_tyvars
-                                            final_binders res_kind
-                                            unsat (scoped_kvs ++ tvs)
-                                -- the tvs contain the binders already
-                                -- in scope from an enclosing class, but
-                                -- re-adding tvs to the env't doesn't cause
-                                -- harm
+       ; reportFloatingKvs name all_tc_tvs unmentioned_kvs
+
+       ; let final_binders = map (mkNamedTyConBinder Specified) good_tvs
+                            ++ tc_binders
+             mk_tctc unsat = mkTcTyCon name final_binders res_kind
+                                       unsat (scoped_kvs ++ tc_tvs)
+                           -- the tvs contain the binders already
+                           -- in scope from an enclosing class, but
+                           -- re-adding tvs to the env't doesn't cause
+                           -- harm
        ; return ( mk_tctc, stuff ) }}
 
   | otherwise
   = do { kv_kinds <- mk_kv_kinds
        ; scoped_kvs <- zipWithM newSigTyVar kv_ns kv_kinds
                      -- the names must line up in splitTelescopeTvs
-       ; (tvs, binders, res_kind, stuff)
+       ; (binders, res_kind, stuff)
            <- tcExtendTyVarEnv2 (kv_ns `zip` scoped_kvs) $
               bind_telescope hs_tvs thing_inside
        ; let   -- NB: Don't add scoped_kvs to tyConTyVars, because they
                -- must remain lined up with the binders
-             mk_tctc unsat = mkTcTyCon name tvs
-                                       binders res_kind unsat
-                                       (scoped_kvs ++ tvs)
+             mk_tctc unsat = mkTcTyCon name binders res_kind unsat
+                                       (scoped_kvs ++ binderVars binders)
        ; return (mk_tctc, stuff) }
   where
       -- if -XNoTypeInType and we know all the implicits are kind vars,
@@ -1306,24 +1307,23 @@ kcHsTyVarBndrs name cusk open_fam all_kind_vars
       -- to handle them one at a time.
     bind_telescope :: [LHsTyVarBndr Name]
                    -> TcM (Kind, r)
-                   -> TcM ([TcTyVar], [TyBinder], TcKind, r)
+                   -> TcM ([TyConBinder], TcKind, r)
     bind_telescope [] thing
       = do { (res_kind, stuff) <- thing
-           ; return ([], [], res_kind, stuff) }
+           ; return ([], res_kind, stuff) }
     bind_telescope (L _ hs_tv : hs_tvs) thing
       = do { tv_pair@(tv, _) <- kc_hs_tv hs_tv
                -- NB: Bring all tvs into scope, even non-dependent ones,
                -- as they're needed in type synonyms, data constructors, etc.
-           ; (tvs, binders, res_kind, stuff) <- bind_unless_scoped tv_pair $
-                                                bind_telescope hs_tvs $
-                                                thing
+           ; (binders, res_kind, stuff) <- bind_unless_scoped tv_pair $
+                                           bind_telescope hs_tvs $
+                                           thing
                   -- See Note [Dependent LHsQTyVars]
            ; let new_binder | hsTyVarName hs_tv `elemNameSet` dep_names
-                            = mkNamedBinder (mkTyVarBinder Visible tv)
+                            = mkNamedTyConBinder Visible tv
                             | otherwise
-                            = mkAnonBinder (tyVarKind tv)
-           ; return ( tv : tvs
-                    , new_binder : binders
+                            = mkAnonTyConBinder tv
+           ; return ( new_binder : binders
                     , res_kind, stuff ) }
 
     -- | Bind the tyvar in the env't unless the bool is True
@@ -1619,7 +1619,7 @@ kcTyClTyVars tycon_name thing_inside
        ; tcExtendTyVarEnv (tcTyConScopedTyVars tycon) $ thing_inside }
 
 tcTyClTyVars :: Name
-             -> ([TyVar] -> [TyBinder] -> Kind -> TcM a) -> TcM a
+             -> ([TyConBinder] -> Kind -> TcM a) -> TcM a
 -- ^ Used for the type variables of a type or class decl
 -- on the second full pass (type-checking/desugaring) in TcTyClDecls.
 -- This is *not* used in the initial-kind run, nor in the "kind-checking" pass.
@@ -1640,9 +1640,7 @@ tcTyClTyVars tycon_name thing_inside
   = do { tycon <- kcLookupTcTyCon tycon_name
 
        ; let scoped_tvs = tcTyConScopedTyVars tycon
-
                -- these are all zonked:
-             tkvs       = tyConTyVars tycon
              binders    = tyConBinders tycon
              res_kind   = tyConResKind tycon
 
@@ -1655,11 +1653,11 @@ tcTyClTyVars tycon_name thing_inside
           -- Add the *unzonked* tyvars to the env't, because those
           -- are the ones mentioned in the source.
        ; tcExtendTyVarEnv scoped_tvs $
-         thing_inside tkvs binders res_kind }
+         thing_inside binders res_kind }
   where
 
 -----------------------------------
-tcDataKindSig :: Kind -> TcM ([TyVar], [TyBinder], Kind)
+tcDataKindSig :: Kind -> TcM ([TyConBinder], Kind)
 -- GADT decls can have a (perhaps partial) kind signature
 --      e.g.  data T :: * -> * -> * where ...
 -- This function makes up suitable (kinded) type variables for
@@ -1679,21 +1677,24 @@ tcDataKindSig kind
                             , isNothing (lookupLocalRdrOcc rdr_env occ) ]
                  -- Note [Avoid name clashes for associated data types]
 
-            -- 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.
-              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 ]
+              extra_bndrs = zipWith3 (mk_tc_bndr span) tv_bndrs occs uniqs
 
-        ; return (tvs, bndrs, res_kind) }
+        ; return (extra_bndrs, res_kind) }
   where
-    (bndrs, res_kind) = splitPiTys kind
+    (tv_bndrs, res_kind) = splitPiTys kind
     mk_tv loc uniq occ kind
       = mkTyVar (mkInternalName uniq occ loc) 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.
+    -- Ugh!
+    mk_tc_bndr loc tv_bndr occ uniq
+      = case tv_bndr of
+          Named (TvBndr tv vis) -> TvBndr tv (NamedTCB vis)
+          Anon kind -> TvBndr (mk_tv loc uniq occ kind) AnonTCB
+
+
 badKindSig :: Kind -> SDoc
 badKindSig kind
  = hang (text "Kind signature on data type declaration has non-* return kind")
index 8c968df..27ccd5a 100644 (file)
@@ -649,10 +649,10 @@ tcDataFamInstDecl mb_clsinfo
              orig_res_ty          = mkTyConApp fam_tc pats'
 
        ; (rep_tc, axiom) <- fixM $ \ ~(rec_rep_tc, _) ->
-           do { let ty_binders = mkTyBindersPreferAnon full_tvs liftedTypeKind
+           do { let ty_binders = mkTyConBindersPreferAnon full_tvs liftedTypeKind
               ; data_cons <- tcConDecls new_or_data
                                         rec_rep_tc
-                                        (full_tvs, ty_binders, orig_res_ty) cons
+                                        (ty_binders, orig_res_ty) cons
               ; tc_rhs <- case new_or_data of
                      DataType -> return (mkDataTyConRhs data_cons)
                      NewType  -> ASSERT( not (null data_cons) )
@@ -668,7 +668,6 @@ tcDataFamInstDecl mb_clsinfo
                       -- the end of Note [Data type families] in TyCon
                     rep_tc   = mkAlgTyCon rep_tc_name
                                           ty_binders liftedTypeKind
-                                          full_tvs
                                           (map (const Nominal) full_tvs)
                                           (fmap unLoc cType) stupid_theta
                                           tc_rhs parent
index f6a59e1..a9f7bc6 100644 (file)
@@ -2034,8 +2034,8 @@ doTyConApp clas ty args
 -- polymorphism, but no more.
 onlyNamedBndrsApplied :: TyCon -> [KindOrType] -> Bool
 onlyNamedBndrsApplied tc ks
- = all isNamedTyBinder used_bndrs &&
-   all isAnonTyBinder  leftover_bndrs
+ = all isNamedTyConBinder         used_bndrs &&
+   all (not . isNamedTyConBinder) leftover_bndrs
  where
    bndrs                        = tyConBinders tc
    (used_bndrs, leftover_bndrs) = splitAtList ks bndrs
@@ -2052,9 +2052,10 @@ doTyApp clas ty f tk
   | isForAllTy (typeKind f)
   = return NoInstance -- We can't solve until we know the ctr.
   | otherwise
-  = return $ GenInst [mk_typeable_pred clas f, mk_typeable_pred clas tk]
+  = do { traceTcS "doTyApp" (ppr clas $$ ppr ty $$ ppr f $$ ppr tk)
+       ; return $ GenInst [mk_typeable_pred clas f, mk_typeable_pred clas tk]
                      (\[t1,t2] -> EvTypeable ty $ EvTypeableTyApp t1 t2)
-                     True
+                     True }
 
 -- Emit a `Typeable` constraint for the given type.
 mk_typeable_pred :: Class -> Type -> PredType
@@ -2073,13 +2074,13 @@ doTyLit kc t = do { kc_clas <- tcLookupClass kc
 {- Note [Typeable (T a b c)]
 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 For type applications we always decompose using binary application,
-vai doTyApp, until we get to a *kind* instantiation.  Exmaple
+via doTyApp, until we get to a *kind* instantiation.  Exmaple
    Proxy :: forall k. k -> *
 
 To solve Typeable (Proxy (* -> *) Maybe) we
   - First decompose with doTyApp,
     to get (Typeable (Proxy (* -> *))) and Typeable Maybe
-  - Then sovle (Typeable (Proxy (* -> *))) with doTyConApp
+  - Then solve (Typeable (Proxy (* -> *))) with doTyConApp
 
 If we attempt to short-cut by solving it all at once, via
 doTyCOnAPp
index c2cf82e..678661c 100644 (file)
@@ -73,7 +73,8 @@ module TcMType (
   zonkTcTypeAndSplitDepVars, zonkTcTypesAndSplitDepVars,
   zonkQuantifiedTyVar,
   quantifyTyVars, quantifyZonkedTyVars,
-  zonkTcTyCoVarBndr, zonkTcTyBinder, zonkTcType, zonkTcTypes, zonkCo,
+  zonkTcTyCoVarBndr, zonkTcTyBinder, zonkTyConBinder,
+  zonkTcType, zonkTcTypes, zonkCo,
   zonkTyCoVarKind, zonkTcTypeMapper,
 
   zonkEvVar, zonkWC, zonkSimples, zonkId, zonkCt, zonkSkolemInfo,
@@ -87,6 +88,7 @@ module TcMType (
 import TyCoRep
 import TcType
 import Type
+import TyCon( TyConBinder )
 import Kind
 import Coercion
 import Class
@@ -1375,10 +1377,16 @@ zonkTcTyCoVarBndr tyvar
 
 -- | Zonk a TyBinder
 zonkTcTyBinder :: TcTyBinder -> TcM TcTyBinder
-zonkTcTyBinder (Anon ty)   = Anon <$> zonkTcType ty
-zonkTcTyBinder (Named (TvBndr tv vis))
+zonkTcTyBinder (Anon ty)   = Anon  <$> zonkTcType ty
+zonkTcTyBinder (Named tvb) = Named <$> zonkTyVarBinder tvb
+
+zonkTyConBinder :: TyConBinder -> TcM TyConBinder
+zonkTyConBinder = zonkTyVarBinder
+
+zonkTyVarBinder :: TyVarBndr TyVar vis -> TcM (TyVarBndr TyVar vis)
+zonkTyVarBinder (TvBndr tv vis)
   = do { tv' <- zonkTcTyCoVarBndr tv
-       ; return (Named (TvBndr tv' vis)) }
+       ; return (TvBndr tv' vis) }
 
 zonkTcTyVar :: TcTyVar -> TcM TcType
 -- Simply look through all Flexis
index e2d2638..b9a6dec 100644 (file)
@@ -14,9 +14,8 @@ module TcPatSyn ( tcInferPatSynDecl, tcCheckPatSynDecl
 
 import HsSyn
 import TcPat
-import Type( binderVar, mkNamedBinders, binderVisibility, mkEmptyTCvSubst
-           , tidyTyCoVarBndrs, tidyTypes, tidyType )
-           , tcHsContext, tcHsLiftedType, tcHsOpenType, kindGeneralize )
+import Type( mkTyVarBinders, mkEmptyTCvSubst
+           , tidyTyVarBinders, tidyTypes, tidyType )
 import TcRnMonad
 import TcSigs( emptyPragEnv, completeSigFromId )
 import TcEnv
@@ -133,14 +132,13 @@ tcCheckPatSynDecl psb@PSB{ psb_id = lname@(L _ name), psb_args = details
                <+> pprQuotedList bad_tvs)
 
          -- See Note [The pattern-synonym signature splitting rule]
-       ; let get_tv = binderVar "tcCheckPatSynDecl"
-             univ_fvs = closeOverKinds $
+       ; let univ_fvs = closeOverKinds $
                         (tyCoVarsOfTypes (pat_ty : req_theta) `extendVarSetList` explicit_univ_tvs)
-             (extra_univ, extra_ex) = partition ((`elemVarSet` univ_fvs) . get_tv) implicit_tvs
-             univ_bndrs = extra_univ ++ mkNamedBinders Specified explicit_univ_tvs
-             ex_bndrs   = extra_ex   ++ mkNamedBinders Specified explicit_ex_tvs
-             univ_tvs   = map get_tv univ_bndrs
-             ex_tvs     = map get_tv ex_bndrs
+             (extra_univ, extra_ex) = partition ((`elemVarSet` univ_fvs) . binderVar) implicit_tvs
+             univ_bndrs = extra_univ ++ mkTyVarBinders Specified explicit_univ_tvs
+             ex_bndrs   = extra_ex   ++ mkTyVarBinders Specified explicit_ex_tvs
+             univ_tvs   = binderVars univ_bndrs
+             ex_tvs     = binderVars ex_bndrs
 
        -- Right!  Let's check the pattern against the signature
        -- See Note [Checking against a pattern signature]
@@ -323,8 +321,8 @@ tc_patsyn_finish lname dir is_infix lpat'
 
        -- Make the 'matcher'
        ; (matcher_id, matcher_bind) <- tcPatSynMatcher lname lpat'
-                                         (map binderVar univ_tvs, req_theta, req_ev_binds, req_dicts)
-                                         (map binderVar ex_tvs, ex_tys, prov_theta, prov_dicts)
+                                         (binderVars univ_tvs, req_theta, req_ev_binds, req_dicts)
+                                         (binderVars ex_tvs, ex_tys, prov_theta, prov_dicts)
                                          (args, arg_tys)
                                          pat_ty
 
index 9ebb1d5..f6ecadf 100644 (file)
@@ -1304,7 +1304,7 @@ Here we get
 data TcPatSynInfo
   = TPSI {
         patsig_name           :: Name,
-        patsig_implicit_bndrs :: [TyBinder],    -- Implicitly-bound kind vars (Invisible) and
+        patsig_implicit_bndrs :: [TyVarBinder], -- Implicitly-bound kind vars (Invisible) and
                                                 -- implicitly-bound type vars (Specified)
           -- See Note [The pattern-synonym signature splitting rule] in TcPatSyn
         patsig_univ_bndrs     :: [TyVar],       -- Bound by explicit user forall
index 75506b9..fda039b 100644 (file)
@@ -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 bndrs1
-     tvs2 = map binderVar bndrs2
+     tvs1 = binderVars bndrs1
+     tvs2 = binderVars bndrs2
index 62f4db8..5cb2366 100644 (file)
@@ -34,7 +34,7 @@ import TcUnify( tcSkolemise, unifyType, noThing )
 import Inst( topInstantiate )
 import TcEnv( tcLookupId )
 import TcEvidence( HsWrapper, (<.>) )
-import Type( mkNamedBinders )
+import Type( mkTyVarBinders )
 
 import DynFlags
 import Var      ( TyVar, tyVarName, tyVarKind )
index 4614b70..e0fa1cb 100644 (file)
@@ -1781,7 +1781,7 @@ reify_tc_app tc tys
         isEmptyVarSet $
         filterVarSet isTyVar $
         tyCoVarsOfType $
-        mkPiTys (dropList tys tc_binders) tc_res_kind
+        mkTyConKind (dropList tys tc_binders) tc_res_kind
 
 reifyPred :: TyCoRep.PredType -> TcM TH.Pred
 reifyPred ty
index f8308e8..9174690 100644 (file)
@@ -351,9 +351,10 @@ kcTyClGroup decls
                  kc_binders  = tyConBinders tc
                  kc_res_kind = tyConResKind tc
                  kc_tyvars   = tyConTyVars tc
-           ; 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
+           ; kvs <- kindGeneralize (mkTyConKind kc_binders kc_res_kind)
+
+           ; (env, kc_binders') <- zonkTyConBinders emptyZonkEnv kc_binders
+           ; kc_res_kind' <- zonkTcTypeToType env kc_res_kind
 
                       -- Make sure kc_kind' has the final, zonked kind variables
            ; traceTc "Generalise kind" $
@@ -361,8 +362,8 @@ kcTyClGroup decls
                   , ppr kvs, ppr kc_binders', ppr kc_res_kind'
                   , ppr kc_tyvars, ppr (tcTyConScopedTyVars tc)]
 
-           ; return (mkTcTyCon name (kvs ++ kc_tyvars)
-                               (mkNamedTyBinders Invisible kvs ++ kc_binders')
+           ; return (mkTcTyCon name
+                               (mkNamedTyConBinders Invisible kvs ++ kc_binders')
                                kc_res_kind'
                                (mightBeUnsaturatedTyCon tc)
                                (tcTyConScopedTyVars tc)) }
@@ -726,15 +727,15 @@ tcTyClDecl1 parent _rec_info (FamDecl { tcdFam = fd })
 tcTyClDecl1 _parent rec_info
             (SynDecl { tcdLName = L _ tc_name, tcdRhs = rhs })
   = ASSERT( isNothing _parent )
-    tcTyClTyVars tc_name $ \ tkvs' binders res_kind ->
-    tcTySynRhs rec_info tc_name tkvs' binders res_kind rhs
+    tcTyClTyVars tc_name $ \ binders res_kind ->
+    tcTySynRhs rec_info tc_name binders res_kind rhs
 
   -- "data/newtype" declaration
 tcTyClDecl1 _parent rec_info
             (DataDecl { tcdLName = L _ tc_name, tcdDataDefn = defn })
   = ASSERT( isNothing _parent )
-    tcTyClTyVars tc_name $ \ tkvs' tycon_binders res_kind ->
-    tcDataDefn rec_info tc_name tkvs' tycon_binders res_kind defn
+    tcTyClTyVars tc_name $ \ tycon_binders res_kind ->
+    tcDataDefn rec_info tc_name tycon_binders res_kind defn
 
 tcTyClDecl1 _parent rec_info
             (ClassDecl { tcdLName = L _ class_name
@@ -743,13 +744,12 @@ tcTyClDecl1 _parent rec_info
             , tcdATs = ats, tcdATDefs = at_defs })
   = ASSERT( isNothing _parent )
     do { clas <- fixM $ \ clas ->
-            tcTyClTyVars class_name $ \ tkvs' binders res_kind ->
+            tcTyClTyVars class_name $ \ binders res_kind ->
             do { MASSERT( isConstraintKind res_kind )
                  -- This little knot is just so we can get
                  -- hold of the name of the class TyCon, which we
                  -- need to look up its recursiveness
-               ; traceTc "tcClassDecl 1" (ppr class_name $$ ppr tkvs' $$
-                                          ppr binders)
+               ; traceTc "tcClassDecl 1" (ppr class_name $$ ppr binders)
                ; let tycon_name = tyConName (classTyCon clas)
                      tc_isrec = rti_is_rec rec_info tycon_name
                      roles = rti_roles rec_info tycon_name
@@ -762,10 +762,10 @@ tcTyClDecl1 _parent rec_info
                ; at_stuff <- tcClassATs class_name clas ats at_defs
                ; mindef <- tcClassMinimalDef class_name sigs sig_stuff
                ; clas <- buildClass
-                            class_name tkvs' roles ctxt' binders
+                            class_name binders roles ctxt'
                             fds' at_stuff
                             sig_stuff mindef tc_isrec
-               ; traceTc "tcClassDecl" (ppr fundeps $$ ppr tkvs' $$
+               ; traceTc "tcClassDecl" (ppr fundeps $$ ppr binders $$
                                         ppr fds')
                ; return clas }
 
@@ -780,25 +780,24 @@ tcFamDecl1 parent (FamilyDecl { fdInfo = fam_info, fdLName = tc_lname@(L _ tc_na
                               , fdTyVars = tvs, fdResultSig = L _ sig
                               , fdInjectivityAnn = inj })
   | DataFamily <- fam_info
-  = tcTyClTyVars tc_name $ \ tkvs' binders res_kind -> do
+  = tcTyClTyVars tc_name $ \ binders res_kind -> do
   { traceTc "data family:" (ppr tc_name)
   ; checkFamFlag tc_name
-  ; (extra_tvs, extra_binders, real_res_kind) <- tcDataKindSig res_kind
+  ; (extra_binders, real_res_kind) <- tcDataKindSig res_kind
   ; tc_rep_name <- newTyConRepName tc_name
-  ; let final_tvs = tkvs' `chkAppend` extra_tvs -- we may not need these
-        tycon = mkFamilyTyCon tc_name (binders `chkAppend` extra_binders)
-                              real_res_kind final_tvs
+  ; let tycon = mkFamilyTyCon tc_name (binders `chkAppend` extra_binders)
+                              real_res_kind
                               (resultVariableName sig)
                               (DataFamilyTyCon tc_rep_name)
                               parent NotInjective
   ; return tycon }
 
   | OpenTypeFamily <- fam_info
-  = tcTyClTyVars tc_name $ \ tkvs' binders res_kind -> do
+  = tcTyClTyVars tc_name $ \ binders res_kind -> do
   { traceTc "open type family:" (ppr tc_name)
   ; checkFamFlag tc_name
-  ; inj' <- tcInjectivity tkvs' inj
-  ; let tycon = mkFamilyTyCon tc_name binders res_kind tkvs'
+  ; inj' <- tcInjectivity binders inj
+  ; let tycon = mkFamilyTyCon tc_name binders res_kind
                                (resultVariableName sig) OpenSynFamilyTyCon
                                parent inj'
   ; return tycon }
@@ -809,11 +808,11 @@ tcFamDecl1 parent (FamilyDecl { fdInfo = fam_info, fdLName = tc_lname@(L _ tc_na
     do { traceTc "Closed type family:" (ppr tc_name)
          -- the variables in the header scope only over the injectivity
          -- declaration but this is not involved here
-       ; (tvs', inj', binders, res_kind)
+       ; (inj', binders, res_kind)
             <- tcTyClTyVars tc_name
-               $ \ tkvs' binders res_kind ->
-               do { inj' <- tcInjectivity tkvs' inj
-                  ; return (tkvs', inj', binders, res_kind) }
+               $ \ binders res_kind ->
+               do { inj' <- tcInjectivity binders inj
+                  ; return (inj', binders, res_kind) }
 
        ; checkFamFlag tc_name -- make sure we have -XTypeFamilies
 
@@ -821,7 +820,7 @@ tcFamDecl1 parent (FamilyDecl { fdInfo = fam_info, fdLName = tc_lname@(L _ tc_na
          -- but eqns might be empty in the Just case as well
        ; case mb_eqns of
            Nothing   ->
-               return $ mkFamilyTyCon tc_name binders res_kind tvs'
+               return $ mkFamilyTyCon tc_name binders res_kind
                                       (resultVariableName sig)
                                       AbstractClosedSynFamilyTyCon parent
                                       inj'
@@ -850,7 +849,7 @@ tcFamDecl1 parent (FamilyDecl { fdInfo = fam_info, fdLName = tc_lname@(L _ tc_na
               | null eqns = Nothing   -- mkBranchedCoAxiom fails on empty list
               | otherwise = Just (mkBranchedCoAxiom co_ax_name fam_tc branches)
 
-             fam_tc = mkFamilyTyCon tc_name binders res_kind tvs' (resultVariableName sig)
+             fam_tc = mkFamilyTyCon tc_name binders res_kind (resultVariableName sig)
                       (ClosedSynFamilyTyCon mb_co_ax) parent inj'
 
          -- We check for instance validity later, when doing validity
@@ -867,7 +866,7 @@ tcFamDecl1 parent (FamilyDecl { fdInfo = fam_info, fdLName = tc_lname@(L _ tc_na
 -- True on position
 -- N means that a function is injective in its Nth argument. False means it is
 -- not.
-tcInjectivity :: [TyVar] -> Maybe (LInjectivityAnn Name)
+tcInjectivity :: [TyConBinder] -> Maybe (LInjectivityAnn Name)
               -> TcM Injectivity
 tcInjectivity _ Nothing
   = return NotInjective
@@ -890,9 +889,10 @@ tcInjectivity _ Nothing
   -- therefore we can always infer the result kind if we know the result type.
   -- But this does not seem to be useful in any way so we don't do it.  (Another
   -- reason is that the implementation would not be straightforward.)
-tcInjectivity tvs (Just (L loc (InjectivityAnn _ lInjNames)))
+tcInjectivity tcbs (Just (L loc (InjectivityAnn _ lInjNames)))
   = setSrcSpan loc $
-    do { dflags <- getDynFlags
+    do { let tvs = binderVars tcbs
+       ; dflags <- getDynFlags
        ; checkTc (xopt LangExt.TypeFamilyDependencies dflags)
                  (text "Illegal injectivity annotation" $$
                   text "Use TypeFamilyDependencies to allow this")
@@ -907,29 +907,28 @@ tcInjectivity tvs (Just (L loc (InjectivityAnn _ lInjNames)))
 
 tcTySynRhs :: RecTyInfo
            -> Name
-           -> [TyVar] -> [TyBinder] -> Kind
+           -> [TyConBinder] -> Kind
            -> LHsType Name -> TcM TyCon
-tcTySynRhs rec_info tc_name tvs binders res_kind hs_ty
+tcTySynRhs rec_info tc_name binders res_kind hs_ty
   = do { env <- getLclEnv
        ; traceTc "tc-syn" (ppr tc_name $$ ppr (tcl_env env))
        ; rhs_ty <- solveEqualities $ tcCheckLHsType hs_ty res_kind
        ; rhs_ty <- zonkTcTypeToType emptyZonkEnv rhs_ty
        ; let roles = rti_roles rec_info tc_name
-             tycon = mkSynonymTyCon tc_name binders res_kind tvs roles rhs_ty
+             tycon = mkSynonymTyCon tc_name binders res_kind roles rhs_ty
        ; return tycon }
 
 tcDataDefn :: RecTyInfo -> Name
-           -> [TyVar] -> [TyBinder] -> Kind
+           -> [TyConBinder] -> Kind
            -> HsDataDefn Name -> TcM TyCon
   -- NB: not used for newtype/data instances (whether associated or not)
 tcDataDefn rec_info     -- Knot-tied; don't look at this eagerly
-           tc_name tvs tycon_binders res_kind
+           tc_name tycon_binders res_kind
          (HsDataDefn { dd_ND = new_or_data, dd_cType = cType
                      , dd_ctxt = ctxt, dd_kindSig = mb_ksig
                      , dd_cons = cons })
- =  do { (extra_tvs, extra_bndrs, real_res_kind) <- tcDataKindSig res_kind
+ =  do { (extra_bndrs, real_res_kind) <- tcDataKindSig res_kind
        ; let final_bndrs  = tycon_binders `chkAppend` extra_bndrs
-             final_tvs    = tvs           `chkAppend` extra_tvs
              roles        = rti_roles rec_info tc_name
 
        ; stupid_tc_theta <- solveEqualities $ tcHsContext ctxt
@@ -945,13 +944,15 @@ tcDataDefn rec_info     -- Knot-tied; don't look at this eagerly
        ; gadt_syntax <- dataDeclChecks tc_name new_or_data stupid_theta cons
 
        ; tycon <- fixM $ \ tycon -> do
-             { let res_ty = mkTyConApp tycon (mkTyVarTys final_tvs)
+             { let res_ty = mkTyConApp tycon (mkTyVarTys (binderVars final_bndrs))
              ; data_cons <- tcConDecls new_or_data tycon
-                                       (final_tvs, final_bndrs, res_ty) cons
+                                       (final_bndrs, res_ty) cons
              ; tc_rhs    <- mk_tc_rhs is_boot tycon data_cons
              ; tc_rep_nm <- newTyConRepName tc_name
-             ; return (mkAlgTyCon tc_name (tycon_binders `chkAppend` extra_bndrs)
-                                  real_res_kind final_tvs roles
+             ; return (mkAlgTyCon tc_name
+                                  final_bndrs
+                                  real_res_kind
+                                  roles
                                   (fmap unLoc cType)
                                   stupid_theta tc_rhs
                                   (VanillaAlgTyCon tc_rep_nm)
@@ -1187,7 +1188,7 @@ two bad things could happen:
 -}
 
 -----------------
-type FamTyConShape = (Name, Arity, [TyBinder], Kind)
+type FamTyConShape = (Name, Arity, [TyConBinder], Kind)
   -- See Note [Type-checking type patterns]
 
 famTyConShape :: TyCon -> FamTyConShape
@@ -1421,23 +1422,23 @@ consUseGadtSyntax _                           = False
                  -- All constructors have same shape
 
 -----------------------------------
-tcConDecls :: NewOrData -> TyCon -> ([TyVar], [TyBinder], Type)
+tcConDecls :: NewOrData -> TyCon -> ([TyConBinder], Type)
            -> [LConDecl Name] -> TcM [DataCon]
   -- Why both the tycon tyvars and binders? Because the tyvars
   -- have all the names and the binders have the visibilities.
-tcConDecls new_or_data rep_tycon (tmpl_tvs, tmpl_bndrs, res_tmpl)
+tcConDecls new_or_data rep_tycon (tmpl_bndrs, res_tmpl)
   = concatMapM $ addLocM $
-    tcConDecl new_or_data rep_tycon tmpl_tvs tmpl_bndrs res_tmpl
+    tcConDecl new_or_data rep_tycon tmpl_bndrs res_tmpl
 
 tcConDecl :: NewOrData
           -> TyCon             -- Representation tycon. Knot-tied!
-          -> [TyVar] -> [TyBinder] -> Type
+          -> [TyConBinder] -> Type
                  -- Return type template (with its template tyvars)
                  --    (tvs, T tys), where T is the family TyCon
           -> ConDecl Name
           -> TcM [DataCon]
 
-tcConDecl new_or_data rep_tycon tmpl_tvs tmpl_bndrs res_tmpl
+tcConDecl new_or_data rep_tycon tmpl_bndrs res_tmpl
           (ConDeclH98 { con_name = name
                       , con_qvars = hs_qvars, con_cxt = hs_ctxt
                       , con_details = hs_details })
@@ -1478,7 +1479,7 @@ tcConDecl new_or_data rep_tycon tmpl_tvs tmpl_bndrs res_tmpl
                  -- we're doing this to get the right behavior around removing
                  -- any vars bound in exp_binders.
 
-       ; kvs <- quantifyZonkedTyVars (mkVarSet tmpl_tvs) vars
+       ; kvs <- quantifyZonkedTyVars (mkVarSet (binderVars tmpl_bndrs)) vars
 
              -- Zonk to Types
        ; (ze, qkvs)      <- zonkTyBndrsX emptyZonkEnv kvs
@@ -1499,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
+                            (mkDataConUnivTyVarBinders tmpl_bndrs)
                             ex_tvs
                             [{- no eq_preds -}] ctxt arg_tys
                             res_tmpl rep_tycon
@@ -1511,7 +1512,7 @@ tcConDecl new_or_data rep_tycon tmpl_tvs tmpl_bndrs res_tmpl
        ; mapM buildOneDataCon [name]
        }
 
-tcConDecl _new_or_data rep_tycon tmpl_tvs _tmpl_bndrs res_tmpl
+tcConDecl _new_or_data rep_tycon tmpl_bndrs res_tmpl
           (ConDeclGADT { con_names = names, con_type = ty })
   = addErrCtxt (dataConCtxtName names) $
     do { traceTc "tcConDecl 1" (ppr names)
@@ -1531,13 +1532,13 @@ tcConDecl _new_or_data rep_tycon tmpl_tvs _tmpl_bndrs res_tmpl
        ; res_ty  <- zonkTcTypeToType ze res_ty
 
        ; let (univ_tvs, ex_tvs, eq_preds, res_ty', arg_subst)
-               = rejigConRes tmpl_tvs res_tmpl qtkvs res_ty
+               = rejigConRes tmpl_bndrs res_tmpl qtkvs res_ty
              -- NB: this is a /lazy/ binding, so we pass five thunks to buildDataCon
              --     without yet forcing the guards in rejigConRes
              -- See Note [Checking GADT return types]
 
              -- See Note [Wrong visibility for GADTs]
-             univ_bndrs = mkNamedTyBinders Specified univ_tvs
+             univ_bndrs = mkTyVarBinders Specified univ_tvs
              ex_bndrs   = mkTyVarBinders Specified ex_tvs
 
        ; fam_envs <- tcGetFamInstEnvs
@@ -1552,7 +1553,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_bndrs eq_preds
+                            univ_bndrs ex_bndrs eq_preds
                             (substTys arg_subst ctxt)
                             (substTys arg_subst arg_tys)
                             (substTy  arg_subst res_ty')
@@ -1740,7 +1741,7 @@ errors reported in one pass.  See Trac #7175, and #10836.
 --      TI :: forall b1 c1. (b1 ~ c1) => b1 -> :R7T b1 c1
 -- In this case orig_res_ty = T (e,e)
 
-rejigConRes :: [TyVar] -> Type    -- Template for result type; e.g.
+rejigConRes :: [TyConBinder] -> Type    -- Template for result type; e.g.
                                   -- data instance T [a] b c = ...
                                   --      gives template ([a,b,c], T [a] b c)
                                   -- Type must be of kind *!
@@ -1754,7 +1755,7 @@ rejigConRes :: [TyVar] -> Type    -- Template for result type; e.g.
         -- We don't check that the TyCon given in the ResTy is
         -- the same as the parent tycon, because checkValidDataCon will do it
 
-rejigConRes tmpl_tvs res_tmpl dc_tvs res_ty
+rejigConRes tmpl_bndrs res_tmpl dc_tvs res_ty
         -- E.g.  data T [a] b c where
         --         MkT :: forall x y z. T [(x,y)] z z
         -- The {a,b,c} are the tmpl_tvs, and the {x,y,z} are the dc_tvs
@@ -1790,8 +1791,9 @@ rejigConRes tmpl_tvs res_tmpl dc_tvs res_ty
         --  bad-result-type error before seeing that the other fields look odd
         -- See Note [Checking GADT return types]
   = (tmpl_tvs, dc_tvs `minusList` tmpl_tvs, [], res_ty, emptyTCvSubst)
-
   where
+    tmpl_tvs = binderVars tmpl_bndrs
+
 {-
 Note [mkGADTVars]
 ~~~~~~~~~~~~~~~~~
index 025afc9..c04c750 100644 (file)
@@ -48,7 +48,7 @@ import IdInfo
 import VarEnv
 import VarSet
 import NameSet  ( NameSet, unitNameSet, emptyNameSet, unionNameSet
-                , extendNameSet, mkNameSet, nameSetElems, elemNameSet )
+                , extendNameSet, mkNameSet, elemNameSet )
 import Coercion ( ltRole )
 import Digraph
 import BasicTypes
@@ -609,7 +609,7 @@ initialRoleEnv1 is_boot annots_env tc
   | otherwise             = pprPanic "initialRoleEnv1" (ppr tc)
   where name         = tyConName tc
         bndrs        = tyConBinders tc
-        visflags     = map tyBinderVisibility $ take (tyConArity tc) bndrs
+        visflags     = map tyConBinderVisibility bndrs
         num_exps     = count (== Visible) visflags
 
           -- if the number of annotations in the role annotation decl
index a307851..f254225 100644 (file)
@@ -135,7 +135,6 @@ module TcType (
   mkTyConApp, mkAppTy, mkAppTys,
   mkTyConTy, mkTyVarTy,
   mkTyVarTys,
-  mkNamedBinder,
 
   isClassPred, isEqPred, isNomEqPred, isIPPred,
   mkClassPred,
@@ -719,7 +718,7 @@ tcTyFamInsts (TyConApp tc tys)
   | isTypeFamilyTyCon tc        = [(tc, take (tyConArity tc) tys)]
   | otherwise                   = concat (map tcTyFamInsts tys)
 tcTyFamInsts (LitTy {})         = []
-tcTyFamInsts (ForAllTy bndr ty) = tcTyFamInsts (binderType bndr)
+tcTyFamInsts (ForAllTy bndr ty) = tcTyFamInsts (binderKind bndr)
                                   ++ tcTyFamInsts ty
 tcTyFamInsts (FunTy ty1 ty2)    = tcTyFamInsts ty1 ++ tcTyFamInsts ty2
 tcTyFamInsts (AppTy ty1 ty2)    = tcTyFamInsts ty1 ++ tcTyFamInsts ty2
@@ -775,7 +774,7 @@ exactTyCoVarsOfType ty
     go (LitTy {})           = emptyVarSet
     go (AppTy fun arg)      = go fun `unionVarSet` go arg
     go (FunTy arg res)      = go arg `unionVarSet` go res
-    go (ForAllTy bndr ty)   = delBinderVar (go ty) bndr `unionVarSet` go (binderType bndr)
+    go (ForAllTy bndr ty)   = delBinderVar (go ty) bndr `unionVarSet` go (binderKind bndr)
     go (CastTy ty co)       = go ty `unionVarSet` goCo co
     go (CoercionTy co)      = goCo co
 
@@ -1514,7 +1513,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 tyBinderVisibility bndrs
+        viss  = map tyConBinderVisibility bndrs
     tc_vis vis _ = repeat vis   -- if we're not in a visible context, our args
                                 -- aren't either
 
index e6a6c7e..cececff 100644 (file)
@@ -24,7 +24,7 @@ import TcRnTypes  ( Xi )
 import CoAxiom    ( CoAxiomRule(..), BuiltInSynFamily(..), Eqn )
 import Name       ( Name, BuiltInSyntax(..) )
 import TysWiredIn
-import TysPrim    ( mkTemplateTyVars )
+import TysPrim    ( mkTemplateAnonTyConBinders )
 import PrelNames  ( gHC_TYPELITS
                   , typeNatAddTyFamNameKey
                   , typeNatMulTyFamNameKey
@@ -100,9 +100,8 @@ typeNatExpTyCon = mkTypeNatFunTyCon2 name
 typeNatLeqTyCon :: TyCon
 typeNatLeqTyCon =
   mkFamilyTyCon name
-    (map mkAnonBinder [ typeNatKind, typeNatKind ])
+    (mkTemplateAnonTyConBinders [ typeNatKind, typeNatKind ])
     boolTy
-    (mkTemplateTyVars [ typeNatKind, typeNatKind ])
     Nothing
     (BuiltInSynFamTyCon ops)
     Nothing
@@ -120,9 +119,8 @@ typeNatLeqTyCon =
 typeNatCmpTyCon :: TyCon
 typeNatCmpTyCon =
   mkFamilyTyCon name
-    (map mkAnonBinder [ typeNatKind, typeNatKind ])
+    (mkTemplateAnonTyConBinders [ typeNatKind, typeNatKind ])
     orderingKind
-    (mkTemplateTyVars [ typeNatKind, typeNatKind ])
     Nothing
     (BuiltInSynFamTyCon ops)
     Nothing
@@ -140,9 +138,8 @@ typeNatCmpTyCon =
 typeSymbolCmpTyCon :: TyCon
 typeSymbolCmpTyCon =
   mkFamilyTyCon name
-    (map mkAnonBinder [ typeSymbolKind, typeSymbolKind ])
+    (mkTemplateAnonTyConBinders [ typeSymbolKind, typeSymbolKind ])
     orderingKind
-    (mkTemplateTyVars [ typeSymbolKind, typeSymbolKind ])
     Nothing
     (BuiltInSynFamTyCon ops)
     Nothing
@@ -165,9 +162,8 @@ typeSymbolCmpTyCon =
 mkTypeNatFunTyCon2 :: Name -> BuiltInSynFamily -> TyCon
 mkTypeNatFunTyCon2 op tcb =
   mkFamilyTyCon op
-    (map mkAnonBinder [ typeNatKind, typeNatKind ])
+    (mkTemplateAnonTyConBinders [ typeNatKind, typeNatKind ])
     typeNatKind
-    (mkTemplateTyVars [ typeNatKind, typeNatKind ])
     Nothing
     (BuiltInSynFamTyCon tcb)
     Nothing
index 3ca6aa3..ca33478 100644 (file)
@@ -381,8 +381,11 @@ matchExpectedTyConApp tc orig_ty
     -- because that'll make types that are utterly ill-kinded.
     -- This happened in Trac #7368
     defer
-      = do { (_subst, args) <- tcInstBinders (tyConBinders tc)
-           ; co <- unifyType noThing (mkTyConApp tc args) orig_ty
+      = do { (_, arg_tvs) <- newMetaTyVars (tyConTyVars tc)
+           ; traceTc "mtca" (ppr tc $$ ppr (tyConTyVars tc) $$ ppr arg_tvs)
+           ; let args = mkTyVarTys arg_tvs
+                 tc_template = mkTyConApp tc args
+           ; co <- unifyType noThing tc_template orig_ty
            ; return (co, args) }
 
 ----------------------
@@ -1458,7 +1461,7 @@ checkTauTvUpdate dflags origin t_or_k tv ty
     defer_me (TyVarTy tv')     = tv == tv' || defer_me (tyVarKind tv')
     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
+    defer_me (ForAllTy bndr t) = defer_me (binderKind bndr) || defer_me t
                                  || not impredicative
     defer_me (FunTy fun arg)   = defer_me fun || defer_me arg
     defer_me (AppTy fun arg)   = defer_me fun || defer_me arg
index 2c66f35..8b62187 100644 (file)
@@ -50,7 +50,7 @@ import Name
 import VarEnv
 import VarSet
 import UniqFM
-import Var         ( mkTyVar )
+import Var         ( TyVarBndr(..), mkTyVar )
 import ErrUtils
 import DynFlags
 import Util
@@ -1006,7 +1006,7 @@ tyConArityErr tc tks
 
     -- tc_type_arity = number of *type* args expected
     -- tc_type_args  = number of *type* args encountered
-    tc_type_arity = count isVisibleBinder $ tyConBinders tc
+    tc_type_arity = count isVisibleTyConBinder (tyConBinders tc)
     tc_type_args  = length vis_tks
 
 arityErr :: Outputable a => String -> a -> Int -> Int -> SDoc
@@ -1667,7 +1667,7 @@ checkValidFamPats mb_clsinfo fam_tc tvs cvs ty_pats
          --     type instance F Int y = y
          -- because then the type (F Int) would be like (\y.y)
          checkTc (length ty_pats == fam_arity) $
-           wrongNumberOfParmsErr (fam_arity - count isInvisibleBinder fam_bndrs)
+           wrongNumberOfParmsErr (fam_arity - count isInvisibleTyConBinder fam_bndrs)
              -- report only explicit arguments
 
        ; mapM_ checkValidTypePat ty_pats
index 27afe4d..a8626db 100644 (file)
@@ -23,7 +23,7 @@ module Class (
 
 #include "HsVersions.h"
 
-import {-# SOURCE #-} TyCon     ( TyCon, tyConName, tyConUnique )
+import {-# SOURCE #-} TyCon     ( TyCon )
 import {-# SOURCE #-} TyCoRep   ( Type, PredType, pprType )
 import Var
 import Name
@@ -155,7 +155,7 @@ The @mkClass@ function fills in the indirect superclasses.
 The SrcSpan is for the entire original declaration.
 -}
 
-mkClass :: [TyVar]
+mkClass :: Name -> [TyVar]
         -> [([TyVar], [TyVar])]
         -> [PredType] -> [Id]
         -> [ClassATItem]
@@ -164,10 +164,12 @@ mkClass :: [TyVar]
         -> TyCon
         -> Class
 
-mkClass tyvars fds super_classes superdict_sels at_stuff
+mkClass cls_name tyvars fds super_classes superdict_sels at_stuff
         op_stuff mindef tycon
-  = Class { classKey     = tyConUnique tycon,
-            className    = tyConName tycon,
+  = Class { classKey     = nameUnique cls_name,
+            className    = cls_name,
+                -- NB:  tyConName tycon = cls_name,
+                -- But it takes a module loop to assert it here
             classTyVars  = tyvars,
             classFunDeps = fds,
             classSCTheta = super_classes,
@@ -238,8 +240,7 @@ classATItems :: Class -> [ClassATItem]
 classATItems = classATStuff
 
 classTvsFds :: Class -> ([TyVar], [FunDep TyVar])
-classTvsFds c
-  = (classTyVars c, classFunDeps c)
+classTvsFds c = (classTyVars c, classFunDeps c)
 
 classHasFds :: Class -> Bool
 classHasFds (Class { classFunDeps = fds }) = not (null fds)
index edacdad..6b1b341 100644 (file)
@@ -22,7 +22,9 @@ Note [The Type-related module hierarchy]
 {-# LANGUAGE ImplicitParams #-}
 
 module TyCoRep (
-        TyThing(..),
+        TyThing(..), pprTyThingCategory, pprShortTyThing,
+
+        -- * Types
         Type(..),
         TyLit(..),
         KindOrType, Kind,
@@ -44,8 +46,8 @@ module TyCoRep (
         sameVis,
 
         -- * Functions over binders
-        TyBinder(..), TyVarBinder(..),
-        binderVar, binderType, binderVisibility,
+        TyBinder(..), TyVarBinder,
+        binderVar, binderVars, binderKind, binderVisibility,
         delBinderVar,
         isInvisible, isVisible,
         isInvisibleBinder, isVisibleBinder,
@@ -55,7 +57,7 @@ module TyCoRep (
 
         -- * Pretty-printing
         pprType, pprParendType, pprTypeApp, pprTvBndr, pprTvBndrs,
-        pprShortTyThing, pprTyThingCategory, pprSigmaType,
+        pprSigmaType,
         pprTheta, pprForAll, pprForAllImplicit, pprUserForAll,
         pprThetaArrowTy, pprClassPred,
         pprKind, pprParendKind, pprTyLit,
@@ -169,6 +171,63 @@ import Data.IORef ( IORef )   -- for CoercionHole
 import GHC.Stack (CallStack)
 #endif
 
+{-
+%************************************************************************
+%*                                                                      *
+                        TyThing
+%*                                                                      *
+%************************************************************************
+
+Despite the fact that DataCon has to be imported via a hi-boot route,
+this module seems the right place for TyThing, because it's needed for
+funTyCon and all the types in TysPrim.
+
+It is also SOURCE-imported into Name.hs
+
+
+Note [ATyCon for classes]
+~~~~~~~~~~~~~~~~~~~~~~~~~
+Both classes and type constructors are represented in the type environment
+as ATyCon.  You can tell the difference, and get to the class, with
+   isClassTyCon :: TyCon -> Bool
+   tyConClass_maybe :: TyCon -> Maybe Class
+The Class and its associated TyCon have the same Name.
+-}
+
+-- | A global typecheckable-thing, essentially anything that has a name.
+-- Not to be confused with a 'TcTyThing', which is also a typecheckable
+-- thing but in the *local* context.  See 'TcEnv' for how to retrieve
+-- a 'TyThing' given a 'Name'.
+data TyThing
+  = AnId     Id
+  | AConLike ConLike
+  | ATyCon   TyCon       -- TyCons and classes; see Note [ATyCon for classes]
+  | ACoAxiom (CoAxiom Branched)
+
+instance Outputable TyThing where
+  ppr = pprShortTyThing
+
+instance NamedThing TyThing where       -- Can't put this with the type
+  getName (AnId id)     = getName id    -- decl, because the DataCon instance
+  getName (ATyCon tc)   = getName tc    -- isn't visible there
+  getName (ACoAxiom cc) = getName cc
+  getName (AConLike cl) = conLikeName cl
+
+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)
+  | isClassTyCon tc = text "Class"
+  | otherwise       = text "Type constructor"
+pprTyThingCategory (ACoAxiom _) = text "Coercion axiom"
+pprTyThingCategory (AnId   _)   = text "Identifier"
+pprTyThingCategory (AConLike (RealDataCon _)) = text "Data constructor"
+pprTyThingCategory (AConLike (PatSynCon _))  = text "Pattern synonym"
+
+
 {- **********************************************************************
 *                                                                       *
                         Type
@@ -381,27 +440,6 @@ data TyBinder
   | Anon Type   -- Visibility is determined by the type (Constraint vs. *)
   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
--- prohibited entirely from appearing in source Haskell ('Invisible')?
--- See Note [TyBinders and VisibilityFlags]
-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
@@ -416,22 +454,6 @@ isInvisibleBinder (Anon ty)              = isPredTy ty
 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.
-sameVis :: VisibilityFlag -> VisibilityFlag -> Bool
-sameVis Visible Visible = True
-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]
 ~~~~~~~~~~~~~~~~~~~
@@ -584,18 +606,6 @@ We could change this decision, but Visible, Named TyBinders are rare
 anyway.  (Most are Anons.)
 -}
 
-instance Binary VisibilityFlag where
-  put_ bh Visible   = putByte bh 0
-  put_ bh Specified = putByte bh 1
-  put_ bh Invisible = putByte bh 2
-
-  get bh = do
-    h <- getByte bh
-    case h of
-      0 -> return Visible
-      1 -> return Specified
-      _ -> return Invisible
-
 
 {- **********************************************************************
 *                                                                       *
@@ -670,8 +680,8 @@ mkFunTy arg res = FunTy arg res
 mkFunTys :: [Type] -> Type -> Type
 mkFunTys tys ty = foldr mkFunTy ty tys
 
-mkForAllTy :: TyVarBinder -> Type -> Type
-mkForAllTy = ForAllTy
+mkForAllTy :: TyVar -> VisibilityFlag -> Type -> Type
+mkForAllTy tv vis ty = ForAllTy (TvBndr tv vis) ty
 
 -- | Wraps foralls over the type using the provided 'TyVar's from left to right
 mkForAllTys :: [TyVarBinder] -> Type -> Type
@@ -1564,60 +1574,6 @@ closeOverKindsDSet = fvDVarSet . closeOverKindsFV . dVarSetElems
 {-
 %************************************************************************
 %*                                                                      *
-                        TyThing
-%*                                                                      *
-%************************************************************************
-
-Despite the fact that DataCon has to be imported via a hi-boot route,
-this module seems the right place for TyThing, because it's needed for
-funTyCon and all the types in TysPrim.
-
-Note [ATyCon for classes]
-~~~~~~~~~~~~~~~~~~~~~~~~~
-Both classes and type constructors are represented in the type environment
-as ATyCon.  You can tell the difference, and get to the class, with
-   isClassTyCon :: TyCon -> Bool
-   tyConClass_maybe :: TyCon -> Maybe Class
-The Class and its associated TyCon have the same Name.
--}
-
--- | A global typecheckable-thing, essentially anything that has a name.
--- Not to be confused with a 'TcTyThing', which is also a typecheckable
--- thing but in the *local* context.  See 'TcEnv' for how to retrieve
--- a 'TyThing' given a 'Name'.
-data TyThing
-  = AnId     Id
-  | AConLike ConLike
-  | ATyCon   TyCon       -- TyCons and classes; see Note [ATyCon for classes]
-  | ACoAxiom (CoAxiom Branched)
-
-instance Outputable TyThing where
-  ppr = pprShortTyThing
-
-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)
-  | isClassTyCon tc = text "Class"
-  | otherwise       = text "Type constructor"
-pprTyThingCategory (ACoAxiom _) = text "Coercion axiom"
-pprTyThingCategory (AnId   _)   = text "Identifier"
-pprTyThingCategory (AConLike (RealDataCon _)) = text "Data constructor"
-pprTyThingCategory (AConLike (PatSynCon _))  = text "Pattern synonym"
-
-
-instance NamedThing TyThing where       -- Can't put this with the type
-  getName (AnId id)     = getName id    -- decl, because the DataCon instance
-  getName (ATyCon tc)   = getName tc    -- isn't visible there
-  getName (ACoAxiom cc) = getName cc
-  getName (AConLike cl) = conLikeName cl
-
-{-
-%************************************************************************
-%*                                                                      *
                         Substitutions
       Data type defined here to avoid unnecessary mutual recursion
 %*                                                                      *
@@ -2773,7 +2729,7 @@ pprUserForAll bndrs
     pprForAll bndrs
   where
     bndr_has_kind_var bndr
-      = not (isEmptyVarSet (tyCoVarsOfType (binderType bndr)))
+      = not (isEmptyVarSet (tyCoVarsOfType (binderKind bndr)))
 
 pprForAllImplicit :: [TyVar] -> SDoc
 pprForAllImplicit tvs = pprForAll [ TvBndr tv Specified | tv <- tvs ]
@@ -2826,19 +2782,11 @@ 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 tvb) = ppr tvb
-  ppr (Anon ty)   = text "[anon]" <+> ppr ty
-
-instance Outputable VisibilityFlag where
-  ppr Visible   = text "[vis]"
-  ppr Specified = text "[spec]"
-  ppr Invisible = text "[invis]"
+  ppr (Anon ty) = text "[anon]" <+> ppr ty
+  ppr (Named (TvBndr v Visible))   = ppr v
+  ppr (Named (TvBndr v Specified)) = char '@' <> ppr v
+  ppr (Named (TvBndr v Invisible)) = braces (ppr v)
 
 -----------------
 instance Outputable Coercion where -- defined here to avoid orphans
@@ -3164,13 +3112,15 @@ tidyTyCoVarBndr tidy_env@(occ_env, subst) tyvar
            else mkVarOcc   (occNameString occ ++ "0")
          | otherwise         = occ
 
-tidyTyVarBinder :: TidyEnv -> TyVarBinder -> (TidyEnv, TyVarBinder)
+tidyTyVarBinder :: TidyEnv -> TyVarBndr TyVar vis
+                -> (TidyEnv, TyVarBndr TyVar vis)
 tidyTyVarBinder tidy_env (TvBndr tv vis)
   = (tidy_env', TvBndr tv' vis)
   where
     (tidy_env', tv') = tidyTyCoVarBndr tidy_env tv
 
-tidyTyVarBinders :: TidyEnv -> [TyVarBinder] -> (TidyEnv, [TyVarBinder])
+tidyTyVarBinders :: TidyEnv -> [TyVarBndr TyVar vis]
+                 -> (TidyEnv, [TyVarBndr TyVar vis])
 tidyTyVarBinders = mapAccumL tidyTyVarBinder
 
 ---------------
index 314eed1..df2dfd5 100644 (file)
@@ -4,16 +4,12 @@ import Outputable ( SDoc )
 import Data.Data  ( Data )
 
 data Type
-data TyBinder
-data TyVarBinder
 data TyThing
 data Coercion
 data LeftOrRight
 data UnivCoProvenance
 data TCvSubst
 
-mkPiTys :: [TyBinder] -> Type -> Type
-
 type PredType = Type
 type Kind = Type
 type ThetaType = [PredType]
index c7c225d..ae97e34 100644 (file)
@@ -6,17 +6,22 @@
 The @TyCon@ datatype
 -}
 
-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP, FlexibleInstances #-}
 
 module TyCon(
         -- * Main TyCon data types
-        TyCon,
-
-        AlgTyConRhs(..), visibleDataCons,
+        TyCon, AlgTyConRhs(..), visibleDataCons,
         AlgTyConFlav(..), isNoParent,
         FamTyConFlav(..), Role(..), Injectivity(..),
         RuntimeRepInfo(..),
 
+        -- * TyConBinder
+        TyConBinder, TyConBndrVis(..),
+        mkNamedTyConBinder, mkNamedTyConBinders,
+        mkAnonTyConBinder, mkAnonTyConBinders,
+        tyConBinderVisibility, isNamedTyConBinder,
+        isVisibleTyConBinder, isInvisibleTyConBinder,
+
         -- ** Field labels
         tyConFieldLabels, tyConFieldLabelEnv,
 
@@ -91,7 +96,7 @@ module TyCon(
         expandSynTyCon_maybe,
         makeTyConAbstract,
         newTyConCo, newTyConCo_maybe,
-        pprPromotionQuote,
+        pprPromotionQuote, mkTyConKind,
 
         -- * Runtime type representation
         TyConRepName, tyConRepName_maybe,
@@ -111,9 +116,10 @@ module TyCon(
 
 #include "HsVersions.h"
 
-import {-# SOURCE #-} TyCoRep ( Kind, Type, PredType, TyBinder, pprType, mkPiTys )
+import {-# SOURCE #-} TyCoRep ( Kind, Type, PredType, pprType )
 import {-# SOURCE #-} TysWiredIn  ( runtimeRepTyCon, constraintKind
-                                  , vecCountTyCon, vecElemTyCon, liftedTypeKind )
+                                  , vecCountTyCon, vecElemTyCon, liftedTypeKind
+                                  , mkFunKind, mkForAllKind )
 import {-# SOURCE #-} DataCon ( DataCon, dataConExTyVars, dataConFieldLabels )
 
 import Binary
@@ -359,23 +365,130 @@ See also:
  * [Verifying injectivity annotation] in FamInstEnv
  * [Type inference for type families with injectivity] in TcInteract
 
-
 ************************************************************************
 *                                                                      *
-\subsection{The data type}
+                    TyConBinder
 *                                                                      *
 ************************************************************************
 -}
 
-{- Note [TyCon binders]
-~~~~~~~~~~~~~~~~~~~~~~~
+type TyConBinder = TyVarBndr TyVar TyConBndrVis
+
+data TyConBndrVis
+  = NamedTCB VisibilityFlag
+  | AnonTCB
+
+mkAnonTyConBinder :: TyVar -> TyConBinder
+mkAnonTyConBinder tv = TvBndr tv AnonTCB
+
+mkAnonTyConBinders :: [TyVar] -> [TyConBinder]
+mkAnonTyConBinders tvs = map mkAnonTyConBinder tvs
+
+mkNamedTyConBinder :: VisibilityFlag -> TyVar -> TyConBinder
+-- The odd argument order supports currying
+mkNamedTyConBinder vis tv = TvBndr tv (NamedTCB vis)
+
+mkNamedTyConBinders :: VisibilityFlag -> [TyVar] -> [TyConBinder]
+-- The odd argument order supports currying
+mkNamedTyConBinders vis tvs = map (mkNamedTyConBinder vis) tvs
+
+tyConBinderVisibility :: TyConBinder -> VisibilityFlag
+tyConBinderVisibility (TvBndr _ (NamedTCB vis)) = vis
+tyConBinderVisibility (TvBndr _ AnonTCB)        = Visible
+
+isNamedTyConBinder :: TyConBinder -> Bool
+isNamedTyConBinder (TvBndr _ (NamedTCB {})) = True
+isNamedTyConBinder _                        = False
+
+isVisibleTyConBinder :: TyVarBndr tv TyConBndrVis -> Bool
+-- Works for IfaceTyConBinder too
+isVisibleTyConBinder (TvBndr _ (NamedTCB vis)) = isVisible vis
+isVisibleTyConBinder (TvBndr _ AnonTCB)        = True
+
+isInvisibleTyConBinder :: TyVarBndr tv TyConBndrVis -> Bool
+-- Works for IfaceTyConBinder too
+isInvisibleTyConBinder tcb = not (isVisibleTyConBinder tcb)
+
+mkTyConKind :: [TyConBinder] -> Kind -> Kind
+mkTyConKind bndrs res_kind = foldr mk res_kind bndrs
+  where
+    mk :: TyConBinder -> Kind -> Kind
+    mk (TvBndr tv AnonTCB)        k = mkFunKind (tyVarKind tv) k
+    mk (TvBndr tv (NamedTCB vis)) k = mkForAllKind tv vis k
+
+{- Note [The binders/kind/arity fields of a TyCon]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+All TyCons have this group of fields
+  tyConBinders :: [TyConBinder]
+  tyConResKind :: Kind
+  tyConTyVars  :: [TyVra] -- Cached = binderVars tyConBinders
+  tyConKind    :: Kind    -- Cached = mkTyConKind tyConBinders tyConResKind
+  tyConArity   :: Arity   -- Cached = length tyConBinders
+
+They fit together like so:
+
+* tyConBinders gives the telescope of type variables on the LHS of the
+  type declaration.  For example:
+
+    type App a (b :: k) = a b
+
+  tyConBinders = [ TvBndr (k::*)   (NamedTCB Invisible)
+                 , TvBndr (a:k->*) AnonTCB
+                 , TvBndr (b:k)    AnonTCB ]
+
+  Note that that are three binders here, including the
+  kind variable k.
+
+  See Note [TyBinders and VisibilityFlags] in TyConRep for what
+  the visibility flag means.
+
+* Each TyConBinder tyConBinders has a TyVar, and that TyVar may
+  scope over some other part of the TyCon's definition. Eg
+      type T a = a->a
+  we have
+      tyConBinders = [ TvBndr (a:*) AnonTCB ]
+      synTcRhs     = a->a
+  So the 'a' scopes over the synTcRhs
+
+* From the tyConBinders and tyConResKind we can get the tyConKind
+  E.g for our App example:
+      App :: forall k. (k->*) -> k -> *
+
+  We get a 'forall' in the kind for each NamedTCB, and an arrow
+  for each AnonTCB
+
+  tyConKind is the full kind of the TyCon, not just the result kind
+
+* tyConArity is the arguments this TyCon must be applied to, to be
+  considered saturated.  Here we mean "applied to in the actual Type",
+  not surface syntax; i.e. including implicit kind variables.
+  So it's just (length tyConBinders)
+-}
+
+instance Outputable tv => Outputable (TyVarBndr tv TyConBndrVis) where
+  ppr (TvBndr v AnonTCB)              = ppr v
+  ppr (TvBndr v (NamedTCB Visible))   = ppr v
+  ppr (TvBndr v (NamedTCB Specified)) = char '@' <> ppr v
+  ppr (TvBndr v (NamedTCB Invisible)) = braces (ppr v)
+
+instance Binary TyConBndrVis where
+  put_ bh AnonTCB        = putByte bh 0
+  put_ bh (NamedTCB vis) = do { putByte bh 1; put_ bh vis }
 
-data TyConBinder = TCB TyVar TcConBinderVis
+  get bh = do { h <- getByte bh
+              ; case h of
+                  0 -> return AnonTCB
+                  _ -> do { vis <- get bh; return (NamedTCB vis) } }
 
-data TyConBinderVis = NamedTCB VisiblityFlag
-                    | AnonTCB
+
+{- *********************************************************************
+*                                                                      *
+               The TyCon type
+*                                                                      *
+************************************************************************
 -}
 
+
 -- | TyCons represent type constructors. Type constructors are introduced by
 -- things such as:
 --
@@ -405,10 +518,10 @@ data TyCon
         tyConName   :: Name,     -- ^ Name of the constructor
 
         -- See Note [The binders/kind/arity fields of a TyCon]
-        tyConBinders :: [TyBinder], -- ^ The TyBinders for this TyCon's kind.
-        tyConResKind :: Kind,       -- ^ Result kind
-        tyConKind   :: Kind,        -- ^ Kind of this TyCon
-        tyConArity  :: Arity,       -- ^ Arity
+        tyConBinders :: [TyConBinder], -- ^ Full binders
+        tyConResKind :: Kind,             -- ^ Result kind
+        tyConKind    :: Kind,             -- ^ Kind of this TyCon
+        tyConArity   :: Arity,            -- ^ Arity
 
         tcRepName :: TyConRepName
     }
@@ -434,23 +547,20 @@ data TyCon
         tyConName    :: Name,    -- ^ Name of the constructor
 
         -- See Note [The binders/kind/arity fields of a TyCon]
-        tyConBinders :: [TyBinder], -- ^ The TyBinders for this TyCon's kind.
-        tyConResKind :: Kind,       -- ^ Result kind
-        tyConKind   :: Kind,        -- ^ Kind of this TyCon
-        tyConArity  :: Arity,       -- ^ Arity
-
-        -- See Note [tyConTyVars and tyConBinders]
-        tyConTyVars  :: [TyVar], -- ^ The kind and type variables used in the
-                                 -- type constructor.
-                                 -- Invariant: length tyConTyVars = tyConArity
-                                 -- Precisely, this list scopes over:
-                                 --
-                                 -- 1. The 'algTcStupidTheta'
-                                 -- 2. The cached types in algTyConRhs.NewTyCon
-                                 -- 3. The family instance types if present
-                                 --
-                                 -- Note that it does /not/ scope over the data
-                                 -- constructors.
+        tyConBinders :: [TyConBinder], -- ^ Full binders
+        tyConTyVars  :: [TyVar],          -- ^ TyVar binders
+        tyConResKind :: Kind,             -- ^ Result kind
+        tyConKind    :: Kind,             -- ^ Kind of this TyCon
+        tyConArity   :: Arity,            -- ^ Arity
+
+              -- The tyConTyVars scope over:
+              --
+              -- 1. The 'algTcStupidTheta'
+              -- 2. The cached types in algTyConRhs.NewTyCon
+              -- 3. The family instance types if present
+              --
+              -- Note that it does /not/ scope over the data
+              -- constructors.
 
         tcRoles      :: [Role],  -- ^ The role for each type variable
                                  -- This list has length = tyConArity
@@ -497,15 +607,12 @@ data TyCon
         tyConName    :: Name,    -- ^ Name of the constructor
 
         -- See Note [The binders/kind/arity fields of a TyCon]
-        tyConBinders :: [TyBinder], -- ^ The TyBinders for this TyCon's kind.
-        tyConResKind :: Kind,       -- ^ Result kind
-        tyConKind   :: Kind,        -- ^ Kind of this TyCon
-        tyConArity  :: Arity,       -- ^ Arity
-
-        -- See Note [tyConTyVars and tyConBinders]
-        tyConTyVars  :: [TyVar], -- ^ List of type and kind variables in this
-                                 -- TyCon. Includes implicit kind variables.
-                                 -- Scopes over: synTcRhs
+        tyConBinders :: [TyConBinder], -- ^ Full binders
+        tyConTyVars  :: [TyVar],          -- ^ TyVar binders
+        tyConResKind :: Kind,             -- ^ Result kind
+        tyConKind    :: Kind,             -- ^ Kind of this TyCon
+        tyConArity   :: Arity,            -- ^ Arity
+             -- tyConTyVars scope over: synTcRhs
 
         tcRoles      :: [Role],  -- ^ The role for each type variable
                                  -- This list has length = tyConArity
@@ -525,16 +632,12 @@ data TyCon
         tyConName    :: Name,    -- ^ Name of the constructor
 
         -- See Note [The binders/kind/arity fields of a TyCon]
-        tyConBinders :: [TyBinder], -- ^ The TyBinders for this TyCon's kind.
-        tyConResKind :: Kind,       -- ^ Result kind
-        tyConKind   :: Kind,        -- ^ Kind of this TyCon
-        tyConArity  :: Arity,       -- ^ Arity
-
-        -- See Note [tyConTyVars and tyConBinders]
-        tyConTyVars  :: [TyVar], -- ^ The kind and type variables used in the
-                                 -- type constructor.
-                                 -- Invariant: length tyvars = arity
-            -- Needed to connect an associated family TyCon
+        tyConBinders :: [TyConBinder], -- ^ Full binders
+        tyConTyVars  :: [TyVar],          -- ^ TyVar binders
+        tyConResKind :: Kind,             -- ^ Result kind
+        tyConKind    :: Kind,             -- ^ Kind of this TyCon
+        tyConArity   :: Arity,            -- ^ Arity
+            -- tyConTyVars connect an associated family TyCon
             -- with its parent class; see TcValidity.checkConsistentFamInst
 
         famTcResVar  :: Maybe Name,   -- ^ Name of result type variable, used
@@ -566,10 +669,10 @@ data TyCon
         tyConName     :: Name,   -- ^ Name of the constructor
 
         -- See Note [The binders/kind/arity fields of a TyCon]
-        tyConBinders :: [TyBinder], -- ^ The TyBinders for this TyCon's kind.
-        tyConResKind :: Kind,       -- ^ Result kind
-        tyConKind   :: Kind,        -- ^ Kind of this TyCon
-        tyConArity  :: Arity,       -- ^ Arity
+        tyConBinders :: [TyConBinder], -- ^ Full binders
+        tyConResKind :: Kind,             -- ^ Result kind
+        tyConKind    :: Kind,             -- ^ Kind of this TyCon
+        tyConArity   :: Arity,            -- ^ Arity
 
         tcRoles       :: [Role], -- ^ The role for each type variable
                                  -- This list has length = tyConArity
@@ -590,10 +693,10 @@ data TyCon
         tyConName    :: Name,       -- ^ Same Name as the data constructor
 
         -- See Note [The binders/kind/arity fields of a TyCon]
-        tyConBinders :: [TyBinder], -- ^ The TyBinders for this TyCon's kind.
-        tyConResKind :: Kind,       -- ^ Result kind
-        tyConKind   :: Kind,        -- ^ Kind of this TyCon
-        tyConArity  :: Arity,       -- ^ Arity
+        tyConBinders :: [TyConBinder], -- ^ Full binders
+        tyConResKind :: Kind,             -- ^ Result kind
+        tyConKind    :: Kind,             -- ^ Kind of this TyCon
+        tyConArity   :: Arity,            -- ^ Arity
 
         tcRoles       :: [Role],    -- ^ Roles: N for kind vars, R for type vars
         dataCon       :: DataCon,   -- ^ Corresponding data constructor
@@ -608,11 +711,11 @@ data TyCon
         tyConUnsat  :: Bool,  -- ^ can this tycon be unsaturated?
 
         -- See Note [The binders/kind/arity fields of a TyCon]
-        tyConTyVars  :: [TyVar],    -- ^ The TyCon's parameterised tyvars
-        tyConBinders :: [TyBinder], -- ^ The TyBinders for this TyCon's kind.
-        tyConResKind :: Kind,       -- ^ Result kind
-        tyConKind    :: Kind,       -- ^ Kind of this TyCon
-        tyConArity   :: Arity,      -- ^ Arity
+        tyConBinders :: [TyConBinder], -- ^ Full binders
+        tyConTyVars  :: [TyVar],          -- ^ TyVar binders
+        tyConResKind :: Kind,             -- ^ Result kind
+        tyConKind    :: Kind,             -- ^ Kind of this TyCon
+        tyConArity   :: Arity,            -- ^ Arity
 
         tcTyConScopedTyVars :: [TyVar] -- ^ Scoped tyvars over the
                                        -- tycon's body. See Note [TcTyCon]
@@ -815,51 +918,8 @@ data FamTyConFlav
    -- | Built-in type family used by the TypeNats solver
    | BuiltInSynFamTyCon BuiltInSynFamily
 
-{- Note [The binders/kind/arity fields of a TyCon]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-All TyCons have this group of fields
-  tyConBinders :: [TyBinder]
-  tyConResKind :: Kind
-  tyConKind    :: Kind   -- Cached = mkPiTys tyConBinders tyConResKind
-  tyConArity   :: Arity  -- Cached = length tyConBinders
-
-They fit together like so:
-
-* tyConBinders gives the telescope of Named (forall'd)
-  Anon (ordinary ->) binders
-
-* Note that tyConBinders /includes/ Anon arguments.  For example:
-    type App a (b :: k) = a b
-      -- App :: forall {k}; (k->*) -> k -> *
-  we get
-    tyConTyBinders = [ Named (k :: *) Invisible, Anon (k->*), Anon k ]
-
-* tyConKind is the full kind of the TyCon,
-  not just the result kind
-
-* tyConArity is the arguments this TyCon must be applied to, to be
-  considered saturated.  Here we mean "applied to in the actual Type",
-  not surface syntax; i.e. including implicit kind variables.
-
-Note [tyConTyVars and tyConBinders]
-~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
-Consider
-  type App a (b :: k) = a b
-    -- App :: forall {k}; (k->*) -> k -> *
-
-For App we get:
-  tyConTyVars    = [ k:*,                      a:k->*,      b:k]
-  tyConTyBinders = [ Named (k :: *) Invisible, Anon (k->*), Anon k ]
-
-The tyConBinder field is used to construct the kind of App, namely
-  App :: forall {k}; (k->*) -> k -> *
-The tyConTyVars field always corresponds 1-1 with tyConBinders, and
-records the names of the binders.  That is important for type synonyms,
-etc, where those names scope over some other field in the TyCon. In
-this case, 'a' and 'b' are mentioned in the RHS.
-
-Note [Closed type families]
-~~~~~~~~~~~~~~~~~~~~~~~~~
+{- Note [Closed type families]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 * In an open type family you can add new instances later.  This is the
   usual case.
 
@@ -1240,14 +1300,14 @@ So we compromise, and move their Kind calculation to the call site.
 -- | Given the name of the function type constructor and it's kind, create the
 -- corresponding 'TyCon'. It is reccomended to use 'TyCoRep.funTyCon' if you want
 -- this functionality
-mkFunTyCon :: Name -> [TyBinder] -> Name -> TyCon
+mkFunTyCon :: Name -> [TyConBinder] -> Name -> TyCon
 mkFunTyCon name binders rep_nm
   = FunTyCon {
         tyConUnique  = nameUnique name,
         tyConName    = name,
         tyConBinders = binders,
         tyConResKind = liftedTypeKind,
-        tyConKind    = mkPiTys binders liftedTypeKind,
+        tyConKind    = mkTyConKind binders liftedTypeKind,
         tyConArity   = 2,
         tcRepName    = rep_nm
     }
@@ -1257,11 +1317,8 @@ mkFunTyCon name binders rep_nm
 -- type constructor - you can get hold of it easily (see Generics
 -- module)
 mkAlgTyCon :: Name
-           -> [TyBinder]        -- ^ Binders of the resulting 'TyCon'
+           -> [TyConBinder]  -- ^ Binders of the 'TyCon'
            -> Kind              -- ^ Result kind
-           -> [TyVar]           -- ^ 'TyVar's scoped over: see 'tyConTyVars'.
-                                --   Arity is inferred from the length of this
-                                --   list
            -> [Role]            -- ^ The roles for each TyVar
            -> Maybe CType       -- ^ The C type this type corresponds to
                                 --   when using the CAPI FFI
@@ -1272,15 +1329,15 @@ mkAlgTyCon :: Name
            -> RecFlag           -- ^ Is the 'TyCon' recursive?
            -> Bool              -- ^ Was the 'TyCon' declared with GADT syntax?
            -> TyCon
-mkAlgTyCon name binders res_kind tyvars roles cType stupid rhs parent is_rec gadt_syn
+mkAlgTyCon name binders res_kind roles cType stupid rhs parent is_rec gadt_syn
   = AlgTyCon {
         tyConName        = name,
         tyConUnique      = nameUnique name,
         tyConBinders     = binders,
         tyConResKind     = res_kind,
-        tyConKind        = mkPiTys binders res_kind,
-        tyConArity       = length tyvars,
-        tyConTyVars      = tyvars,
+        tyConKind        = mkTyConKind binders res_kind,
+        tyConArity       = length binders,
+        tyConTyVars      = binderVars binders,
         tcRoles          = roles,
         tyConCType       = cType,
         algTcStupidTheta = stupid,
@@ -1292,32 +1349,31 @@ mkAlgTyCon name binders res_kind tyvars roles cType stupid rhs parent is_rec gad
     }
 
 -- | Simpler specialization of 'mkAlgTyCon' for classes
-mkClassTyCon :: Name -> [TyBinder]
-             -> [TyVar] -> [Role] -> AlgTyConRhs -> Class
+mkClassTyCon :: Name -> [TyConBinder]
+             -> [Role] -> AlgTyConRhs -> Class
              -> RecFlag -> Name -> TyCon
-mkClassTyCon name binders tyvars roles rhs clas is_rec tc_rep_name
-  = mkAlgTyCon name binders constraintKind tyvars roles Nothing [] rhs
+mkClassTyCon name binders roles rhs clas is_rec tc_rep_name
+  = mkAlgTyCon name binders constraintKind roles Nothing [] rhs
                (ClassTyCon clas tc_rep_name)
                is_rec False
 
 mkTupleTyCon :: Name
-             -> [TyBinder]
+             -> [TyConBinder]
              -> Kind    -- ^ Result kind of the 'TyCon'
              -> Arity   -- ^ Arity of the tuple
-             -> [TyVar] -- ^ 'TyVar's scoped over: see 'tyConTyVars'
              -> DataCon
              -> TupleSort    -- ^ Whether the tuple is boxed or unboxed
              -> AlgTyConFlav
              -> TyCon
-mkTupleTyCon name binders res_kind arity tyvars con sort parent
+mkTupleTyCon name binders res_kind arity con sort parent
   = AlgTyCon {
         tyConName        = name,
         tyConUnique      = nameUnique name,
         tyConBinders     = binders,
         tyConResKind     = res_kind,
-        tyConKind        = mkPiTys binders res_kind,
+        tyConKind        = mkTyConKind binders res_kind,
         tyConArity       = arity,
-        tyConTyVars      = tyvars,
+        tyConTyVars      = binderVars binders,
         tcRoles          = replicate arity Representational,
         tyConCType       = Nothing,
         algTcStupidTheta = [],
@@ -1335,31 +1391,32 @@ mkTupleTyCon name binders res_kind arity tyvars con sort parent
 -- TcErrors sometimes calls typeKind.
 -- See also Note [Kind checking recursive type and class declarations]
 -- in TcTyClsDecls.
-mkTcTyCon :: Name -> [TyVar]
-          -> [TyBinder] -> Kind  -- ^ /result/ kind only
+mkTcTyCon :: Name
+          -> [TyConBinder]
+          -> Kind                -- ^ /result/ kind only
           -> Bool                -- ^ Can this be unsaturated?
           -> [TyVar]             -- ^ Scoped type variables, see Note [TcTyCon]
           -> TyCon
-mkTcTyCon name tvs binders res_kind unsat scoped_tvs
+mkTcTyCon name binders res_kind unsat scoped_tvs
   = TcTyCon { tyConUnique  = getUnique name
             , tyConName    = name
-            , tyConTyVars  = tvs
+            , tyConTyVars  = binderVars binders
             , tyConBinders = binders
             , tyConResKind = res_kind
-            , tyConKind    = mkPiTys binders res_kind
+            , tyConKind    = mkTyConKind binders res_kind
             , tyConUnsat   = unsat
             , tyConArity   = length binders
             , tcTyConScopedTyVars = scoped_tvs }
 
 -- | Create an unlifted primitive 'TyCon', such as @Int#@
-mkPrimTyCon :: Name -> [TyBinder]
+mkPrimTyCon :: Name -> [TyConBinder]
             -> Kind   -- ^ /result/ kind
             -> [Role] -> TyCon
 mkPrimTyCon name binders res_kind roles
   = mkPrimTyCon' name binders res_kind roles True (Just $ mkPrelTyConRepName name)
 
 -- | Kind constructors
-mkKindTyCon :: Name -> [TyBinder]
+mkKindTyCon :: Name -> [TyConBinder]
             -> Kind  -- ^ /result/ kind
             -> [Role] -> Name -> TyCon
 mkKindTyCon name binders res_kind roles rep_nm
@@ -1368,14 +1425,14 @@ mkKindTyCon name binders res_kind roles rep_nm
     tc = mkPrimTyCon' name binders res_kind roles False (Just rep_nm)
 
 -- | Create a lifted primitive 'TyCon' such as @RealWorld@
-mkLiftedPrimTyCon :: Name -> [TyBinder]
+mkLiftedPrimTyCon :: Name -> [TyConBinder]
                   -> Kind   -- ^ /result/ kind
                   -> [Role] -> TyCon
 mkLiftedPrimTyCon name binders res_kind roles
   = mkPrimTyCon' name binders res_kind roles False (Just rep_nm)
   where rep_nm = mkPrelTyConRepName name
 
-mkPrimTyCon' :: Name -> [TyBinder]
+mkPrimTyCon' :: Name -> [TyConBinder]
              -> Kind    -- ^ /result/ kind
              -> [Role]
              -> Bool -> Maybe TyConRepName -> TyCon
@@ -1385,7 +1442,7 @@ mkPrimTyCon' name binders res_kind roles is_unlifted rep_nm
         tyConUnique  = nameUnique name,
         tyConBinders = binders,
         tyConResKind = res_kind,
-        tyConKind    = mkPiTys binders res_kind,
+        tyConKind    = mkTyConKind binders res_kind,
         tyConArity   = length roles,
         tcRoles      = roles,
         isUnlifted   = is_unlifted,
@@ -1393,34 +1450,34 @@ mkPrimTyCon' name binders res_kind roles is_unlifted rep_nm
     }
 
 -- | Create a type synonym 'TyCon'
-mkSynonymTyCon :: Name -> [TyBinder] -> Kind   -- ^ /result/ kind
-               -> [TyVar] -> [Role] -> Type -> TyCon
-mkSynonymTyCon name binders res_kind tyvars roles rhs
+mkSynonymTyCon :: Name -> [TyConBinder] -> Kind   -- ^ /result/ kind
+               -> [Role] -> Type -> TyCon
+mkSynonymTyCon name binders res_kind roles rhs
   = SynonymTyCon {
         tyConName    = name,
         tyConUnique  = nameUnique name,
         tyConBinders = binders,
         tyConResKind = res_kind,
-        tyConKind    = mkPiTys binders res_kind,
-        tyConArity   = length tyvars,
-        tyConTyVars  = tyvars,
+        tyConKind    = mkTyConKind binders res_kind,
+        tyConArity   = length binders,
+        tyConTyVars  = binderVars binders,
         tcRoles      = roles,
         synTcRhs     = rhs
     }
 
 -- | Create a type family 'TyCon'
-mkFamilyTyCon :: Name -> [TyBinder] -> Kind  -- ^ /result/ kind
-              -> [TyVar] -> Maybe Name -> FamTyConFlav
+mkFamilyTyCon :: Name -> [TyConBinder] -> Kind  -- ^ /result/ kind
+              -> Maybe Name -> FamTyConFlav
               -> Maybe Class -> Injectivity -> TyCon
-mkFamilyTyCon name binders res_kind tyvars resVar flav parent inj
+mkFamilyTyCon name binders res_kind resVar flav parent inj
   = FamilyTyCon
       { tyConUnique  = nameUnique name
       , tyConName    = name
       , tyConBinders = binders
       , tyConResKind = res_kind
-      , tyConKind    = mkPiTys binders res_kind
-      , tyConArity   = length tyvars
-      , tyConTyVars  = tyvars
+      , tyConKind    = mkTyConKind binders res_kind
+      , tyConArity   = length binders
+      , tyConTyVars  = binderVars binders
       , famTcResVar  = resVar
       , famTcFlav    = flav
       , famTcParent  = parent
@@ -1432,23 +1489,22 @@ mkFamilyTyCon name binders res_kind tyvars resVar flav parent inj
 -- Somewhat dodgily, we give it the same Name
 -- as the data constructor itself; when we pretty-print
 -- the TyCon we add a quote; see the Outputable TyCon instance
-mkPromotedDataCon :: DataCon -> Name -> TyConRepName -> [TyBinder] -> Kind -> [Role]
+mkPromotedDataCon :: DataCon -> Name -> TyConRepName
+                  -> [TyConBinder] -> Kind -> [Role]
                   -> RuntimeRepInfo -> TyCon
 mkPromotedDataCon con name rep_name binders res_kind roles rep_info
   = PromotedDataCon {
         tyConUnique   = nameUnique name,
         tyConName     = name,
-        tyConArity    = arity,
+        tyConArity    = length roles,
         tcRoles       = roles,
         tyConBinders  = binders,
         tyConResKind  = res_kind,
-        tyConKind     = mkPiTys binders res_kind,
+        tyConKind     = mkTyConKind binders res_kind,
         dataCon       = con,
         tcRepName     = rep_name,
         promDcRepInfo = rep_info
   }
-  where
-    arity = length roles
 
 isFunTyCon :: TyCon -> Bool
 isFunTyCon (FunTyCon {}) = True
@@ -1463,7 +1519,7 @@ isAbstractTyCon _ = False
 -- Used when recovering from errors
 makeTyConAbstract :: TyCon -> TyCon
 makeTyConAbstract tc
-  = mkTcTyCon (tyConName tc) (tyConTyVars tc)
+  = mkTcTyCon (tyConName tc)
               (tyConBinders tc) (tyConResKind tc)
               (mightBeUnsaturatedTyCon tc) [{- no scoped vars -}]
 
index 5d27fa0..d77ed8a 100644 (file)
@@ -1,12 +1,7 @@
 module TyCon where
 
-import Name (Name)
-import Unique (Unique)
-
 data TyCon
 
-tyConName           :: TyCon -> Name
-tyConUnique         :: TyCon -> Unique
 isTupleTyCon        :: TyCon -> Bool
 isUnboxedTupleTyCon :: TyCon -> Bool
 isFunTyCon          :: TyCon -> Bool
index c20a158..93161b7 100644 (file)
@@ -39,7 +39,7 @@ module Type (
         splitForAllTys, splitForAllTyVarBndrs,
         splitForAllTy_maybe, splitForAllTy,
         splitPiTy_maybe, splitPiTy, splitPiTys,
-        mkPiTy, mkPiTys, mkTyBindersPreferAnon,
+        mkPiTy, mkPiTys, mkTyConBindersPreferAnon,
         mkLamType, mkLamTypes,
         piResultTy, piResultTys,
         applyTysX, dropForAlls,
@@ -82,14 +82,15 @@ module Type (
         predTypeEqRel,
 
         -- ** Binders
-        sameVis, mkNamedTyBinders,
+        sameVis,
         mkTyVarBinder, mkTyVarBinders,
-        mkAnonBinder, mkNamedBinder,
+        mkAnonBinder,
         isAnonTyBinder, isNamedTyBinder,
-        binderVar, binderType, binderVisibility,
-        tyBinderType, tyBinderVisibility,
+        binderVar, binderVars, binderKind, binderVisibility,
+        tyBinderType,
         binderRelevantType_maybe, caseBinder,
         isVisible, isInvisible, isVisibleBinder, isInvisibleBinder,
+        tyConBindersTyBinders,
 
         -- ** Common type constructors
         funTyCon,
@@ -880,10 +881,10 @@ piResultTys ty orig_args@(arg:args)
   | otherwise
   = pprPanic "piResultTys1" (ppr ty $$ ppr orig_args)
   where
+    in_scope = mkInScopeSet (tyCoVarsOfTypes (ty:orig_args))
+
     go :: TvSubstEnv -> Type -> [Type] -> Type
     go tv_env ty [] = substTy (mkTvSubst in_scope tv_env) ty
-      where
-        in_scope = mkInScopeSet (tyCoVarsOfTypes (ty:orig_args))
 
     go tv_env ty all_args@(arg:args)
       | Just ty' <- coreView ty
@@ -1098,7 +1099,7 @@ mkCastTy ty co = -- NB: don't check if the coercion "from" type matches here;
       = split_apps (t2:args) t1 co
     split_apps args (TyConApp tc tc_args) co
       | mightBeUnsaturatedTyCon tc
-      = affix_co (tyConBinders tc) (mkTyConTy tc) (tc_args `chkAppend` args) co
+      = affix_co (tyConTyBinders tc) (mkTyConTy tc) (tc_args `chkAppend` args) co
       | otherwise -- not decomposable... but it may still be oversaturated
       = let (non_decomp_args, decomp_args) = splitAt (tyConArity tc) tc_args
             saturated_tc = mkTyConApp tc non_decomp_args
@@ -1107,7 +1108,7 @@ mkCastTy ty co = -- NB: don't check if the coercion "from" type matches here;
                  saturated_tc (decomp_args `chkAppend` args) co
 
     split_apps args (FunTy arg res) co
-      = affix_co (tyConBinders funTyCon) (mkTyConTy funTyCon)
+      = affix_co (tyConTyBinders funTyCon) (mkTyConTy funTyCon)
                  (arg : res : args) co
     split_apps args ty co
       = affix_co (fst $ splitPiTys $ typeKind ty)
@@ -1134,6 +1135,17 @@ mkCastTy ty co = -- NB: don't check if the coercion "from" type matches here;
     no_double_casts (CastTy ty co1) co2 = CastTy ty (co1 `mkTransCo` co2)
     no_double_casts ty              co  = CastTy ty co
 
+tyConTyBinders :: TyCon -> [TyBinder]
+-- Return the tyConBinders in TyBinder form
+tyConTyBinders tycon = tyConBindersTyBinders (tyConBinders tycon)
+
+tyConBindersTyBinders :: [TyConBinder] -> [TyBinder]
+-- Return the tyConBinders in TyBinder form
+tyConBindersTyBinders = map to_tyb
+  where
+    to_tyb (TvBndr tv (NamedTCB vis)) = Named (TvBndr tv vis)
+    to_tyb (TvBndr tv AnonTCB)        = Anon (tyVarKind tv)
+
 {-
 --------------------------------------------------------------------
                             CoercionTy
@@ -1221,16 +1233,16 @@ 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)
+mkTyConBindersPreferAnon :: [TyVar] -> Type -> [TyConBinder]
+mkTyConBindersPreferAnon vars inner_ty = fst (go vars)
   where
-    go :: [TyVar] -> ([TyBinder], VarSet) -- also returns the free vars
+    go :: [TyVar] -> ([TyConBinder], VarSet) -- also returns the free vars
     go [] = ([], tyCoVarsOfType inner_ty)
     go (v:vs) |  v `elemVarSet` fvs
-              = ( Named (TvBndr v Visible) : binders
+              = ( TvBndr v (NamedTCB Visible) : binders
                 , fvs `delVarSet` v `unionVarSet` kind_vars )
               | otherwise
-              = ( Anon (tyVarKind v) : binders
+              = ( TvBndr v AnonTCB : binders
                 , fvs `unionVarSet` kind_vars )
       where
         (binders, fvs) = go vs
@@ -1382,18 +1394,10 @@ mkTyVarBinder vis var = TvBndr var 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.
 isAnonTyBinder :: TyBinder -> Bool
@@ -1406,16 +1410,9 @@ isNamedTyBinder (Anon {})  = False
 
 tyBinderType :: TyBinder -> Type
 -- Barely used
-tyBinderType (Named tvb) = binderType tvb
+tyBinderType (Named tvb) = binderKind 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
 binderRelevantType_maybe (Named {}) = Nothing
@@ -1764,7 +1761,7 @@ repType ty
       | Just ty' <- coreView ty
       = go rec_nts ty'
 
-    go rec_nts (ForAllTy (Named {}) ty2)  -- Drop type foralls
+    go rec_nts (ForAllTy _ ty2)  -- Drop type foralls
       = go rec_nts ty2
 
     go rec_nts (TyConApp tc tys)        -- Expand newtypes
@@ -1821,8 +1818,7 @@ kindPrimRep ki = WARN( True
 typeRepArity :: Arity -> Type -> RepArity
 typeRepArity 0 _ = 0
 typeRepArity n ty = case repType ty of
-  UnaryRep (ForAllTy bndr ty) -> length (flattenRepType (repType (binderType bndr)))
-                                 + typeRepArity (n - 1) ty
+  UnaryRep (FunTy arg res) -> length (flattenRepType (repType arg)) + typeRepArity (n - 1) res
   _ -> pprPanic "typeRepArity: arity greater than type can handle" (ppr (n, ty, repType ty))
 
 isVoidTy :: Type -> Bool
index 9436d19..f4c7939 100644 (file)
@@ -19,3 +19,4 @@ partitionInvisibles :: TyCon -> (a -> Type) -> [a] -> ([a], [a])
 coreView :: Type -> Maybe Type
 
 tyCoVarsOfTypesWellScoped :: [Type] -> [TyVar]
+
index 23cd0a2..9fbe128 100644 (file)
@@ -51,9 +51,8 @@ buildDataFamInst name' fam_tc vect_tc rhs
             rep_ty   = mkTyConApp rep_tc tys'
             pat_tys  = [mkTyConApp vect_tc tys']
             rep_tc   = mkAlgTyCon name'
-                           (mkTyBindersPreferAnon tyvars' liftedTypeKind)
+                           (mkTyConBindersPreferAnon tyvars' liftedTypeKind)
                            liftedTypeKind
-                           tyvars'
                            (map (const Nominal) tyvars')
                            Nothing
                            []          -- no stupid theta
@@ -85,7 +84,7 @@ buildPDataDataCon orig_name vect_tc repr_tc repr
                             (map (const no_bang) comp_tys)
                             (Just $ map (const HsLazy) comp_tys)
                             []                     -- no field labels
-                            tvs (map (mkNamedBinder . mkTyVarBinder Specified) tvs)
+                            (mkTyVarBinders Specified tvs)
                             []                     -- no existentials
                             []                     -- no eq spec
                             []                     -- no context
@@ -129,7 +128,7 @@ buildPDatasDataCon orig_name vect_tc repr_tc repr
                             (map (const no_bang) comp_tys)
                             (Just $ map (const HsLazy) comp_tys)
                             []                     -- no field labels
-                            tvs (map (mkNamedBinder . mkTyVarBinder Specified) tvs)
+                            (mkTyVarBinders Specified tvs)
                             []                     -- no existentials
                             []                     -- no eq spec
                             []                     -- no context
index 0bcdf0c..b6c8bec 100644 (file)
@@ -360,7 +360,7 @@ vectTypeEnv tycons vectTypeDecls vectClassDecls
         origName  = tyConName origTyCon
         vectName  = tyConName vectTyCon
 
-        mkSyn canonName ty = mkSynonymTyCon canonName [] (typeKind ty) [] [] ty
+        mkSyn canonName ty = mkSynonymTyCon canonName [] (typeKind ty) [] ty
 
         defDataCons
           | isAbstract = return ()
index 052eced..3085beb 100644 (file)
@@ -61,10 +61,9 @@ vectTyConDecl tycon name'
        ; cls' <- liftDs $
                    buildClass
                      name'                      -- new name: "V:Class"
-                     (tyConTyVars tycon)        -- keep original type vars
+                     (tyConBinders tycon)       -- keep original kind
                      (map (const Nominal) (tyConRoles tycon)) -- all role are N for safety
                      theta'                     -- superclasses
-                     (tyConBinders tycon)       -- keep original kind
                      (snd . classTvsFds $ cls)  -- keep the original functional dependencies
                      []                         -- no associated types (for the moment)
                      methods'                   -- method info
@@ -105,7 +104,6 @@ vectTyConDecl tycon name'
                     name'                   -- new name
                     (tyConBinders tycon)
                     (tyConResKind tycon)    -- keep original kind
-                    (tyConTyVars tycon)     -- keep original type vars
                     (map (const Nominal) (tyConRoles tycon)) -- all roles are N for safety
                     Nothing
                     []                      -- no stupid theta
@@ -191,7 +189,7 @@ vectDataCon dc
                     (dataConSrcBangs dc)           -- strictness as original constructor
                     (Just $ dataConImplBangs dc)
                     []                             -- no labelled fields for now
-                    univ_tvs univ_bndrs            -- universally quantified vars
+                    univ_bndrs                     -- universally quantified vars
                     []                             -- no existential tvs for now
                     []                             -- no equalities for now
                     []                             -- no context for now
@@ -204,4 +202,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  = map mkNamedBinder (dataConUnivTyVarBinders dc)
+    univ_bndrs  = dataConUnivTyVarBinders dc
index 9e7eba0..fe730f6 100644 (file)
@@ -1,6 +1,6 @@
 
 ado002.hs:8:8: error:
-    • Couldn't match expected type ‘Char -> IO t1
+    • Couldn't match expected type ‘Char -> IO b0
                   with actual type ‘IO Char’
     • The function ‘getChar’ is applied to one argument,
       but its type ‘IO Char’ has none
index 8f2e603..ae18bb6 100644 (file)
@@ -18,7 +18,7 @@ werror.hs:10:1: warning: [-Wunused-top-binds (in -Wextra, -Wunused-binds)]
 
 werror.hs:10:1: warning: [-Wmissing-signatures (in -Wall)]
     Top-level binding with no type signature:
-      f :: forall t t1. [t1] -> [t]
+      f :: forall a a1. [a1] -> [a]
 
 werror.hs:10:1: warning: [-Wincomplete-patterns (in -Wextra)]
     Pattern match(es) are non-exhaustive
index 06b1f9c..e304430 100644 (file)
@@ -1,17 +1,17 @@
-\r
-gadt13.hs:15:13: error:\r
-    • Couldn't match expected type ‘t’\r
-                  with actual type ‘String -> [Char]’\r
-        ‘t’ is untouchable\r
-          inside the constraints: t1 ~ Int\r
-          bound by a pattern with constructor: I :: Int -> Term Int,\r
-                   in an equation for ‘shw’\r
-          at gadt13.hs:15:6-8\r
-      ‘t’ is a rigid type variable bound by\r
-        the inferred type of shw :: Term t1 -> t at gadt13.hs:15:1-30\r
-      Possible fix: add a type signature for ‘shw’\r
-    • Possible cause: ‘(.)’ is applied to too many arguments\r
-      In the expression: ("I " ++) . shows t\r
-      In an equation for ‘shw’: shw (I t) = ("I " ++) . shows t\r
-    • Relevant bindings include\r
-        shw :: Term t1 -> t (bound at gadt13.hs:15:1)\r
+
+gadt13.hs:15:13: error:
+    • Couldn't match expected type ‘t’
+                  with actual type ‘String -> [Char]’
+        ‘t’ is untouchable
+          inside the constraints: a ~ Int
+          bound by a pattern with constructor: I :: Int -> Term Int,
+                   in an equation for ‘shw’
+          at gadt13.hs:15:6-8
+      ‘t’ is a rigid type variable bound by
+        the inferred type of shw :: Term a -> t at gadt13.hs:15:1-30
+      Possible fix: add a type signature for ‘shw’
+    • Possible cause: ‘(.)’ is applied to too many arguments
+      In the expression: ("I " ++) . shows t
+      In an equation for ‘shw’: shw (I t) = ("I " ++) . shows t
+    • Relevant bindings include
+        shw :: Term a -> t (bound at gadt13.hs:15:1)
index 6e1effa..e66226e 100644 (file)
@@ -1,20 +1,20 @@
-\r
-gadt7.hs:16:38: error:\r
-    • Couldn't match expected type ‘t’ with actual type ‘t1’\r
-        ‘t’ is untouchable\r
-          inside the constraints: t2 ~ Int\r
-          bound by a pattern with constructor: K :: T Int,\r
-                   in a case alternative\r
-          at gadt7.hs:16:33\r
-      ‘t’ is a rigid type variable bound by\r
-        the inferred type of i1b :: T t2 -> t1 -> t at gadt7.hs:16:1-44\r
-      ‘t1’ is a rigid type variable bound by\r
-        the inferred type of i1b :: T t2 -> t1 -> t at gadt7.hs:16:1-44\r
-      Possible fix: add a type signature for ‘i1b’\r
-    • In the expression: y1\r
-      In a case alternative: K -> y1\r
-      In the expression: case t1 of { K -> y1 }\r
-    • Relevant bindings include\r
-        y1 :: t1 (bound at gadt7.hs:16:16)\r
-        y :: t1 (bound at gadt7.hs:16:7)\r
-        i1b :: T t2 -> t1 -> t (bound at gadt7.hs:16:1)\r
+
+gadt7.hs:16:38: error:
+    • Couldn't match expected type ‘t’ with actual type ‘t1’
+        ‘t’ is untouchable
+          inside the constraints: a ~ Int
+          bound by a pattern with constructor: K :: T Int,
+                   in a case alternative
+          at gadt7.hs:16:33
+      ‘t’ is a rigid type variable bound by
+        the inferred type of i1b :: T a -> t1 -> t at gadt7.hs:16:1-44
+      ‘t1’ is a rigid type variable bound by
+        the inferred type of i1b :: T a -> t1 -> t at gadt7.hs:16:1-44
+      Possible fix: add a type signature for ‘i1b’
+    • In the expression: y1
+      In a case alternative: K -> y1
+      In the expression: case t1 of { K -> y1 }
+    • Relevant bindings include
+        y1 :: t1 (bound at gadt7.hs:16:16)
+        y :: t1 (bound at gadt7.hs:16:7)
+        i1b :: T a -> t1 -> t (bound at gadt7.hs:16:1)
index b4168d1..cecb2ce 100644 (file)
@@ -303,8 +303,8 @@ GHC.Generics representation types:
                                                                    'GHC.Generics.NoSourceStrictness
                                                                    'GHC.Generics.DecidedLazy)
                                                                 ((GHC.Generics.:.:)
-                                                                   (k -> GHC.Types.*)
                                                                    *
+                                                                   (k -> GHC.Types.*)
                                                                    (T10604_deriving.Proxy *)
                                                                    (GHC.Generics.Rec1
                                                                       (k -> GHC.Types.*)
index d069493..36398df 100644 (file)
@@ -1,5 +1,5 @@
 
 <interactive>:4:1: error:
-    • No instance for (Show (t1 -> t)) arising from a use of ‘print’
+    • No instance for (Show (t -> a)) arising from a use of ‘print’
         (maybe you haven't applied a function to enough arguments?)
     • In a stmt of an interactive GHCi command: print it
index 1d0844c..d510a47 100644 (file)
@@ -1,6 +1,6 @@
 Breakpoint 0 activated at ../Test3.hs:2:18-31
 Stopped in Main.mymap, ../Test3.hs:2:18-31
-_result :: [t] = _
-f :: t1 -> t = _
-x :: t1 = _
-xs :: [t1] = [_]
+_result :: [a] = _
+f :: t -> a = _
+x :: t = _
+xs :: [t] = [_]
index 81eae63..35e92d4 100644 (file)
@@ -4,7 +4,7 @@ a :: Integer = 1
 left :: [Integer] = _
 right :: [Integer] = _
 Stopped in QSort.qsort, ../QSort.hs:5:17-26
-_result :: [t] = _
-left :: [t] = _
+_result :: [a] = _
+left :: [a] = _
 ()
 left = []
index 463b66f..7929e36 100644 (file)
@@ -1,9 +1,9 @@
 
 <interactive>:4:1: error:
-    • No instance for (Show t) arising from a use of ‘print’
-      Cannot resolve unknown runtime type ‘t
+    • No instance for (Show a) arising from a use of ‘print’
+      Cannot resolve unknown runtime type ‘a
       Use :print or :force to determine these types
-      Relevant bindings include it :: t (bound at <interactive>:4:1)
+      Relevant bindings include it :: a (bound at <interactive>:4:1)
       These potential instances exist:
         instance (Show b, Show a) => Show (Either a b)
           -- Defined in ‘Data.Either’
     • In a stmt of an interactive GHCi command: print it
 
 <interactive>:6:1: error:
-    • No instance for (Show t) arising from a use of ‘print’
-      Cannot resolve unknown runtime type ‘t
+    • No instance for (Show a) arising from a use of ‘print’
+      Cannot resolve unknown runtime type ‘a
       Use :print or :force to determine these types
-      Relevant bindings include it :: t (bound at <interactive>:6:1)
+      Relevant bindings include it :: a (bound at <interactive>:6:1)
       These potential instances exist:
         instance (Show b, Show a) => Show (Either a b)
           -- Defined in ‘Data.Either’
index d8f1b65..35fa445 100644 (file)
@@ -1,13 +1,13 @@
 Stopped in Main.mymap, ../Test3.hs:2:18-31
-_result :: [t] = _
-f :: Integer -> t = _
+_result :: [a] = _
+f :: Integer -> a = _
 x :: Integer = 1
 xs :: [Integer] = [2,3]
 xs :: [Integer] = [2,3]
 x :: Integer = 1
-f :: Integer -> t = _
-_result :: [t] = _
-y = (_t1::t)
+f :: Integer -> a = _
+_result :: [a] = _
+y = (_t1::a)
 y = 2
 xs :: [Integer] = [2,3]
 x :: Integer = 1
index 7ef5dc1..9ae5688 100644 (file)
@@ -9,25 +9,25 @@ _result :: [a] = _
 -6  : mymap (../Test3.hs:2:18-31)
 <end of history>
 Logged breakpoint at ../Test3.hs:2:22-31
-_result :: [t]
-f :: t1 -> t
-xs :: [t1]
-xs :: [t1] = []
-f :: t1 -> t = _
-_result :: [t] = _
+_result :: [a]
+f :: t -> a
+xs :: [t]
+xs :: [t] = []
+f :: t -> a = _
+_result :: [a] = _
 Logged breakpoint at ../Test3.hs:2:18-20
-_result :: t
-f :: Integer -> t
+_result :: a
+f :: Integer -> a
 x :: Integer
-xs :: [t1] = []
+xs :: [t] = []
 x :: Integer = 2
-f :: Integer -> t = _
-_result :: t = _
+f :: Integer -> a = _
+_result :: a = _
 _result = 3
 Logged breakpoint at ../Test3.hs:2:18-31
-_result :: [t]
-f :: Integer -> t
+_result :: [a]
+f :: Integer -> a
 x :: Integer
 xs :: [Integer]
 Logged breakpoint at ../Test3.hs:2:18-20
-_result :: t
+_result :: a
index 0cc49e2..8434b21 100644 (file)
@@ -1,7 +1,7 @@
-f :: t -> [t]
+f :: a -> [a]
 g :: a -> Maybe a
-f :: t -> [t]
-f :: t -> [t]
+f :: a -> [a]
+f :: a -> [a]
 g :: a -> Maybe a
-f :: t -> [t]
+f :: a -> [a]
 g :: a -> Maybe a
index 0a9dddb..164e0cf 100644 (file)
@@ -3,11 +3,11 @@ without -fprint-explicit-foralls
 pattern P :: Bool      -- Defined at <interactive>:16:1
 pattern Pe :: a -> Ex  -- Defined at <interactive>:17:1
 pattern Pu :: t -> t   -- Defined at <interactive>:18:1
-pattern Pue :: t -> a -> (t, Ex)       -- Defined at <interactive>:19:1
+pattern Pue :: a -> a1 -> (a, Ex)      -- Defined at <interactive>:19:1
 pattern Pur :: (Num a, Eq a) => a -> [a]
        -- Defined at <interactive>:20:1
-pattern Purp :: (Num a, Eq a) => Show t => a
-                                           -> t -> ([a], UnivProv t)
+pattern Purp :: (Num a1, Eq a1) => Show a => a1
+                                             -> a -> ([a1], UnivProv a)
        -- Defined at <interactive>:21:1
 pattern Pure :: (Num a, Eq a) => a -> a1 -> ([a], Ex)
        -- Defined at <interactive>:22:1
@@ -16,9 +16,9 @@ pattern Purep :: (Num a, Eq a) => Show a1 => a
        -- Defined at <interactive>:23:1
 pattern Pep :: () => Show a => a -> ExProv
        -- Defined at <interactive>:24:1
-pattern Pup :: () => Show t => t -> UnivProv t
+pattern Pup :: () => Show a => a -> UnivProv a
        -- Defined at <interactive>:25:1
-pattern Puep :: () => Show a => a -> t -> (ExProv, t)
+pattern Puep :: () => Show a => a -> b -> (ExProv, b)
        -- Defined at <interactive>:26:1
 
 with -fprint-explicit-foralls
@@ -27,12 +27,12 @@ pattern P :: Bool   -- Defined at <interactive>:16:1
 pattern Pe :: () => forall {a}. a -> Ex
        -- Defined at <interactive>:17:1
 pattern Pu :: forall {t}. t -> t       -- Defined at <interactive>:18:1
-pattern Pue :: forall {t}. () => forall {a}. t -> a -> (t, Ex)
+pattern Pue :: forall {a}. () => forall {a1}. a -> a1 -> (a, Ex)
        -- Defined at <interactive>:19:1
 pattern Pur :: forall {a}. (Num a, Eq a) => a -> [a]
        -- Defined at <interactive>:20:1
-pattern Purp :: forall {t} {a}. (Num a, Eq a) => Show t => a
-                                                           -> t -> ([a], UnivProv t)
+pattern Purp :: forall {a} {a1}. (Num a1, Eq a1) => Show a => a1
+                                                              -> a -> ([a1], UnivProv a)
        -- Defined at <interactive>:21:1
 pattern Pure :: forall {a}. (Num a, Eq a) => forall {a1}. a
                                                           -> a1 -> ([a], Ex)
@@ -42,8 +42,8 @@ pattern Purep :: forall {a}. (Num a, Eq a) => forall {a1}. Show
        -- Defined at <interactive>:23:1
 pattern Pep :: () => forall {a}. Show a => a -> ExProv
        -- Defined at <interactive>:24:1
-pattern Pup :: forall {t}. () => Show t => t -> UnivProv t
+pattern Pup :: forall {a}. () => Show a => a -> UnivProv a
        -- Defined at <interactive>:25:1
-pattern Puep :: forall {t}. () => forall {a}. Show a => a
-                                                        -> t -> (ExProv, t)
+pattern Puep :: forall {b}. () => forall {a}. Show a => a
+                                                        -> b -> (ExProv, b)
        -- Defined at <interactive>:26:1
index f06760e..048f45d 100644 (file)
@@ -49,7 +49,7 @@
 
 <interactive>:60:15: error:
     Type family equation violates injectivity annotation.
-    Kind variable ‘k’ cannot be inferred from the right-hand side.
+    Kind variable ‘k1’ cannot be inferred from the right-hand side.
     Use -fprint-explicit-kinds to see the kind arguments
     In the type family equation:
       PolyKindVars '[] = '[] -- Defined at <interactive>:60:15
index 81a360f..2dfae37 100644 (file)
@@ -25,9 +25,9 @@ instance Foldable ((,) a) -- Defined in ‘Data.Foldable’
 instance Traversable ((,) a) -- Defined in ‘Data.Traversable’
 instance (Monoid a, Monoid b) => Monoid (a, b)
   -- Defined in ‘GHC.Base’
-data (#,#) (c :: TYPE a) (d :: TYPE b) = (#,#) c d
+data (#,#) (a :: TYPE k0) (b :: TYPE k1) = (#,#) a b
        -- Defined in ‘GHC.Prim’
 (,) :: a -> b -> (a, b)
-(#,#) :: c -> d -> (# c, d #)
+(#,#) :: a -> b -> (# a, b #)
 (  ,  ) :: a -> b -> (a, b)
-(#  ,  #) :: c -> d -> (# c, d #)
+(#  ,  #) :: a -> b -> (# a, b #)
index 6eb08cd..2f35e23 100644 (file)
@@ -1,4 +1,4 @@
-data (->) t1 t2        -- Defined in ‘GHC.Prim’
+data (->) a b  -- Defined in ‘GHC.Prim’
 infixr 0 `(->)`
 instance Monad ((->) r) -- Defined in ‘GHC.Base’
 instance Functor ((->) r) -- Defined in ‘GHC.Base’
index d0d9bd5..1fe5d79 100644 (file)
@@ -1,2 +1,2 @@
-pattern P :: () => (Num t1, Eq t) => A t1 t
+pattern P :: () => (Num x, Eq y) => A x y
        -- Defined at T8776.hs:6:1
index d6c3823..695aaaf 100644 (file)
@@ -1 +1 @@
-f :: Monad m => (m a, t) -> m b
+f :: Monad m => (m a, b) -> m b1
index 6eb08cd..2f35e23 100644 (file)
@@ -1,4 +1,4 @@
-data (->) t1 t2        -- Defined in ‘GHC.Prim’
+data (->) a b  -- Defined in ‘GHC.Prim’
 infixr 0 `(->)`
 instance Monad ((->) r) -- Defined in ‘GHC.Base’
 instance Functor ((->) r) -- Defined in ‘GHC.Base’
index fac6116..3cb103c 100644 (file)
@@ -1,4 +1,4 @@
 type role Coercible representational representational
-class a ~R# b => Coercible (a :: k) (b :: k)
+class a ~R# b => Coercible (a :: k0) (b :: k0)
        -- Defined in ‘GHC.Types’
 coerce :: Coercible a b => a -> b      -- Defined in ‘GHC.Prim’
index 6eb08cd..2f35e23 100644 (file)
@@ -1,4 +1,4 @@
-data (->) t1 t2        -- Defined in ‘GHC.Prim’
+data (->) a b  -- Defined in ‘GHC.Prim’
 infixr 0 `(->)`
 instance Monad ((->) r) -- Defined in ‘GHC.Base’
 instance Functor ((->) r) -- Defined in ‘GHC.Base’
index a3489d2..29877bf 100644 (file)
@@ -4,7 +4,7 @@ TYPE SIGNATURES
   emptyL :: forall a. ListColl a
   insert :: forall c. Coll c => Elem c -> c -> c
   test2 ::
-    forall t t1 c. (Elem c ~ (t, t1), Coll c, Num t, Num t1) => c -> c
+    forall a b c. (Elem c ~ (a, b), Coll c, Num a, Num b) => c -> c
 TYPE CONSTRUCTORS
   class Coll c where
     type family Elem c :: * open
index f8cd07d..0a1b9d3 100644 (file)
@@ -1,18 +1,18 @@
 
 ExtraTcsUntch.hs:23:18: error:
-    Couldn't match expected type ‘F Int’ with actual type ‘[[t]]’
-    In the first argument of ‘h’, namely ‘[x]’
-    In the expression: h [x]
-    In an equation for ‘g1’: g1 _ = h [x]
-    Relevant bindings include
-      x :: [t] (bound at ExtraTcsUntch.hs:21:3)
-      f :: [t] -> ((), ((), ())) (bound at ExtraTcsUntch.hs:21:1)
+    • Couldn't match expected type ‘F Int’ with actual type ‘[[a]]’
+    • In the first argument of ‘h’, namely ‘[x]’
+      In the expression: h [x]
+      In an equation for ‘g1’: g1 _ = h [x]
+    • Relevant bindings include
+        x :: [a] (bound at ExtraTcsUntch.hs:21:3)
+        f :: [a] -> ((), ((), ())) (bound at ExtraTcsUntch.hs:21:1)
 
 ExtraTcsUntch.hs:25:38: error:
-    Couldn't match expected type ‘F Int’ with actual type ‘[[t]]’
-    In the first argument of ‘h’, namely ‘[[undefined]]’
-    In the expression: h [[undefined]]
-    In the expression: (h [[undefined]], op x [y])
-    Relevant bindings include
-      x :: [t] (bound at ExtraTcsUntch.hs:21:3)
-      f :: [t] -> ((), ((), ())) (bound at ExtraTcsUntch.hs:21:1)
+    • Couldn't match expected type ‘F Int’ with actual type ‘[[a]]’
+    • In the first argument of ‘h’, namely ‘[[undefined]]’
+      In the expression: h [[undefined]]
+      In the expression: (h [[undefined]], op x [y])
+    • Relevant bindings include
+        x :: [a] (bound at ExtraTcsUntch.hs:21:3)
+        f :: [a] -> ((), ((), ())) (bound at ExtraTcsUntch.hs:21:1)
index e1a64e4..f7617ee 100644 (file)
@@ -1,9 +1,9 @@
 
 T7848.hs:6:1: error:
     • Occurs check: cannot construct the infinite type:
-        t ~ t2 -> t1 -> A -> A -> A -> A -> t0 -> t
+        t ~ t0 -> t1 -> A -> A -> A -> A -> t2 -> t
     • When checking that:
-          t2 -> t1 -> A -> A -> A -> A -> forall t4. t4 -> t
+          t0 -> t1 -> A -> A -> A -> A -> forall t2. t2 -> t
         is more polymorphic than: t
     • Relevant bindings include x :: t (bound at T7848.hs:6:1)
 
index 3cebd8f..23c059e 100644 (file)
@@ -1,38 +1,34 @@
 
 T10403.hs:15:7: warning: [-Wpartial-type-signatures (in -Wdefault)]
-    Found constraint wildcard ‘_’ standing for ‘Functor f’
-    In the type signature:
-      h1 :: _ => _
+    • Found type wildcard ‘_’ standing for ‘Functor f’
+      Where: ‘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-41
+    • 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
+               at T10403.hs:17:1-41
              ‘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
+               at T10403.hs:17:1-41
              ‘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)
+               at T10403.hs:17:1-41
+    • In the type signature: h1 :: _ => _
 
 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
+               at T10403.hs:22:1-41
              ‘a’ is a rigid type variable bound by
                the inferred type of h2 :: (a -> b) -> f0 a -> H f0
-               at T10403.hs:22:1
+               at T10403.hs:22:1-41
              ‘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)
+    • In the type signature: h2 :: _
 
 T10403.hs:22:15: warning: [-Wdeferred-type-errors (in -Wdefault)]
     • Ambiguous type variable ‘f0’ arising from a use of ‘fmap’
@@ -79,4 +75,3 @@ T10403.hs:28:20: warning: [-Wdeferred-type-errors (in -Wdefault)]
       In an equation for ‘app2’: app2 = h2 (H . I) (B ())
     • Relevant bindings include
         app2 :: H (B t) (bound at T10403.hs:28:1)
-
index c7420eb..7abf6e5 100644 (file)
@@ -2,9 +2,8 @@
 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 :: _
+               the inferred type of go :: Int -> t -> t at T11192.hs:8:8-17
+    • In the type signature: go :: _
       In the expression:
         let
           go :: _
@@ -16,18 +15,15 @@ T11192.hs:7:14: warning: [-Wpartial-type-signatures (in -Wdefault)]
                 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)
+    • Relevant bindings include 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 :: _
+    • Found type wildcard ‘_’ standing for ‘t1 -> t -> t’
+      Where: ‘t1’ is a rigid type variable bound by
+               the inferred type of go :: t1 -> t -> t at T11192.hs:14:8-17
+             ‘t’ is a rigid type variable bound by
+               the inferred type of go :: t1 -> t -> t at T11192.hs:14:8-17
+    • In the type signature: go :: _
       In the expression:
         let
           go :: _
@@ -39,7 +35,4 @@ T11192.hs:13:14: warning: [-Wpartial-type-signatures (in -Wdefault)]
                 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)
-
+    • Relevant bindings include succeeds :: a (bound at T11192.hs:12:1)
index 02a1233..a3b293b 100644 (file)
@@ -1,24 +1,24 @@
-\r
-T12033.hs:12:22: warning: [-Wpartial-type-signatures (in -Wdefault)]\r
-    • Found type wildcard ‘_’ standing for ‘v -> t’\r
-      Where: ‘t’ is a rigid type variable bound by\r
-               the inferred type of\r
-               makeTuple :: v -> t\r
-               makeExpression :: v -> t\r
-               at T12033.hs:(11,4)-(13,39)\r
-             ‘v’ is a rigid type variable bound by\r
-               the type signature for:\r
-                 tripleStoreToRuleSet :: forall v. v -> v\r
-               at T12033.hs:6:1-30\r
-    • In the type signature: makeExpression :: _\r
-      In an equation for ‘tripleStoreToRuleSet’:\r
-          tripleStoreToRuleSet getAtom\r
-            = makeTuple getAtom\r
-            where\r
-                makeRule v = makeExpression v\r
-                makeTuple v = makeExpression v\r
-                makeExpression :: _\r
-                makeExpression v = makeTuple getAtom\r
-    • Relevant bindings include\r
-        getAtom :: v (bound at T12033.hs:7:22)\r
-        tripleStoreToRuleSet :: v -> v (bound at T12033.hs:7:1)\r
+
+T12033.hs:12:22: warning: [-Wpartial-type-signatures (in -Wdefault)]
+    • Found type wildcard ‘_’ standing for ‘v -> t’
+      Where: ‘v’ is a rigid type variable bound by
+               the type signature for:
+                 tripleStoreToRuleSet :: forall v. v -> v
+               at T12033.hs:6:1-30
+             ‘t’ is a rigid type variable bound by
+               the inferred type of
+               makeTuple :: v -> t
+               makeExpression :: v -> t
+               at T12033.hs:(11,4)-(13,39)
+    • In the type signature: makeExpression :: _
+      In an equation for ‘tripleStoreToRuleSet’:
+          tripleStoreToRuleSet getAtom
+            = makeTuple getAtom
+            where
+                makeRule v = makeExpression v
+                makeTuple v = makeExpression v
+                makeExpression :: _
+                makeExpression v = makeTuple getAtom
+    • Relevant bindings include
+        getAtom :: v (bound at T12033.hs:7:22)
+        tripleStoreToRuleSet :: v -> v (bound at T12033.hs:7:1)
index 60b5b11..a69c59b 100644 (file)
@@ -1,50 +1,50 @@
-TYPE SIGNATURES\r
-  bar :: forall w t. t -> (t -> w) -> w\r
-  foo :: forall a. (Show a, Enum a) => a -> String\r
-TYPE CONSTRUCTORS\r
-COERCION AXIOMS\r
-Dependent modules: []\r
-Dependent packages: [base-4.9.0.0, ghc-prim-0.5.0.0,\r
-                     integer-gmp-1.0.0.1]\r
-\r
-WarningWildcardInstantiations.hs:5:14: warning: [-Wpartial-type-signatures (in -Wdefault)]\r
-    • Found type wildcard ‘_a’ standing for ‘a’\r
-      Where: ‘a’ is a rigid type variable bound by\r
-               the inferred type of foo :: (Show a, Enum a) => a -> String\r
-               at WarningWildcardInstantiations.hs:6:1-21\r
-    • In the type signature: foo :: (Show _a, _) => _a -> _\r
-\r
-WarningWildcardInstantiations.hs:5:18: warning: [-Wpartial-type-signatures (in -Wdefault)]\r
-    • Found type wildcard ‘_’ standing for ‘Enum a’\r
-      Where: ‘a’ is a rigid type variable bound by\r
-               the inferred type of foo :: (Show a, Enum a) => a -> String\r
-               at WarningWildcardInstantiations.hs:6:1-21\r
-    • In the type signature: foo :: (Show _a, _) => _a -> _\r
-\r
-WarningWildcardInstantiations.hs:5:30: warning: [-Wpartial-type-signatures (in -Wdefault)]\r
-    • Found type wildcard ‘_’ standing for ‘String’\r
-    • In the type signature: foo :: (Show _a, _) => _a -> _\r
-\r
-WarningWildcardInstantiations.hs:8:8: warning: [-Wpartial-type-signatures (in -Wdefault)]\r
-    • Found type wildcard ‘_’ standing for ‘t’\r
-      Where: ‘t’ is a rigid type variable bound by\r
-               the inferred type of bar :: t -> (t -> w) -> w\r
-               at WarningWildcardInstantiations.hs:9:1-13\r
-    • In the type signature: bar :: _ -> _ -> _\r
-\r
-WarningWildcardInstantiations.hs:8:13: warning: [-Wpartial-type-signatures (in -Wdefault)]\r
-    • Found type wildcard ‘_’ standing for ‘t -> w’\r
-      Where: ‘w’ is a rigid type variable bound by\r
-               the inferred type of bar :: t -> (t -> w) -> w\r
-               at WarningWildcardInstantiations.hs:9:1-13\r
-             ‘t’ is a rigid type variable bound by\r
-               the inferred type of bar :: t -> (t -> w) -> w\r
-               at WarningWildcardInstantiations.hs:9:1-13\r
-    • In the type signature: bar :: _ -> _ -> _\r
-\r
-WarningWildcardInstantiations.hs:8:18: warning: [-Wpartial-type-signatures (in -Wdefault)]\r
-    • Found type wildcard ‘_’ standing for ‘w’\r
-      Where: ‘w’ is a rigid type variable bound by\r
-               the inferred type of bar :: t -> (t -> w) -> w\r
-               at WarningWildcardInstantiations.hs:9:1-13\r
-    • In the type signature: bar :: _ -> _ -> _\r
+TYPE SIGNATURES
+  bar :: forall w t. t -> (t -> w) -> w
+  foo :: forall a. (Show a, Enum a) => a -> String
+TYPE CONSTRUCTORS
+COERCION AXIOMS
+Dependent modules: []
+Dependent packages: [base-4.9.0.0, ghc-prim-0.5.0.0,
+                     integer-gmp-1.0.0.1]
+
+WarningWildcardInstantiations.hs:5:14: warning: [-Wpartial-type-signatures (in -Wdefault)]
+    • Found type wildcard ‘_a’ standing for ‘a’
+      Where: ‘a’ is a rigid type variable bound by
+               the inferred type of foo :: (Show a, Enum a) => a -> String
+               at WarningWildcardInstantiations.hs:6:1-21
+    • In the type signature: foo :: (Show _a, _) => _a -> _
+
+WarningWildcardInstantiations.hs:5:18: warning: [-Wpartial-type-signatures (in -Wdefault)]
+    • Found type wildcard ‘_’ standing for ‘Enum a’
+      Where: ‘a’ is a rigid type variable bound by
+               the inferred type of foo :: (Show a, Enum a) => a -> String
+               at WarningWildcardInstantiations.hs:6:1-21
+    • In the type signature: foo :: (Show _a, _) => _a -> _
+
+WarningWildcardInstantiations.hs:5:30: warning: [-Wpartial-type-signatures (in -Wdefault)]
+    • Found type wildcard ‘_’ standing for ‘String’
+    • In the type signature: foo :: (Show _a, _) => _a -> _
+
+WarningWildcardInstantiations.hs:8:8: warning: [-Wpartial-type-signatures (in -Wdefault)]
+    • Found type wildcard ‘_’ standing for ‘t’
+      Where: ‘t’ is a rigid type variable bound by
+               the inferred type of bar :: t -> (t -> w) -> w
+               at WarningWildcardInstantiations.hs:9:1-13
+    • In the type signature: bar :: _ -> _ -> _
+
+WarningWildcardInstantiations.hs:8:13: warning: [-Wpartial-type-signatures (in -Wdefault)]
+    • Found type wildcard ‘_’ standing for ‘t -> w’
+      Where: ‘t’ is a rigid type variable bound by
+               the inferred type of bar :: t -> (t -> w) -> w
+               at WarningWildcardInstantiations.hs:9:1-13
+             ‘w’ is a rigid type variable bound by
+               the inferred type of bar :: t -> (t -> w) -> w
+               at WarningWildcardInstantiations.hs:9:1-13
+    • In the type signature: bar :: _ -> _ -> _
+
+WarningWildcardInstantiations.hs:8:18: warning: [-Wpartial-type-signatures (in -Wdefault)]
+    • Found type wildcard ‘_’ standing for ‘w’
+      Where: ‘w’ is a rigid type variable bound by
+               the inferred type of bar :: t -> (t -> w) -> w
+               at WarningWildcardInstantiations.hs:9:1-13
+    • In the type signature: bar :: _ -> _ -> _
index e9cac55..16a5bf8 100644 (file)
@@ -1,13 +1,12 @@
 
 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
+    • Found type wildcard ‘_’ standing for ‘t2 -> Bool -> t1
+      Where: ‘t2’ is a rigid type variable bound by
+               the inferred type of copy :: t2 -> Bool -> t1 at T10045.hs:7:10-34
+             ‘t1’ is a rigid type variable bound by
+               the inferred type of copy :: t2 -> Bool -> t1 at T10045.hs:7:10-34
       To use the inferred type, enable PartialTypeSignatures
-    • In the type signature:
-        copy :: _
+    • In the type signature: copy :: _
       In the expression:
         let
           copy :: _
@@ -20,7 +19,5 @@ T10045.hs:6:18: error:
                 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 d026cbc..440d872 100644 (file)
@@ -1,48 +1,48 @@
-\r
-WildcardInstantiations.hs:5:14: error:\r
-    • Found type wildcard ‘_a’ standing for ‘a’\r
-      Where: ‘a’ is a rigid type variable bound by\r
-               the inferred type of foo :: (Show a, Enum a) => a -> String\r
-               at WildcardInstantiations.hs:6:1-21\r
-      To use the inferred type, enable PartialTypeSignatures\r
-    • In the type signature: foo :: (Show _a, _) => _a -> _\r
-\r
-WildcardInstantiations.hs:5:18: error:\r
-    • Found type wildcard ‘_’ standing for ‘Enum a’\r
-      Where: ‘a’ is a rigid type variable bound by\r
-               the inferred type of foo :: (Show a, Enum a) => a -> String\r
-               at WildcardInstantiations.hs:6:1-21\r
-      To use the inferred type, enable PartialTypeSignatures\r
-    • In the type signature: foo :: (Show _a, _) => _a -> _\r
-\r
-WildcardInstantiations.hs:5:30: error:\r
-    • Found type wildcard ‘_’ standing for ‘String’\r
-      To use the inferred type, enable PartialTypeSignatures\r
-    • In the type signature: foo :: (Show _a, _) => _a -> _\r
-\r
-WildcardInstantiations.hs:8:8: error:\r
-    • Found type wildcard ‘_’ standing for ‘t’\r
-      Where: ‘t’ is a rigid type variable bound by\r
-               the inferred type of bar :: t -> (t -> w) -> w\r
-               at WildcardInstantiations.hs:9:1-13\r
-      To use the inferred type, enable PartialTypeSignatures\r
-    • In the type signature: bar :: _ -> _ -> _\r
-\r
-WildcardInstantiations.hs:8:13: error:\r
-    • Found type wildcard ‘_’ standing for ‘t -> w’\r
-      Where: ‘w’ is a rigid type variable bound by\r
-               the inferred type of bar :: t -> (t -> w) -> w\r
-               at WildcardInstantiations.hs:9:1-13\r
-             ‘t’ is a rigid type variable bound by\r
-               the inferred type of bar :: t -> (t -> w) -> w\r
-               at WildcardInstantiations.hs:9:1-13\r
-      To use the inferred type, enable PartialTypeSignatures\r
-    • In the type signature: bar :: _ -> _ -> _\r
-\r
-WildcardInstantiations.hs:8:18: error:\r
-    • Found type wildcard ‘_’ standing for ‘w’\r
-      Where: ‘w’ is a rigid type variable bound by\r
-               the inferred type of bar :: t -> (t -> w) -> w\r
-               at WildcardInstantiations.hs:9:1-13\r
-      To use the inferred type, enable PartialTypeSignatures\r
-    • In the type signature: bar :: _ -> _ -> _\r
+
+WildcardInstantiations.hs:5:14: error:
+    • Found type wildcard ‘_a’ standing for ‘a’
+      Where: ‘a’ is a rigid type variable bound by
+               the inferred type of foo :: (Show a, Enum a) => a -> String
+               at WildcardInstantiations.hs:6:1-21
+      To use the inferred type, enable PartialTypeSignatures
+    • In the type signature: foo :: (Show _a, _) => _a -> _
+
+WildcardInstantiations.hs:5:18: error:
+    • Found type wildcard ‘_’ standing for ‘Enum a’
+      Where: ‘a’ is a rigid type variable bound by
+               the inferred type of foo :: (Show a, Enum a) => a -> String
+               at WildcardInstantiations.hs:6:1-21
+      To use the inferred type, enable PartialTypeSignatures
+    • In the type signature: foo :: (Show _a, _) => _a -> _
+
+WildcardInstantiations.hs:5:30: error:
+    • Found type wildcard ‘_’ standing for ‘String’
+      To use the inferred type, enable PartialTypeSignatures
+    • In the type signature: foo :: (Show _a, _) => _a -> _
+
+WildcardInstantiations.hs:8:8: error:
+    • Found type wildcard ‘_’ standing for ‘t’
+      Where: ‘t’ is a rigid type variable bound by
+               the inferred type of bar :: t -> (t -> w) -> w
+               at WildcardInstantiations.hs:9:1-13
+      To use the inferred type, enable PartialTypeSignatures
+    • In the type signature: bar :: _ -> _ -> _
+
+WildcardInstantiations.hs:8:13: error:
+    • Found type wildcard ‘_’ standing for ‘t -> w’
+      Where: ‘t’ is a rigid type variable bound by
+               the inferred type of bar :: t -> (t -> w) -> w
+               at WildcardInstantiations.hs:9:1-13
+             ‘w’ is a rigid type variable bound by
+               the inferred type of bar :: t -> (t -> w) -> w
+               at WildcardInstantiations.hs:9:1-13
+      To use the inferred type, enable PartialTypeSignatures
+    • In the type signature: bar :: _ -> _ -> _
+
+WildcardInstantiations.hs:8:18: error:
+    • Found type wildcard ‘_’ standing for ‘w’
+      Where: ‘w’ is a rigid type variable bound by
+               the inferred type of bar :: t -> (t -> w) -> w
+               at WildcardInstantiations.hs:9:1-13
+      To use the inferred type, enable PartialTypeSignatures
+    • In the type signature: bar :: _ -> _ -> _
index 7a0af54..72f67e3 100644 (file)
@@ -11,7 +11,7 @@ T11213.hs:21:1: warning: [-Wmissing-pattern-synonym-signatures (in -Wall)]
 
 T11213.hs:22:1: warning: [-Wmissing-pattern-synonym-signatures (in -Wall)]
     Top-level binding with no type signature:
-      Pue :: forall t. () => forall a. t -> a -> (t, Ex)
+      Pue :: forall a. () => forall a1. a -> a1 -> (a, Ex)
 
 T11213.hs:23:1: warning: [-Wmissing-pattern-synonym-signatures (in -Wall)]
     Top-level binding with no type signature:
@@ -19,9 +19,9 @@ T11213.hs:23:1: warning: [-Wmissing-pattern-synonym-signatures (in -Wall)]
 
 T11213.hs:24:1: warning: [-Wmissing-pattern-synonym-signatures (in -Wall)]
     Top-level binding with no type signature:
-      Purp :: forall t a.
-              (Num a, Eq a) =>
-              Show t => a -> t -> ([a], UnivProv t)
+      Purp :: forall a a1.
+              (Num a1, Eq a1) =>
+              Show a => a1 -> a -> ([a1], UnivProv a)
 
 T11213.hs:25:1: warning: [-Wmissing-pattern-synonym-signatures (in -Wall)]
     Top-level binding with no type signature:
@@ -39,8 +39,8 @@ T11213.hs:27:1: warning: [-Wmissing-pattern-synonym-signatures (in -Wall)]
 
 T11213.hs:28:1: warning: [-Wmissing-pattern-synonym-signatures (in -Wall)]
     Top-level binding with no type signature:
-      Pup :: forall t. () => Show t => t -> UnivProv t
+      Pup :: forall a. () => Show a => a -> UnivProv a
 
 T11213.hs:29:1: warning: [-Wmissing-pattern-synonym-signatures (in -Wall)]
     Top-level binding with no type signature:
-      Puep :: forall t. () => forall a. Show a => a -> t -> (ExProv, t)
+      Puep :: forall b. () => forall a. Show a => a -> b -> (ExProv, b)
index e583aa1..40dae30 100644 (file)
@@ -4,16 +4,16 @@ T11053.hs:7:1: warning: [-Wmissing-pattern-synonym-signatures (in -Wall)]
 
 T11053.hs:9:1: warning: [-Wmissing-pattern-synonym-signatures (in -Wall)]
     Top-level binding with no type signature:
-      J :: forall t. t -> Maybe t
+      J :: forall a. a -> Maybe a
 
 T11053.hs:11:1: warning: [-Wmissing-pattern-synonym-signatures (in -Wall)]
     Top-level binding with no type signature:
-      J1 :: forall t. t -> Maybe t
+      J1 :: forall a. a -> Maybe a
 
 T11053.hs:13:1: warning: [-Wmissing-pattern-synonym-signatures (in -Wall)]
     Top-level binding with no type signature:
-      J2 :: forall t. t -> Maybe t
+      J2 :: forall a. a -> Maybe a
 
 T11053.hs:15:1: warning: [-Wmissing-pattern-synonym-signatures (in -Wall)]
     Top-level binding with no type signature:
-      J3 :: forall t. t -> Maybe t
+      J3 :: forall a. a -> Maybe a
index 3dcecbc..d3e6c0e 100644 (file)
@@ -1,3 +1,3 @@
-pattern Single :: t -> [t]     -- Defined at <interactive>:3:1
+pattern Single :: a -> [a]     -- Defined at <interactive>:3:1
 foo :: [Bool] -> [Bool]
 [False]
index 58e883e..95b3a77 100644 (file)
@@ -1,7 +1,6 @@
 
 T7328.hs:8:34: error:
-    • Occurs check: cannot construct the infinite kind: k0 ~ k1 -> k0
+    • Occurs check: cannot construct the infinite kind: k1 ~ k0 -> k1
     • In the first argument of ‘Foo’, namely ‘f’
       In the first argument of ‘Proxy’, namely ‘Foo f’
-      In the type signature:
-        foo :: a ~ f i => Proxy (Foo f)
+      In the type signature: foo :: a ~ f i => Proxy (Foo f)
index 31ac2a3..9f8f62e 100644 (file)
@@ -1,21 +1,19 @@
-\r
-T7438.hs:6:14: error:\r
-    • Couldn't match expected type ‘t2’ with actual type ‘t3’\r
-        ‘t2’ is untouchable\r
-          inside the constraints: t ~ t1\r
-          bound by a pattern with constructor:\r
-                     Nil :: forall k (a :: k). Thrist a a,\r
-                   in an equation for ‘go’\r
-          at T7438.hs:6:4-6\r
-      ‘t2’ is a rigid type variable bound by\r
-        the inferred type of go :: Thrist t1 t -> t3 -> t2\r
-        at T7438.hs:6:1-16\r
-      ‘t3’ is a rigid type variable bound by\r
-        the inferred type of go :: Thrist t1 t -> t3 -> t2\r
-        at T7438.hs:6:1-16\r
-      Possible fix: add a type signature for ‘go’\r
-    • In the expression: acc\r
-      In an equation for ‘go’: go Nil acc = acc\r
-    • Relevant bindings include\r
-        acc :: t3 (bound at T7438.hs:6:8)\r
-        go :: Thrist t1 t -> t3 -> t2 (bound at T7438.hs:6:1)\r
+
+T7438.hs:6:14: error:
+    • Couldn't match expected type ‘t’ with actual type ‘t1’
+        ‘t’ is untouchable
+          inside the constraints: b ~ a
+          bound by a pattern with constructor:
+                     Nil :: forall k (a :: k). Thrist a a,
+                   in an equation for ‘go’
+          at T7438.hs:6:4-6
+      ‘t’ is a rigid type variable bound by
+        the inferred type of go :: Thrist a b -> t1 -> t at T7438.hs:6:1-16
+      ‘t1’ is a rigid type variable bound by
+        the inferred type of go :: Thrist a b -> t1 -> t at T7438.hs:6:1-16
+      Possible fix: add a type signature for ‘go’
+    • In the expression: acc
+      In an equation for ‘go’: go Nil acc = acc
+    • Relevant bindings include
+        acc :: t1 (bound at T7438.hs:6:8)
+        go :: Thrist a b -> t1 -> t (bound at T7438.hs:6:1)
index 409e66a..79a9a46 100644 (file)
@@ -1,14 +1,13 @@
 
 T9017.hs:8:7: error:
-    • Couldn't match kind ‘k1’ with ‘*’
-      ‘k1’ is a rigid type variable bound by
+    • Couldn't match kind ‘k’ with ‘*’
+      ‘k’ 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
+        at T9017.hs:7:1-16
       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 8667f31..241cf76 100644 (file)
@@ -25,7 +25,7 @@ rebindable6.hs:110:17: error:
                    return b }
 
 rebindable6.hs:111:17: error:
-    • Ambiguous type variables ‘t0’, ‘t1’ arising from a do statement
+    • Ambiguous type variables ‘t1’, ‘t0’ arising from a do statement
       prevents the constraint ‘(HasBind
                                   (IO (Maybe b) -> (Maybe b -> t1) -> t0))’ from being solved.
         (maybe you haven't applied a function to enough arguments?)
@@ -33,7 +33,7 @@ rebindable6.hs:111:17: error:
         g :: IO (Maybe b) (bound at rebindable6.hs:108:19)
         test_do :: IO a -> IO (Maybe b) -> IO b
           (bound at rebindable6.hs:108:9)
-      Probable fix: use a type annotation to specify what ‘t0’, ‘t1’ should be.
+      Probable fix: use a type annotation to specify what ‘t1’, ‘t0’ should be.
       These potential instance exist:
         instance HasBind (IO a -> (a -> IO b) -> IO b)
           -- Defined at rebindable6.hs:51:18
index 21c3547..8b4dc2c 100644 (file)
@@ -1,6 +1,6 @@
 
 T10618.hs:3:22: error:
-    • Variable not in scope: (<>) :: Maybe (Maybe a1) -> Maybe a0 -> t
+    • Variable not in scope: (<>) :: Maybe (Maybe a0) -> Maybe a1 -> t
     • Perhaps you meant one of these:
         ‘<$>’ (imported from Prelude), ‘*>’ (imported from Prelude),
         ‘<$’ (imported from Prelude)
index ab778a0..cf206a1 100644 (file)
@@ -1,54 +1,54 @@
-\r
-tc141.hs:11:12: error:\r
-    • You cannot bind scoped type variable ‘a’\r
-        in a pattern binding signature\r
-    • In the pattern: p :: a\r
-      In the pattern: (p :: a, q :: a)\r
-      In a pattern binding: (p :: a, q :: a) = x\r
-\r
-tc141.hs:11:31: error:\r
-    • Couldn't match expected type ‘a1’ with actual type ‘a’\r
-        because type variable ‘a1’ would escape its scope\r
-      This (rigid, skolem) type variable is bound by\r
-        an expression type signature:\r
-          a1\r
-        at tc141.hs:11:34\r
-    • In the expression: q :: a\r
-      In the expression: (q :: a, p)\r
-      In the expression: let (p :: a, q :: a) = x in (q :: a, p)\r
-    • Relevant bindings include\r
-        p :: a (bound at tc141.hs:11:12)\r
-        q :: a (bound at tc141.hs:11:17)\r
-        x :: (a, a) (bound at tc141.hs:11:3)\r
-        f :: (a, a) -> (t, a) (bound at tc141.hs:11:1)\r
-\r
-tc141.hs:13:13: error:\r
-    • You cannot bind scoped type variable ‘a’\r
-        in a pattern binding signature\r
-    • In the pattern: y :: a\r
-      In a pattern binding: y :: a = a\r
-      In the expression:\r
-        let y :: a = a in\r
-        let\r
-          v :: a\r
-          v = b\r
-        in v\r
-\r
-tc141.hs:15:18: error:\r
-    • Couldn't match expected type ‘a1’ with actual type ‘t’\r
-        because type variable ‘a1’ would escape its scope\r
-      This (rigid, skolem) type variable is bound by\r
-        the type signature for:\r
-          v :: a1\r
-        at tc141.hs:14:14-19\r
-    • In the expression: b\r
-      In an equation for ‘v’: v = b\r
-      In the expression:\r
-        let\r
-          v :: a\r
-          v = b\r
-        in v\r
-    • Relevant bindings include\r
-        v :: a1 (bound at tc141.hs:15:14)\r
-        b :: t (bound at tc141.hs:13:5)\r
-        g :: t1 -> t -> forall a. a (bound at tc141.hs:13:1)\r
+
+tc141.hs:11:12: error:
+    • You cannot bind scoped type variable ‘a’
+        in a pattern binding signature
+    • In the pattern: p :: a
+      In the pattern: (p :: a, q :: a)
+      In a pattern binding: (p :: a, q :: a) = x
+
+tc141.hs:11:31: error:
+    • Couldn't match expected type ‘a2’ with actual type ‘a1’
+        because type variable ‘a2’ would escape its scope
+      This (rigid, skolem) type variable is bound by
+        an expression type signature:
+          a2
+        at tc141.hs:11:34
+    • In the expression: q :: a
+      In the expression: (q :: a, p)
+      In the expression: let (p :: a, q :: a) = x in (q :: a, p)
+    • Relevant bindings include
+        p :: a1 (bound at tc141.hs:11:12)
+        q :: a1 (bound at tc141.hs:11:17)
+        x :: (a1, a1) (bound at tc141.hs:11:3)
+        f :: (a1, a1) -> (a, a1) (bound at tc141.hs:11:1)
+
+tc141.hs:13:13: error:
+    • You cannot bind scoped type variable ‘a’
+        in a pattern binding signature
+    • In the pattern: y :: a
+      In a pattern binding: y :: a = a
+      In the expression:
+        let y :: a = a in
+        let
+          v :: a
+          v = b
+        in v
+
+tc141.hs:15:18: error:
+    • Couldn't match expected type ‘a1’ with actual type ‘t’
+        because type variable ‘a1’ would escape its scope
+      This (rigid, skolem) type variable is bound by
+        the type signature for:
+          v :: a1
+        at tc141.hs:14:14-19
+    • In the expression: b
+      In an equation for ‘v’: v = b
+      In the expression:
+        let
+          v :: a
+          v = b
+        in v
+    • Relevant bindings include
+        v :: a1 (bound at tc141.hs:15:14)
+        b :: t (bound at tc141.hs:13:5)
+        g :: t1 -> t -> forall a. a (bound at tc141.hs:13:1)
index f30ceec..651aad6 100644 (file)
@@ -1,6 +1,6 @@
 
 FailDueToGivenOverlapping.hs:27:9: error:
-    • Overlapping instances for E [t0] arising from a use of ‘eop’
+    • Overlapping instances for E [a0] arising from a use of ‘eop’
       Matching givens (or their superclasses):
         E [Int]
           bound by the type signature for:
@@ -8,6 +8,6 @@ FailDueToGivenOverlapping.hs:27:9: error:
           at FailDueToGivenOverlapping.hs:26:1-26
       Matching instances:
         instance E [a] -- Defined at FailDueToGivenOverlapping.hs:21:10
-      (The choice depends on the instantiation of ‘t0’)
+      (The choice depends on the instantiation of ‘a0’)
     • In the expression: eop [undefined]
       In an equation for ‘bar’: bar _ = eop [undefined]
index b6a16d3..782d6e3 100644 (file)
@@ -1,6 +1,6 @@
 
 T10351.hs:6:1: error:
-    • Non type-variable argument in the constraint: C [t]
+    • Non type-variable argument in the constraint: C [a]
       (Use FlexibleContexts to permit this)
     • When checking the inferred type
-        f :: forall t. C [t] => t -> ()
+        f :: forall a. C [a] => a -> ()
index 6c649e4..6837540 100644 (file)
@@ -1,6 +1,6 @@
 
 T11355.hs:5:7: error:
-    • Illegal polymorphic type: forall (a :: TYPE t1). a
+    • Illegal polymorphic type: forall (a :: TYPE t0). a
       GHC doesn't yet support impredicative polymorphism
     • In the expression:
         const @_ @((forall a. a) -> forall a. a) () (id @(forall a. a))
index 08de488..dc3ee90 100644 (file)
@@ -1,9 +1,9 @@
 
 T5858.hs:11:7: error:
-    • Ambiguous type variables ‘t0’, ‘t1’ arising from a use of ‘infer’
+    • Ambiguous type variables ‘a0’, ‘a1’ arising from a use of ‘infer’
       prevents the constraint ‘(InferOverloaded
-                                  ([t0], [t1]))’ from being solved.
-      Probable fix: use a type annotation to specify what ‘t0’, ‘t1’ should be.
+                                  ([a0], [a1]))’ from being solved.
+      Probable fix: use a type annotation to specify what ‘a0’, ‘a1’ should be.
       These potential instance exist:
         instance t1 ~ String => InferOverloaded (t1, t1)
           -- Defined at T5858.hs:8:10
index 3bd6b40..758acff 100644 (file)
@@ -69,7 +69,7 @@ T6018fail.hs:59:10: error:
 
 T6018fail.hs:62:15: error:
     Type family equation violates injectivity annotation.
-    Kind variable ‘k’ cannot be inferred from the right-hand side.
+    Kind variable ‘k1’ cannot be inferred from the right-hand side.
     Use -fprint-explicit-kinds to see the kind arguments
     In the type family equation:
       PolyKindVars '[] = '[] -- Defined at T6018fail.hs:62:15
index 53e6798..4200268 100644 (file)
@@ -1,14 +1,14 @@
 
 T8142.hs:6:18: error:
     • Couldn't match type ‘Nu g0’ with ‘Nu g’
-      Expected type: Nu ((,) t) -> Nu g
-        Actual type: Nu ((,) t0) -> Nu g0
+      Expected type: Nu ((,) a) -> Nu g
+        Actual type: Nu ((,) a0) -> Nu g0
       NB: ‘Nu’ is a type function, and may not be injective
       The type variable ‘g0’ is ambiguous
     • In the ambiguity check for the inferred type for ‘h’
       To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
       When checking the inferred type
-        h :: forall (g :: * -> *) t. Nu ((,) t) -> Nu g
+        h :: forall (g :: * -> *) a. Nu ((,) a) -> Nu g
       In an equation for ‘tracer’:
           tracer
             = h
@@ -16,11 +16,11 @@ T8142.hs:6:18: error:
                 h = (\ (_, b) -> ((outI . fmap h) b)) . out
 
 T8142.hs:6:57: error:
-    • Couldn't match type ‘Nu ((,) t)’ with ‘g (Nu ((,) t))’
-      Expected type: Nu ((,) t) -> (t, g (Nu ((,) t)))
-        Actual type: Nu ((,) t) -> (t, Nu ((,) t))
+    • Couldn't match type ‘Nu ((,) a)’ with ‘g (Nu ((,) a))’
+      Expected type: Nu ((,) a) -> (a, g (Nu ((,) a)))
+        Actual type: Nu ((,) a) -> (a, Nu ((,) a))
     • In the second argument of ‘(.)’, namely ‘out’
       In the expression: (\ (_, b) -> ((outI . fmap h) b)) . out
       In an equation for ‘h’: h = (\ (_, b) -> ((outI . fmap h) b)) . out
     • Relevant bindings include
-        h :: Nu ((,) t) -> Nu g (bound at T8142.hs:6:18)
+        h :: Nu ((,) a) -> Nu g (bound at T8142.hs:6:18)
index 996da6e..ce1b09d 100644 (file)
@@ -1,15 +1,14 @@
-\r
-T9109.hs:8:13: error:\r
-    • Couldn't match expected type ‘t’ with actual type ‘Bool’\r
-        ‘t’ is untouchable\r
-          inside the constraints: t1 ~ Bool\r
-          bound by a pattern with constructor: GBool :: G Bool,\r
-                   in an equation for ‘foo’\r
-          at T9109.hs:8:5-9\r
-      ‘t’ is a rigid type variable bound by\r
-        the inferred type of foo :: G t1 -> t at T9109.hs:8:1-16\r
-      Possible fix: add a type signature for ‘foo’\r
-    • In the expression: True\r
-      In an equation for ‘foo’: foo GBool = True\r
-    • Relevant bindings include\r
-        foo :: G t1 -> t (bound at T9109.hs:8:1)\r
+
+T9109.hs:8:13: error:
+    • Couldn't match expected type ‘t’ with actual type ‘Bool’
+        ‘t’ is untouchable
+          inside the constraints: a ~ Bool
+          bound by a pattern with constructor: GBool :: G Bool,
+                   in an equation for ‘foo’
+          at T9109.hs:8:5-9
+      ‘t’ is a rigid type variable bound by
+        the inferred type of foo :: G a -> t at T9109.hs:8:1-16
+      Possible fix: add a type signature for ‘foo’
+    • In the expression: True
+      In an equation for ‘foo’: foo GBool = True
+    • Relevant bindings include foo :: G a -> t (bound at T9109.hs:8:1)
index 03671b0..ff90a73 100644 (file)
@@ -1,6 +1,6 @@
 
 VtaFail.hs:7:16: error:
-    • Cannot apply expression of type ‘t0 -> t1 -> (t0, t1)’
+    • Cannot apply expression of type ‘a0 -> b0 -> (a0, b0)’
       to a visible type argument ‘Int’
     • In the expression: pairup_nosig @Int @Bool 5 True
       In an equation for ‘answer_nosig’:
index 6160446..56c28d9 100644 (file)
@@ -1,7 +1,7 @@
 
 tcfail001.hs:9:2: error:
     • Couldn't match expected type ‘[a]’
-                  with actual type ‘[t1] -> [t0]’
+                  with actual type ‘[a0] -> [a1]’
     • The equation(s) for ‘op’ have one argument,
       but its type ‘[a]’ has none
       In the instance declaration for ‘A [a]’
index c22a05e..11e5290 100644 (file)
@@ -1,6 +1,6 @@
 
 tcfail010.hs:3:16: error:
-    • No instance for (Num [t0]) arising from a use of ‘+’
+    • No instance for (Num [a0]) arising from a use of ‘+’
     • In the expression: z + 2
       In the expression: \ (y : z) -> z + 2
       In an equation for ‘q’: q = \ (y : z) -> z + 2
index 572c7a6..ea5a2a7 100644 (file)
@@ -1,5 +1,5 @@
 
-tcfail012.hs:3:8:
-    Couldn't match expected type ‘Bool’ with actual type ‘[t0]’
-    In the expression: []
-    In a pattern binding: True = []
+tcfail012.hs:3:8: error:
+    • Couldn't match expected type ‘Bool’ with actual type ‘[a0]’
+    • In the expression: []
+      In a pattern binding: True = []
index ff77022..f3e815b 100644 (file)
@@ -1,7 +1,7 @@
 
 tcfail013.hs:4:3: error:
-    • Couldn't match expected type ‘[t1]’ with actual type ‘Bool’
+    • Couldn't match expected type ‘[a]’ with actual type ‘Bool’
     • In the pattern: True
       In an equation for ‘f’: f True = 2
     • Relevant bindings include
-        f :: [t1] -> t (bound at tcfail013.hs:3:1)
+        f :: [a] -> t (bound at tcfail013.hs:3:1)
index 949cb65..3430c2d 100644 (file)
@@ -1,7 +1,7 @@
 
 tcfail016.hs:8:1: error:
-    • Couldn't match type ‘(t, Expr t)’ with ‘Expr t
-      Expected type: AnnExpr t -> [[Char]]
-        Actual type: Expr t -> [[Char]]
+    • Couldn't match type ‘(a, Expr a)’ with ‘Expr a
+      Expected type: AnnExpr a -> [[Char]]
+        Actual type: Expr a -> [[Char]]
     • Relevant bindings include
-&nbs