Commit 5fdb854c authored by eir@cis.upenn.edu's avatar eir@cis.upenn.edu
Browse files

s/Invisible/Inferred/g s/Visible/Required/g

This renames VisibilityFlag from

> data VisibilityFlag = Visible | Specified | Invisible

to

> data ArgFlag = Required | Specified | Inferred

The old name was quite confusing, because both Specified
and Invisible were invisible! The new names are hopefully clearer.
parent a33b498d
...@@ -418,9 +418,9 @@ data DataCon ...@@ -418,9 +418,9 @@ data DataCon
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
For the TyVarBinders in a DataCon and PatSyn: For the TyVarBinders in a DataCon and PatSyn:
* Each Visibilty flag is Invisible or Specified. * Each argument flag is Inferred or Specified.
None are Visible. (A DataCon is a term-level function; see None are Required. (A DataCon is a term-level function; see
Note [No Visible TyBinder in terms] in TyCoRep.) Note [No Required TyBinder in terms] in TyCoRep.)
Why do we need the TyVarBinders, rather than just the TyVars? So that Why do we need the TyVarBinders, rather than just the TyVars? So that
we can construct the right type for the DataCon with its foralls we can construct the right type for the DataCon with its foralls
...@@ -741,7 +741,7 @@ mkDataCon :: Name ...@@ -741,7 +741,7 @@ mkDataCon :: Name
-- if it is a record, otherwise empty -- if it is a record, otherwise empty
-> [TyVarBinder] -- ^ Universals. See Note [TyVarBinders in DataCons] -> [TyVarBinder] -- ^ Universals. See Note [TyVarBinders in DataCons]
-> [TyVarBinder] -- ^ Existentials. -> [TyVarBinder] -- ^ Existentials.
-- (These last two must be Named and Invisible/Specified) -- (These last two must be Named and Inferred/Specified)
-> [EqSpec] -- ^ GADT equalities -> [EqSpec] -- ^ GADT equalities
-> ThetaType -- ^ Theta-type occuring before the arguments proper -> ThetaType -- ^ Theta-type occuring before the arguments proper
-> [Type] -- ^ Original argument types -> [Type] -- ^ Original argument types
......
...@@ -57,9 +57,9 @@ module Var ( ...@@ -57,9 +57,9 @@ module Var (
mustHaveLocalBinding, mustHaveLocalBinding,
-- * TyVar's -- * TyVar's
TyVarBndr(..), VisibilityFlag(..), TyVarBinder, TyVarBndr(..), ArgFlag(..), TyVarBinder,
binderVar, binderVars, binderVisibility, binderKind, binderVar, binderVars, binderArgFlag, binderKind,
isVisible, isInvisible, sameVis, isVisibleArgFlag, isInvisibleArgFlag, sameVis,
-- ** Constructing TyVar's -- ** Constructing TyVar's
mkTyVar, mkTcTyVar, mkTyVar, mkTcTyVar,
...@@ -317,34 +317,35 @@ updateVarTypeM f id = do { ty' <- f (varType id) ...@@ -317,34 +317,35 @@ updateVarTypeM f id = do { ty' <- f (varType id)
{- ********************************************************************* {- *********************************************************************
* * * *
* VisibilityFlag * ArgFlag
* * * *
********************************************************************* -} ********************************************************************* -}
-- | Is something required to appear in source Haskell ('Visible'), -- | Is something required to appear in source Haskell ('Required'),
-- permitted by request ('Specified') (visible type application), or -- permitted by request ('Specified') (visible type application), or
-- prohibited entirely from appearing in source Haskell ('Invisible')? -- prohibited entirely from appearing in source Haskell ('Inferred')?
-- See Note [TyBinders and VisibilityFlags] in TyCoRep -- See Note [TyBinders and ArgFlags] in TyCoRep
data VisibilityFlag = Visible | Specified | Invisible data ArgFlag = Required | Specified | Inferred
deriving (Eq, Data) deriving (Eq, Data)
isVisible :: VisibilityFlag -> Bool -- | Does this 'ArgFlag' classify an argument that is written in Haskell?
isVisible Visible = True isVisibleArgFlag :: ArgFlag -> Bool
isVisible _ = False isVisibleArgFlag Required = True
isVisibleArgFlag _ = False
isInvisible :: VisibilityFlag -> Bool
isInvisible v = not (isVisible v) -- | Does this 'ArgFlag' classify an argument that is not written in Haskell?
isInvisibleArgFlag :: ArgFlag -> Bool
-- | Do these denote the same level of visibility? Except that isInvisibleArgFlag = not . isVisibleArgFlag
-- 'Specified' and 'Invisible' are considered the same. Used
-- for printing. -- | Do these denote the same level of visibility? 'Required'
sameVis :: VisibilityFlag -> VisibilityFlag -> Bool -- arguments are visible, others are not. So this function
sameVis Visible Visible = True -- equates 'Specified' and 'Inferred'. Used for printing.
sameVis Visible _ = False sameVis :: ArgFlag -> ArgFlag -> Bool
sameVis _ Visible = False sameVis Required Required = True
sameVis Required _ = False
sameVis _ Required = False
sameVis _ _ = True sameVis _ _ = True
{- ********************************************************************* {- *********************************************************************
* * * *
* TyVarBndr, TyVarBinder * TyVarBndr, TyVarBinder
...@@ -353,25 +354,25 @@ sameVis _ _ = True ...@@ -353,25 +354,25 @@ sameVis _ _ = True
-- TyVarBndr is polymorphic in both tyvar and visiblity fields: -- TyVarBndr is polymorphic in both tyvar and visiblity fields:
-- * tyvar can be TyVar or IfaceTv -- * tyvar can be TyVar or IfaceTv
-- * vis can be VisibilityFlag or TyConBndrVis -- * argf can be ArgFlag or TyConBndrVis
data TyVarBndr tyvar vis = TvBndr tyvar vis data TyVarBndr tyvar argf = TvBndr tyvar argf
deriving( Data ) deriving( Data )
-- | A `TyVarBinder` is the binder of a ForAllTy -- | A `TyVarBinder` is the binder of a ForAllTy
-- It's convenient to define this synonym here rather its natural -- It's convenient to define this synonym here rather its natural
-- home in TyCoRep, because it's used in DataCon.hs-boot -- home in TyCoRep, because it's used in DataCon.hs-boot
type TyVarBinder = TyVarBndr TyVar VisibilityFlag type TyVarBinder = TyVarBndr TyVar ArgFlag
binderVar :: TyVarBndr tv vis -> tv binderVar :: TyVarBndr tv argf -> tv
binderVar (TvBndr v _) = v binderVar (TvBndr v _) = v
binderVars :: [TyVarBndr tv vis] -> [tv] binderVars :: [TyVarBndr tv argf] -> [tv]
binderVars tvbs = map binderVar tvbs binderVars tvbs = map binderVar tvbs
binderVisibility :: TyVarBndr tv vis -> vis binderArgFlag :: TyVarBndr tv argf -> argf
binderVisibility (TvBndr _ vis) = vis binderArgFlag (TvBndr _ argf) = argf
binderKind :: TyVarBndr TyVar vis -> Kind binderKind :: TyVarBndr TyVar argf -> Kind
binderKind (TvBndr tv _) = tyVarKind tv binderKind (TvBndr tv _) = tyVarKind tv
{- {-
...@@ -429,15 +430,15 @@ setTcTyVarDetails :: TyVar -> TcTyVarDetails -> TyVar ...@@ -429,15 +430,15 @@ setTcTyVarDetails :: TyVar -> TcTyVarDetails -> TyVar
setTcTyVarDetails tv details = tv { tc_tv_details = details } setTcTyVarDetails tv details = tv { tc_tv_details = details }
------------------------------------- -------------------------------------
instance Outputable tv => Outputable (TyVarBndr tv VisibilityFlag) where instance Outputable tv => Outputable (TyVarBndr tv ArgFlag) where
ppr (TvBndr v Visible) = ppr v ppr (TvBndr v Required) = ppr v
ppr (TvBndr v Specified) = char '@' <> ppr v ppr (TvBndr v Specified) = char '@' <> ppr v
ppr (TvBndr v Invisible) = braces (ppr v) ppr (TvBndr v Inferred) = braces (ppr v)
instance Outputable VisibilityFlag where instance Outputable ArgFlag where
ppr Visible = text "[vis]" ppr Required = text "[req]"
ppr Specified = text "[spec]" ppr Specified = text "[spec]"
ppr Invisible = text "[invis]" ppr Inferred = text "[infrd]"
instance (Binary tv, Binary vis) => Binary (TyVarBndr tv vis) where instance (Binary tv, Binary vis) => Binary (TyVarBndr tv vis) where
put_ bh (TvBndr tv vis) = do { put_ bh tv; put_ bh vis } put_ bh (TvBndr tv vis) = do { put_ bh tv; put_ bh vis }
...@@ -445,17 +446,17 @@ instance (Binary tv, Binary vis) => Binary (TyVarBndr tv vis) where ...@@ -445,17 +446,17 @@ instance (Binary tv, Binary vis) => Binary (TyVarBndr tv vis) where
get bh = do { tv <- get bh; vis <- get bh; return (TvBndr tv vis) } get bh = do { tv <- get bh; vis <- get bh; return (TvBndr tv vis) }
instance Binary VisibilityFlag where instance Binary ArgFlag where
put_ bh Visible = putByte bh 0 put_ bh Required = putByte bh 0
put_ bh Specified = putByte bh 1 put_ bh Specified = putByte bh 1
put_ bh Invisible = putByte bh 2 put_ bh Inferred = putByte bh 2
get bh = do get bh = do
h <- getByte bh h <- getByte bh
case h of case h of
0 -> return Visible 0 -> return Required
1 -> return Specified 1 -> return Specified
_ -> return Invisible _ -> return Inferred
{- {-
%************************************************************************ %************************************************************************
......
...@@ -179,7 +179,7 @@ mkDataConUnivTyVarBinders tc_bndrs ...@@ -179,7 +179,7 @@ mkDataConUnivTyVarBinders tc_bndrs
where where
vis = case tc_vis of vis = case tc_vis of
AnonTCB -> Specified AnonTCB -> Specified
NamedTCB Visible -> Specified NamedTCB Required -> Specified
NamedTCB vis -> vis NamedTCB vis -> vis
{- Note [Building the TyBinders for a DataCon] {- Note [Building the TyBinders for a DataCon]
...@@ -202,7 +202,7 @@ of the DataCon. Here is an example: ...@@ -202,7 +202,7 @@ of the DataCon. Here is an example:
The TyCon has The TyCon has
tyConTyVars = [ k:*, a:k->*, b:k] tyConTyVars = [ k:*, a:k->*, b:k]
tyConTyBinders = [ Named (TvBndr (k :: *) Invisible), Anon (k->*), Anon k ] tyConTyBinders = [ Named (TvBndr (k :: *) Inferred), Anon (k->*), Anon k ]
The TyBinders for App line up with App's kind, given above. The TyBinders for App line up with App's kind, given above.
...@@ -211,7 +211,7 @@ But the DataCon MkApp has the type ...@@ -211,7 +211,7 @@ But the DataCon MkApp has the type
That is, its TyBinders should be That is, its TyBinders should be
dataConUnivTyVarBinders = [ TvBndr (k:*) Invisible dataConUnivTyVarBinders = [ TvBndr (k:*) Inferred
, TvBndr (a:k->*) Specified , TvBndr (a:k->*) Specified
, TvBndr (b:k) Specified ] , TvBndr (b:k) Specified ]
...@@ -219,12 +219,12 @@ So we want to take the TyCon's TyBinders and the TyCon's TyVars and ...@@ -219,12 +219,12 @@ So we want to take the TyCon's TyBinders and the TyCon's TyVars and
merge them, pulling merge them, pulling
- variable names from the TyVars - variable names from the TyVars
- visibilities from the TyBinders - visibilities from the TyBinders
- but changing Anon/Visible to Specified - but changing Anon/Required to Specified
The last part about Visible->Specified comes from this: The last part about Required->Specified comes from this:
data T k (a:k) b = MkT (a b) data T k (a:k) b = MkT (a b)
Here k is Visible in T's kind, but we don't have Visible binders in Here k is Required in T's kind, but we don't have Required binders in
the TyBinders for a term (see Note [No Visible TyBinder in terms] the TyBinders for a term (see Note [No Required TyBinder in terms]
in TyCoRep), so we change it to Specified when making MkT's TyBinders in TyCoRep), so we change it to Specified when making MkT's TyBinders
This merging operation is done by mkDataConUnivTyBinders. In contrast, This merging operation is done by mkDataConUnivTyBinders. In contrast,
......
...@@ -18,7 +18,7 @@ module IfaceType ( ...@@ -18,7 +18,7 @@ module IfaceType (
IfaceTyLit(..), IfaceTcArgs(..), IfaceTyLit(..), IfaceTcArgs(..),
IfaceContext, IfaceBndr(..), IfaceOneShot(..), IfaceLamBndr, IfaceContext, IfaceBndr(..), IfaceOneShot(..), IfaceLamBndr,
IfaceTvBndr, IfaceIdBndr, IfaceTyConBinder, IfaceTvBndr, IfaceIdBndr, IfaceTyConBinder,
IfaceForAllBndr, VisibilityFlag(..), IfaceForAllBndr, ArgFlag(..),
ifConstraintKind, ifTyConBinderTyVar, ifTyConBinderName, ifConstraintKind, ifTyConBinderTyVar, ifTyConBinderName,
...@@ -146,7 +146,7 @@ data IfaceTyLit ...@@ -146,7 +146,7 @@ data IfaceTyLit
deriving (Eq) deriving (Eq)
type IfaceTyConBinder = TyVarBndr IfaceTvBndr TyConBndrVis type IfaceTyConBinder = TyVarBndr IfaceTvBndr TyConBndrVis
type IfaceForAllBndr = TyVarBndr IfaceTvBndr VisibilityFlag type IfaceForAllBndr = TyVarBndr IfaceTvBndr ArgFlag
-- See Note [Suppressing invisible arguments] -- See Note [Suppressing invisible arguments]
-- We use a new list type (rather than [(IfaceType,Bool)], because -- We use a new list type (rather than [(IfaceType,Bool)], because
...@@ -524,7 +524,7 @@ toIfaceTcArgs tc ty_args ...@@ -524,7 +524,7 @@ toIfaceTcArgs tc ty_args
| Just ty' <- coreView ty | Just ty' <- coreView ty
= go env ty' ts = go env ty' ts
go env (ForAllTy (TvBndr tv vis) res) (t:ts) go env (ForAllTy (TvBndr tv vis) res) (t:ts)
| isVisible vis = ITC_Vis t' ts' | isVisibleArgFlag vis = ITC_Vis t' ts'
| otherwise = ITC_Invis t' ts' | otherwise = ITC_Invis t' ts'
where where
t' = toIfaceType t t' = toIfaceType t
...@@ -716,7 +716,7 @@ pprIfaceForAll bndrs@(TvBndr _ vis : _) ...@@ -716,7 +716,7 @@ pprIfaceForAll bndrs@(TvBndr _ vis : _)
(bndrs', doc) = ppr_itv_bndrs bndrs vis (bndrs', doc) = ppr_itv_bndrs bndrs vis
add_separator stuff = case vis of add_separator stuff = case vis of
Visible -> stuff <+> arrow Required -> stuff <+> arrow
_inv -> stuff <> dot _inv -> stuff <> dot
...@@ -724,7 +724,7 @@ pprIfaceForAll bndrs@(TvBndr _ vis : _) ...@@ -724,7 +724,7 @@ pprIfaceForAll bndrs@(TvBndr _ vis : _)
-- Returns both the list of not-yet-rendered binders and the doc. -- Returns both the list of not-yet-rendered binders and the doc.
-- No anonymous binders here! -- No anonymous binders here!
ppr_itv_bndrs :: [IfaceForAllBndr] ppr_itv_bndrs :: [IfaceForAllBndr]
-> VisibilityFlag -- ^ visibility of the first binder in the list -> ArgFlag -- ^ visibility of the first binder in the list
-> ([IfaceForAllBndr], SDoc) -> ([IfaceForAllBndr], SDoc)
ppr_itv_bndrs all_bndrs@(bndr@(TvBndr _ 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 | vis `sameVis` vis1 = let (bndrs', doc) = ppr_itv_bndrs bndrs vis1 in
...@@ -740,7 +740,7 @@ pprIfaceForAllCoBndrs :: [(IfLclName, IfaceCoercion)] -> SDoc ...@@ -740,7 +740,7 @@ pprIfaceForAllCoBndrs :: [(IfLclName, IfaceCoercion)] -> SDoc
pprIfaceForAllCoBndrs bndrs = hsep $ map pprIfaceForAllCoBndr bndrs pprIfaceForAllCoBndrs bndrs = hsep $ map pprIfaceForAllCoBndr bndrs
pprIfaceForAllBndr :: IfaceForAllBndr -> SDoc pprIfaceForAllBndr :: IfaceForAllBndr -> SDoc
pprIfaceForAllBndr (TvBndr tv Invisible) = sdocWithDynFlags $ \dflags -> pprIfaceForAllBndr (TvBndr tv Inferred) = sdocWithDynFlags $ \dflags ->
if gopt Opt_PrintExplicitForalls dflags if gopt Opt_PrintExplicitForalls dflags
then braces $ pprIfaceTvBndr tv then braces $ pprIfaceTvBndr tv
else pprIfaceTvBndr tv else pprIfaceTvBndr tv
......
...@@ -521,7 +521,7 @@ tc_ax_branch prev_branches ...@@ -521,7 +521,7 @@ tc_ax_branch prev_branches
, ifaxbLHS = lhs, ifaxbRHS = rhs , ifaxbLHS = lhs, ifaxbRHS = rhs
, ifaxbRoles = roles, ifaxbIncomps = incomps }) , ifaxbRoles = roles, ifaxbIncomps = incomps })
= bindIfaceTyConBinders_AT = bindIfaceTyConBinders_AT
(map (\b -> TvBndr b (NamedTCB Invisible)) tv_bndrs) $ \ tvs -> (map (\b -> TvBndr b (NamedTCB Inferred)) tv_bndrs) $ \ tvs ->
-- The _AT variant is needed here; see Note [CoAxBranch type variables] in CoAxiom -- The _AT variant is needed here; see Note [CoAxBranch type variables] in CoAxiom
bindIfaceIds cv_bndrs $ \ cvs -> do bindIfaceIds cv_bndrs $ \ cvs -> do
{ tc_lhs <- tcIfaceTcArgs lhs { tc_lhs <- tcIfaceTcArgs lhs
...@@ -1448,7 +1448,7 @@ bindIfaceForAllBndrs (bndr:bndrs) thing_inside ...@@ -1448,7 +1448,7 @@ bindIfaceForAllBndrs (bndr:bndrs) thing_inside
bindIfaceForAllBndrs bndrs $ \bndrs' -> bindIfaceForAllBndrs bndrs $ \bndrs' ->
thing_inside (mkTyVarBinder vis tv : bndrs') thing_inside (mkTyVarBinder vis tv : bndrs')
bindIfaceForAllBndr :: IfaceForAllBndr -> (TyVar -> VisibilityFlag -> IfL a) -> IfL a bindIfaceForAllBndr :: IfaceForAllBndr -> (TyVar -> ArgFlag -> IfL a) -> IfL a
bindIfaceForAllBndr (TvBndr tv vis) thing_inside bindIfaceForAllBndr (TvBndr tv vis) thing_inside
= bindIfaceTyVar tv $ \tv' -> thing_inside tv' vis = bindIfaceTyVar tv $ \tv' -> thing_inside tv' vis
......
...@@ -556,7 +556,7 @@ unboxedTupleKind = tYPE unboxedTupleRepDataConTy ...@@ -556,7 +556,7 @@ unboxedTupleKind = tYPE unboxedTupleRepDataConTy
mkFunKind :: Kind -> Kind -> Kind mkFunKind :: Kind -> Kind -> Kind
mkFunKind = mkFunTy mkFunKind = mkFunTy
mkForAllKind :: TyVar -> VisibilityFlag -> Kind -> Kind mkForAllKind :: TyVar -> ArgFlag -> Kind -> Kind
mkForAllKind = mkForAllTy mkForAllKind = mkForAllTy
{- {-
......
module TysWiredIn where module TysWiredIn where
import Var( TyVar, VisibilityFlag ) import Var( TyVar, ArgFlag )
import {-# SOURCE #-} TyCon ( TyCon ) import {-# SOURCE #-} TyCon ( TyCon )
import {-# SOURCE #-} TyCoRep (Type, Kind) import {-# SOURCE #-} TyCoRep (Type, Kind)
mkFunKind :: Kind -> Kind -> Kind mkFunKind :: Kind -> Kind -> Kind
mkForAllKind :: TyVar -> VisibilityFlag -> Kind -> Kind mkForAllKind :: TyVar -> ArgFlag -> Kind -> Kind
listTyCon :: TyCon listTyCon :: TyCon
typeNatKind, typeSymbolKind :: Type typeNatKind, typeSymbolKind :: Type
......
...@@ -163,7 +163,7 @@ topInstantiate :: CtOrigin -> TcSigmaType -> TcM (HsWrapper, TcRhoType) ...@@ -163,7 +163,7 @@ topInstantiate :: CtOrigin -> TcSigmaType -> TcM (HsWrapper, TcRhoType)
-- then wrap e :: rho (that is, wrap :: ty "->" rho) -- then wrap e :: rho (that is, wrap :: ty "->" rho)
topInstantiate = top_instantiate True topInstantiate = top_instantiate True
-- | Instantiate all outer 'Invisible' binders -- | Instantiate all outer 'Inferred' binders
-- and any context. Never looks through arrows or specified type variables. -- and any context. Never looks through arrows or specified type variables.
-- Used for visible type application. -- Used for visible type application.
topInstantiateInferred :: CtOrigin -> TcSigmaType topInstantiateInferred :: CtOrigin -> TcSigmaType
...@@ -174,7 +174,7 @@ topInstantiateInferred :: CtOrigin -> TcSigmaType ...@@ -174,7 +174,7 @@ topInstantiateInferred :: CtOrigin -> TcSigmaType
topInstantiateInferred = top_instantiate False topInstantiateInferred = top_instantiate False
top_instantiate :: Bool -- True <=> instantiate *all* variables top_instantiate :: Bool -- True <=> instantiate *all* variables
-- False <=> instantiate only the invisible ones -- False <=> instantiate only the inferred ones
-> CtOrigin -> TcSigmaType -> TcM (HsWrapper, TcRhoType) -> CtOrigin -> TcSigmaType -> TcM (HsWrapper, TcRhoType)
top_instantiate inst_all orig ty top_instantiate inst_all orig ty
| not (null binders && null theta) | not (null binders && null theta)
...@@ -218,7 +218,7 @@ top_instantiate inst_all orig ty ...@@ -218,7 +218,7 @@ top_instantiate inst_all orig ty
should_inst bndr should_inst bndr
| inst_all = True | inst_all = True
| otherwise = binderVisibility bndr == Invisible | otherwise = binderArgFlag bndr == Inferred
deeplyInstantiate :: CtOrigin -> TcSigmaType -> TcM (HsWrapper, TcRhoType) deeplyInstantiate :: CtOrigin -> TcSigmaType -> TcM (HsWrapper, TcRhoType)
-- Int -> forall a. a -> a ==> (\x:Int. [] x alpha) :: Int -> alpha -- Int -> forall a. a -> a ==> (\x:Int. [] x alpha) :: Int -> alpha
......
...@@ -770,9 +770,9 @@ mkExport prag_fn qtvs theta ...@@ -770,9 +770,9 @@ mkExport prag_fn qtvs theta
-- NB: we have already done checkValidType, including an ambiguity check, -- NB: we have already done checkValidType, including an ambiguity check,
-- on the type; either when we checked the sig or in mkInferredPolyId -- on the type; either when we checked the sig or in mkInferredPolyId
; let poly_ty = idType poly_id ; let poly_ty = idType poly_id
sel_poly_ty = mkInvSigmaTy qtvs theta mono_ty sel_poly_ty = mkInfSigmaTy qtvs theta mono_ty
-- This type is just going into tcSubType, -- This type is just going into tcSubType,
-- so Inv vs. Spec doesn't matter -- so Inferred vs. Specified doesn't matter
; wrap <- if sel_poly_ty `eqType` poly_ty -- NB: eqType ignores visibility ; wrap <- if sel_poly_ty `eqType` poly_ty -- NB: eqType ignores visibility
then return idHsWrapper -- Fast path; also avoids complaint when we infer then return idHsWrapper -- Fast path; also avoids complaint when we infer
...@@ -842,7 +842,7 @@ chooseInferredQuantifiers inferred_theta tau_tvs qtvs Nothing ...@@ -842,7 +842,7 @@ chooseInferredQuantifiers inferred_theta tau_tvs qtvs Nothing
do { let free_tvs = closeOverKinds (growThetaTyVars inferred_theta tau_tvs) do { let free_tvs = closeOverKinds (growThetaTyVars inferred_theta tau_tvs)
-- Include kind variables! Trac #7916 -- Include kind variables! Trac #7916
my_theta = pickCapturedPreds free_tvs inferred_theta my_theta = pickCapturedPreds free_tvs inferred_theta
binders = [ mkTyVarBinder Invisible tv binders = [ mkTyVarBinder Inferred tv
| tv <- qtvs | tv <- qtvs
, tv `elemVarSet` free_tvs ] , tv `elemVarSet` free_tvs ]
; return (binders, my_theta) } ; return (binders, my_theta) }
...@@ -891,7 +891,7 @@ chooseInferredQuantifiers inferred_theta tau_tvs qtvs ...@@ -891,7 +891,7 @@ chooseInferredQuantifiers inferred_theta tau_tvs qtvs
| tv <- qtvs | tv <- qtvs
, tv `elemVarSet` free_tvs , tv `elemVarSet` free_tvs
, let vis | tv `elemVarSet` spec_tv_set = Specified , let vis | tv `elemVarSet` spec_tv_set = Specified
| otherwise = Invisible ] | otherwise = Inferred ]
-- Pulling from qtvs maintains original order -- Pulling from qtvs maintains original order
mk_ctuple [pred] = return pred mk_ctuple [pred] = return pred
......
...@@ -622,8 +622,8 @@ can_eq_nc' _flat _rdr_env _envs ev eq_rel ...@@ -622,8 +622,8 @@ can_eq_nc' _flat _rdr_env _envs ev eq_rel
; if not (equalLength bndrs1 bndrs2) ; if not (equalLength bndrs1 bndrs2)
then do { traceTcS "Forall failure" $ then do { traceTcS "Forall failure" $
vcat [ ppr s1, ppr s2, ppr bndrs1, ppr bndrs2 vcat [ ppr s1, ppr s2, ppr bndrs1, ppr bndrs2
, ppr (map binderVisibility bndrs1) , ppr (map binderArgFlag bndrs1)
, ppr (map binderVisibility bndrs2) ] , ppr (map binderArgFlag bndrs2) ]
; canEqHardFailure ev s1 s2 } ; canEqHardFailure ev s1 s2 }
else else
do { traceTcS "Creating implication for polytype equality" $ ppr ev do { traceTcS "Creating implication for polytype equality" $ ppr ev
......
...@@ -1452,7 +1452,7 @@ mkEqInfoMsg ct ty1 ty2 ...@@ -1452,7 +1452,7 @@ mkEqInfoMsg ct ty1 ty2
_ -> (ty1, ty2) _ -> (ty1, ty2)
invis_msg | Just vis <- tcEqTypeVis act_ty exp_ty invis_msg | Just vis <- tcEqTypeVis act_ty exp_ty
, vis /= Visible , not vis
= ppSuggestExplicitKinds = ppSuggestExplicitKinds
| otherwise | otherwise
= empty = empty
......
...@@ -1191,7 +1191,7 @@ tcArgs fun orig_fun_ty fun_orig orig_args herald ...@@ -1191,7 +1191,7 @@ tcArgs fun orig_fun_ty fun_orig orig_args herald
; case tcSplitForAllTy_maybe upsilon_ty of ; case tcSplitForAllTy_maybe upsilon_ty of
Just (tvb, inner_ty) -> Just (tvb, inner_ty) ->
do { let tv = binderVar tvb do { let tv = binderVar tvb
vis = binderVisibility tvb vis = binderArgFlag tvb
kind = tyVarKind tv kind = tyVarKind tv
; MASSERT2( vis == Specified ; MASSERT2( vis == Specified
, (vcat [ ppr fun_ty, ppr upsilon_ty, ppr tvb , (vcat [ ppr fun_ty, ppr upsilon_ty, ppr tvb
...@@ -1484,7 +1484,7 @@ tcExprSig expr sig@(PartialSig { psig_name = name, sig_loc = loc }) ...@@ -1484,7 +1484,7 @@ tcExprSig expr sig@(PartialSig { psig_name = name, sig_loc = loc })
tau_tvs = tyCoVarsOfType tau tau_tvs = tyCoVarsOfType tau
; (binders, my_theta) <- chooseInferredQuantifiers inferred_theta ; (binders, my_theta) <- chooseInferredQuantifiers inferred_theta
tau_tvs qtvs (Just sig_inst) tau_tvs qtvs (Just sig_inst)
; let inferred_sigma = mkInvSigmaTy qtvs inferred_theta tau ; let inferred_sigma = mkInfSigmaTy qtvs inferred_theta tau
my_sigma = mkForAllTys binders (mkPhiTy my_theta tau) my_sigma = mkForAllTys binders (mkPhiTy my_theta tau)
; wrap <- if inferred_sigma `eqType` my_sigma -- NB: eqType ignores vis. ; wrap <- if inferred_sigma `eqType` my_sigma -- NB: eqType ignores vis.
then return idHsWrapper -- Fast path; also avoids complaint when we infer then return idHsWrapper -- Fast path; also avoids complaint when we infer
......
...@@ -1660,7 +1660,7 @@ functorLikeTraverse var (FT { ft_triv = caseTrivial, ft_var = caseVar ...@@ -1660,7 +1660,7 @@ functorLikeTraverse var (FT { ft_triv = caseTrivial, ft_var = caseVar
where where
(xrs,xcs) = unzip (map (go co) args) (xrs,xcs) = unzip (map (go co) args)
go co (ForAllTy (TvBndr v vis) x) go co (ForAllTy (TvBndr v vis) x)
| isVisible vis = panic "unexpected visible binder" | isVisibleArgFlag vis = panic "unexpected visible binder"
| v /= var && xc = (caseForAll v xr,True) | v /= var && xc = (caseForAll v xr,True)
where (xr,xc) = go co x where (xr,xc) = go co x
......
...@@ -752,7 +752,7 @@ tcInferArgs fun tc_binders mb_kind_info args ...@@ -752,7 +752,7 @@ tcInferArgs fun tc_binders mb_kind_info args
; (subst, leftover_binders, args', leftovers, n) ; (subst, leftover_binders, args', leftovers, n)
<- tc_infer_args typeLevelMode fun binders mb_kind_info args 1 <- tc_infer_args typeLevelMode fun binders mb_kind_info args 1
-- now, we need to instantiate any remaining invisible arguments -- now, we need to instantiate any remaining invisible arguments
; let (invis_bndrs, other_binders) = span isInvisibleBinder leftover_binders ; let (invis_bndrs, other_binders) = break isVisibleBinder leftover_binders
; (subst', invis_args) ; (subst', invis_args)