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

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
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
For the TyVarBinders in a DataCon and PatSyn:
* Each Visibilty flag is Invisible or Specified.
None are Visible. (A DataCon is a term-level function; see
Note [No Visible TyBinder in terms] in TyCoRep.)
* Each argument flag is Inferred or Specified.
None are Required. (A DataCon is a term-level function; see
Note [No Required TyBinder in terms] in TyCoRep.)
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
......@@ -741,7 +741,7 @@ mkDataCon :: Name
-- if it is a record, otherwise empty
-> [TyVarBinder] -- ^ Universals. See Note [TyVarBinders in DataCons]
-> [TyVarBinder] -- ^ Existentials.
-- (These last two must be Named and Invisible/Specified)
-- (These last two must be Named and Inferred/Specified)
-> [EqSpec] -- ^ GADT equalities
-> ThetaType -- ^ Theta-type occuring before the arguments proper
-> [Type] -- ^ Original argument types
......
......@@ -57,9 +57,9 @@ module Var (
mustHaveLocalBinding,
-- * TyVar's
TyVarBndr(..), VisibilityFlag(..), TyVarBinder,
binderVar, binderVars, binderVisibility, binderKind,
isVisible, isInvisible, sameVis,
TyVarBndr(..), ArgFlag(..), TyVarBinder,
binderVar, binderVars, binderArgFlag, binderKind,
isVisibleArgFlag, isInvisibleArgFlag, sameVis,
-- ** Constructing TyVar's
mkTyVar, mkTcTyVar,
......@@ -317,33 +317,34 @@ 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
-- prohibited entirely from appearing in source Haskell ('Invisible')?
-- See Note [TyBinders and VisibilityFlags] in TyCoRep
data VisibilityFlag = Visible | Specified | Invisible
-- prohibited entirely from appearing in source Haskell ('Inferred')?
-- See Note [TyBinders and ArgFlags] in TyCoRep
data ArgFlag = Required | Specified | Inferred
deriving (Eq, Data)
isVisible :: VisibilityFlag -> Bool
isVisible Visible = True
isVisible _ = False
-- | Does this 'ArgFlag' classify an argument that is written in Haskell?
isVisibleArgFlag :: ArgFlag -> Bool
isVisibleArgFlag Required = True
isVisibleArgFlag _ = 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
-- | Does this 'ArgFlag' classify an argument that is not written in Haskell?
isInvisibleArgFlag :: ArgFlag -> Bool
isInvisibleArgFlag = not . isVisibleArgFlag
-- | Do these denote the same level of visibility? 'Required'
-- arguments are visible, others are not. So this function
-- equates 'Specified' and 'Inferred'. Used for printing.
sameVis :: ArgFlag -> ArgFlag -> Bool
sameVis Required Required = True
sameVis Required _ = False
sameVis _ Required = False
sameVis _ _ = True
{- *********************************************************************
* *
......@@ -353,25 +354,25 @@ sameVis _ _ = True
-- 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
-- * argf can be ArgFlag or TyConBndrVis
data TyVarBndr tyvar argf = TvBndr tyvar argf
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
type TyVarBinder = TyVarBndr TyVar ArgFlag
binderVar :: TyVarBndr tv vis -> tv
binderVar :: TyVarBndr tv argf -> tv
binderVar (TvBndr v _) = v
binderVars :: [TyVarBndr tv vis] -> [tv]
binderVars :: [TyVarBndr tv argf] -> [tv]
binderVars tvbs = map binderVar tvbs
binderVisibility :: TyVarBndr tv vis -> vis
binderVisibility (TvBndr _ vis) = vis
binderArgFlag :: TyVarBndr tv argf -> argf
binderArgFlag (TvBndr _ argf) = argf
binderKind :: TyVarBndr TyVar vis -> Kind
binderKind :: TyVarBndr TyVar argf -> Kind
binderKind (TvBndr tv _) = tyVarKind tv
{-
......@@ -429,15 +430,15 @@ 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
instance Outputable tv => Outputable (TyVarBndr tv ArgFlag) where
ppr (TvBndr v Required) = 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
ppr Visible = text "[vis]"
instance Outputable ArgFlag where
ppr Required = text "[req]"
ppr Specified = text "[spec]"
ppr Invisible = text "[invis]"
ppr Inferred = text "[infrd]"
instance (Binary tv, Binary vis) => Binary (TyVarBndr tv vis) where
put_ bh (TvBndr tv vis) = do { put_ bh tv; put_ bh vis }
......@@ -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) }
instance Binary VisibilityFlag where
put_ bh Visible = putByte bh 0
instance Binary ArgFlag where
put_ bh Required = putByte bh 0
put_ bh Specified = putByte bh 1
put_ bh Invisible = putByte bh 2
put_ bh Inferred = putByte bh 2
get bh = do
h <- getByte bh
case h of
0 -> return Visible
0 -> return Required
1 -> return Specified
_ -> return Invisible
_ -> return Inferred
{-
%************************************************************************
......
......@@ -178,9 +178,9 @@ mkDataConUnivTyVarBinders tc_bndrs
mk_binder (TvBndr tv tc_vis) = mkTyVarBinder vis tv
where
vis = case tc_vis of
AnonTCB -> Specified
NamedTCB Visible -> Specified
NamedTCB vis -> vis
AnonTCB -> Specified
NamedTCB Required -> Specified
NamedTCB vis -> vis
{- Note [Building the TyBinders for a DataCon]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
......@@ -201,8 +201,8 @@ of the DataCon. Here is an example:
The TyCon has
tyConTyVars = [ k:*, a:k->*, b:k]
tyConTyBinders = [ Named (TvBndr (k :: *) Invisible), Anon (k->*), Anon k ]
tyConTyVars = [ k:*, a:k->*, b:k]
tyConTyBinders = [ Named (TvBndr (k :: *) Inferred), Anon (k->*), Anon k ]
The TyBinders for App line up with App's kind, given above.
......@@ -211,7 +211,7 @@ But the DataCon MkApp has the type
That is, its TyBinders should be
dataConUnivTyVarBinders = [ TvBndr (k:*) Invisible
dataConUnivTyVarBinders = [ TvBndr (k:*) Inferred
, TvBndr (a: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
merge them, pulling
- variable names from the TyVars
- 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)
Here k is Visible in T's kind, but we don't have Visible binders in
the TyBinders for a term (see Note [No Visible TyBinder in terms]
Here k is Required in T's kind, but we don't have Required binders in
the TyBinders for a term (see Note [No Required TyBinder in terms]
in TyCoRep), so we change it to Specified when making MkT's TyBinders
This merging operation is done by mkDataConUnivTyBinders. In contrast,
......
......@@ -18,7 +18,7 @@ module IfaceType (
IfaceTyLit(..), IfaceTcArgs(..),
IfaceContext, IfaceBndr(..), IfaceOneShot(..), IfaceLamBndr,
IfaceTvBndr, IfaceIdBndr, IfaceTyConBinder,
IfaceForAllBndr, VisibilityFlag(..),
IfaceForAllBndr, ArgFlag(..),
ifConstraintKind, ifTyConBinderTyVar, ifTyConBinderName,
......@@ -146,7 +146,7 @@ data IfaceTyLit
deriving (Eq)
type IfaceTyConBinder = TyVarBndr IfaceTvBndr TyConBndrVis
type IfaceForAllBndr = TyVarBndr IfaceTvBndr VisibilityFlag
type IfaceForAllBndr = TyVarBndr IfaceTvBndr ArgFlag
-- See Note [Suppressing invisible arguments]
-- We use a new list type (rather than [(IfaceType,Bool)], because
......@@ -524,8 +524,8 @@ toIfaceTcArgs tc ty_args
| Just ty' <- coreView ty
= go env ty' ts
go env (ForAllTy (TvBndr tv vis) res) (t:ts)
| isVisible vis = ITC_Vis t' ts'
| otherwise = ITC_Invis t' ts'
| isVisibleArgFlag vis = ITC_Vis t' ts'
| otherwise = ITC_Invis t' ts'
where
t' = toIfaceType t
ts' = go (extendTvSubst env tv t) res ts
......@@ -716,15 +716,15 @@ pprIfaceForAll bndrs@(TvBndr _ vis : _)
(bndrs', doc) = ppr_itv_bndrs bndrs vis
add_separator stuff = case vis of
Visible -> stuff <+> arrow
_inv -> stuff <> dot
Required -> stuff <+> arrow
_inv -> stuff <> dot
-- | Render the ... in @(forall ... .)@ or @(forall ... ->)@.
-- Returns both the list of not-yet-rendered binders and the doc.
-- No anonymous binders here!
ppr_itv_bndrs :: [IfaceForAllBndr]
-> VisibilityFlag -- ^ visibility of the first binder in the list
-> ArgFlag -- ^ visibility of the first binder in the list
-> ([IfaceForAllBndr], SDoc)
ppr_itv_bndrs all_bndrs@(bndr@(TvBndr _ vis) : bndrs) vis1
| vis `sameVis` vis1 = let (bndrs', doc) = ppr_itv_bndrs bndrs vis1 in
......@@ -740,11 +740,11 @@ pprIfaceForAllCoBndrs :: [(IfLclName, IfaceCoercion)] -> SDoc
pprIfaceForAllCoBndrs bndrs = hsep $ map pprIfaceForAllCoBndr bndrs
pprIfaceForAllBndr :: IfaceForAllBndr -> SDoc
pprIfaceForAllBndr (TvBndr tv Invisible) = sdocWithDynFlags $ \dflags ->
pprIfaceForAllBndr (TvBndr tv Inferred) = sdocWithDynFlags $ \dflags ->
if gopt Opt_PrintExplicitForalls dflags
then braces $ pprIfaceTvBndr tv
else pprIfaceTvBndr tv
pprIfaceForAllBndr (TvBndr tv _) = pprIfaceTvBndr tv
pprIfaceForAllBndr (TvBndr tv _) = pprIfaceTvBndr tv
pprIfaceForAllCoBndr :: (IfLclName, IfaceCoercion) -> SDoc
pprIfaceForAllCoBndr (tv, kind_co)
......
......@@ -521,7 +521,7 @@ tc_ax_branch prev_branches
, ifaxbLHS = lhs, ifaxbRHS = rhs
, ifaxbRoles = roles, ifaxbIncomps = incomps })
= 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
bindIfaceIds cv_bndrs $ \ cvs -> do
{ tc_lhs <- tcIfaceTcArgs lhs
......@@ -1448,7 +1448,7 @@ bindIfaceForAllBndrs (bndr:bndrs) thing_inside
bindIfaceForAllBndrs bndrs $ \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
= bindIfaceTyVar tv $ \tv' -> thing_inside tv' vis
......
......@@ -556,7 +556,7 @@ unboxedTupleKind = tYPE unboxedTupleRepDataConTy
mkFunKind :: Kind -> Kind -> Kind
mkFunKind = mkFunTy
mkForAllKind :: TyVar -> VisibilityFlag -> Kind -> Kind
mkForAllKind :: TyVar -> ArgFlag -> Kind -> Kind
mkForAllKind = mkForAllTy
{-
......
module TysWiredIn where
import Var( TyVar, VisibilityFlag )
import Var( TyVar, ArgFlag )
import {-# SOURCE #-} TyCon ( TyCon )
import {-# SOURCE #-} TyCoRep (Type, Kind)
mkFunKind :: Kind -> Kind -> Kind
mkForAllKind :: TyVar -> VisibilityFlag -> Kind -> Kind
mkForAllKind :: TyVar -> ArgFlag -> Kind -> Kind
listTyCon :: TyCon
typeNatKind, typeSymbolKind :: Type
......
......@@ -163,7 +163,7 @@ topInstantiate :: CtOrigin -> TcSigmaType -> TcM (HsWrapper, TcRhoType)
-- then wrap e :: rho (that is, wrap :: ty "->" rho)
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.
-- Used for visible type application.
topInstantiateInferred :: CtOrigin -> TcSigmaType
......@@ -174,7 +174,7 @@ topInstantiateInferred :: CtOrigin -> TcSigmaType
topInstantiateInferred = top_instantiate False
top_instantiate :: Bool -- True <=> instantiate *all* variables
-- False <=> instantiate only the invisible ones
-- False <=> instantiate only the inferred ones
-> CtOrigin -> TcSigmaType -> TcM (HsWrapper, TcRhoType)
top_instantiate inst_all orig ty
| not (null binders && null theta)
......@@ -218,7 +218,7 @@ top_instantiate inst_all orig ty
should_inst bndr
| inst_all = True
| otherwise = binderVisibility bndr == Invisible
| otherwise = binderArgFlag bndr == Inferred
deeplyInstantiate :: CtOrigin -> TcSigmaType -> TcM (HsWrapper, TcRhoType)
-- Int -> forall a. a -> a ==> (\x:Int. [] x alpha) :: Int -> alpha
......
......@@ -770,9 +770,9 @@ mkExport prag_fn qtvs theta
-- NB: we have already done checkValidType, including an ambiguity check,
-- on the type; either when we checked the sig or in mkInferredPolyId
; 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,
-- 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
then return idHsWrapper -- Fast path; also avoids complaint when we infer
......@@ -842,7 +842,7 @@ chooseInferredQuantifiers inferred_theta tau_tvs qtvs Nothing
do { let free_tvs = closeOverKinds (growThetaTyVars inferred_theta tau_tvs)
-- Include kind variables! Trac #7916
my_theta = pickCapturedPreds free_tvs inferred_theta
binders = [ mkTyVarBinder Invisible tv
binders = [ mkTyVarBinder Inferred tv
| tv <- qtvs
, tv `elemVarSet` free_tvs ]
; return (binders, my_theta) }
......@@ -891,7 +891,7 @@ chooseInferredQuantifiers inferred_theta tau_tvs qtvs
| tv <- qtvs
, tv `elemVarSet` free_tvs
, let vis | tv `elemVarSet` spec_tv_set = Specified
| otherwise = Invisible ]
| otherwise = Inferred ]
-- Pulling from qtvs maintains original order
mk_ctuple [pred] = return pred
......
......@@ -622,8 +622,8 @@ can_eq_nc' _flat _rdr_env _envs ev eq_rel
; if not (equalLength bndrs1 bndrs2)
then do { traceTcS "Forall failure" $
vcat [ ppr s1, ppr s2, ppr bndrs1, ppr bndrs2
, ppr (map binderVisibility bndrs1)
, ppr (map binderVisibility bndrs2) ]
, ppr (map binderArgFlag bndrs1)
, ppr (map binderArgFlag bndrs2) ]
; canEqHardFailure ev s1 s2 }
else
do { traceTcS "Creating implication for polytype equality" $ ppr ev
......
......@@ -1452,7 +1452,7 @@ mkEqInfoMsg ct ty1 ty2
_ -> (ty1, ty2)
invis_msg | Just vis <- tcEqTypeVis act_ty exp_ty
, vis /= Visible
, not vis
= ppSuggestExplicitKinds
| otherwise
= empty
......
......@@ -1191,7 +1191,7 @@ tcArgs fun orig_fun_ty fun_orig orig_args herald
; case tcSplitForAllTy_maybe upsilon_ty of
Just (tvb, inner_ty) ->
do { let tv = binderVar tvb
vis = binderVisibility tvb
vis = binderArgFlag tvb
kind = tyVarKind tv
; MASSERT2( vis == Specified
, (vcat [ ppr fun_ty, ppr upsilon_ty, ppr tvb
......@@ -1484,7 +1484,7 @@ tcExprSig expr sig@(PartialSig { psig_name = name, sig_loc = loc })
tau_tvs = tyCoVarsOfType tau
; (binders, my_theta) <- chooseInferredQuantifiers inferred_theta
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)
; wrap <- if inferred_sigma `eqType` my_sigma -- NB: eqType ignores vis.
then return idHsWrapper -- Fast path; also avoids complaint when we infer
......
......@@ -1660,8 +1660,8 @@ functorLikeTraverse var (FT { ft_triv = caseTrivial, ft_var = caseVar
where
(xrs,xcs) = unzip (map (go co) args)
go co (ForAllTy (TvBndr v vis) x)
| isVisible vis = panic "unexpected visible binder"
| v /= var && xc = (caseForAll v xr,True)
| isVisibleArgFlag vis = panic "unexpected visible binder"
| v /= var && xc = (caseForAll v xr,True)
where (xr,xc) = go co x
go _ _ = (caseTrivial,False)
......
......@@ -752,7 +752,7 @@ tcInferArgs fun tc_binders mb_kind_info args
; (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
; let (invis_bndrs, other_binders) = break isVisibleBinder leftover_binders
; (subst', invis_args)
<- tcInstBindersX subst mb_kind_info invis_bndrs
; return ( subst'
......@@ -780,7 +780,7 @@ tc_infer_args mode orig_ty binders mb_kind_info orig_args n0
-- typechecking, we don't.
go subst binders all_args n acc
| (inv_binders, other_binders) <- span isInvisibleBinder binders
| (inv_binders, other_binders) <- break isVisibleBinder binders
, not (null inv_binders)
= do { traceTc "tc_infer_args 1" (ppr inv_binders)
; (subst', args') <- tcInstBindersX subst mb_kind_info inv_binders
......@@ -1320,7 +1320,7 @@ kcHsTyVarBndrs name cusk open_fam all_kind_vars
thing
-- See Note [Dependent LHsQTyVars]
; let new_binder | hsTyVarName hs_tv `elemNameSet` dep_names
= mkNamedTyConBinder Visible tv
= mkNamedTyConBinder Required tv
| otherwise
= mkAnonTyConBinder tv
; return ( new_binder : binders
......
......@@ -1532,7 +1532,7 @@ mkDefMethBind clas inst_tys sel_id dm_name
fn = noLoc (idName sel_id)
visible_inst_tys = [ ty | (tcb, ty) <- tyConBinders (classTyCon clas) `zip` inst_tys
, tyConBinderVisibility tcb /= Invisible ]
, tyConBinderArgFlag tcb /= Inferred ]
rhs = foldl mk_vta (nlHsVar dm_name) visible_inst_tys
bind = noLoc $ mkTopFunBind Generated fn $
[mkSimpleMatch (FunRhs fn Prefix) [] rhs]
......
......@@ -91,9 +91,9 @@ tcInferPatSynDecl PSB{ psb_id = lname@(L _ name), psb_args = details,
; traceTc "tcInferPatSynDecl }" $ ppr name
; tc_patsyn_finish lname dir is_infix lpat'
(mkTyVarBinders Invisible univ_tvs
(mkTyVarBinders Inferred univ_tvs
, req_theta, ev_binds, req_dicts)
(mkTyVarBinders Invisible ex_tvs
(mkTyVarBinders Inferred ex_tvs
, mkTyVarTys ex_tvs, prov_theta, map EvId prov_dicts)
(map nlHsVar args, map idType args)
pat_ty rec_fields }
......@@ -396,7 +396,7 @@ tcPatSynMatcher (L loc name) lpat
(cont_args, cont_arg_tys)
| is_unlifted = ([nlHsVar voidPrimId], [voidPrimTy])
| otherwise = (args, arg_tys)
cont_ty = mkInvSigmaTy ex_tvs prov_theta $
cont_ty = mkInfSigmaTy ex_tvs prov_theta $
mkFunTys cont_arg_tys res_ty
fail_ty = mkFunTy voidPrimTy res_ty
......@@ -407,7 +407,7 @@ tcPatSynMatcher (L loc name) lpat
; fail <- newSysLocalId (fsLit "fail") fail_ty
; let matcher_tau = mkFunTys [pat_ty, cont_ty, fail_ty] res_ty
matcher_sigma = mkInvSigmaTy (rr_tv:res_tv:univ_tvs) req_theta matcher_tau
matcher_sigma = mkInfSigmaTy (rr_tv:res_tv:univ_tvs) req_theta matcher_tau
matcher_id = mkExportedVanillaId matcher_name matcher_sigma
-- See Note [Exported LocalIds] in Id
......
......@@ -2104,7 +2104,7 @@ considers this example, with -fprint-explicit-foralls enabled:
Note that the variables and constraints are reordered here, because this
is possible during regeneralization. Also note that the variables are
reported as Invisible instead of Specified.
reported as Inferred instead of Specified.
:type +v / TM_NoInst
......
......@@ -1304,7 +1304,7 @@ Here we get
data TcPatSynInfo
= TPSI {
patsig_name :: Name,
patsig_implicit_bndrs :: [TyVarBinder], -- Implicitly-bound kind vars (Invisible) and
patsig_implicit_bndrs :: [TyVarBinder], -- Implicitly-bound kind vars (Inferred) 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
......
......@@ -393,7 +393,7 @@ tcPatSynSig name sig_ty
, text "prov" <+> ppr prov
, text "body_ty" <+> ppr body_ty ]
; return (TPSI { patsig_name = name
, patsig_implicit_bndrs = mkTyVarBinders Invisible kvs ++
, patsig_implicit_bndrs = mkTyVarBinders Inferred kvs ++
mkTyVarBinders Specified implicit_tvs
, patsig_univ_bndrs = univ_tvs
, patsig_req = req
......
......@@ -363,7 +363,7 @@ kcTyClGroup decls
, ppr kc_tyvars, ppr (tcTyConScopedTyVars tc)]
; return (mkTcTyCon name
(mkNamedTyConBinders Invisible kvs ++ kc_binders')
(mkNamedTyConBinders Inferred kvs ++ kc_binders')
kc_res_kind'
(mightBeUnsaturatedTyCon tc)
(tcTyConScopedTyVars tc)) }
......@@ -1492,7 +1492,7 @@ tcConDecl new_or_data rep_tycon tmpl_bndrs res_tmpl
-- Can't print univ_tvs, arg_tys etc, because we are inside the knot here
; traceTc "tcConDecl 2" (ppr name $$ ppr field_lbls)
; let
ex_tvs = mkTyVarBinders Invisible qkvs ++
ex_tvs = mkTyVarBinders Inferred qkvs ++
mkTyVarBinders Specified user_qtvs
buildOneDataCon (L _ name) = do
{ is_infix <- tcConIsInfixH98 name hs_details
......
......@@ -610,8 +610,8 @@ initialRoleEnv1 is_boot annots_env tc
| otherwise = pprPanic "initialRoleEnv1" (ppr tc)
where name = tyConName tc
bndrs = tyConBinders tc
visflags = map tyConBinderVisibility bndrs
num_exps = count (== Visible) visflags
argflags = map tyConBinderArgFlag bndrs
num_exps = count isVisibleArgFlag argflags
-- if the number of annotations in the role annotation decl
-- is wrong, just ignore it. We check this in the validity check.
......@@ -620,12 +620,13 @@ initialRoleEnv1 is_boot annots_env tc
Just (L _ (RoleAnnotDecl _ annots))
| annots `lengthIs` num_exps -> map unLoc annots
_ -> replicate num_exps Nothing
default_roles = build_default_roles visflags role_annots
default_roles = build_default_roles argflags role_annots
build_default_roles (Visible : viss) (m_annot : ras)
= (m_annot `orElse` default_role) : build_default_roles viss ras
build_default_roles (_inv : viss) ras
= Nominal : build_default_roles viss ras
build_default_roles (argf : argfs) (m_annot : ras)
| isVisibleArgFlag argf
= (m_annot `orElse` default_role) : build_default_roles argfs ras
build_default_roles (_argf : argfs) ras
= Nominal : build_default_roles argfs ras
build_default_roles [] [] = []
build_default_roles _ _ = pprPanic "initialRoleEnv1 (2)"
(vcat [ppr tc, ppr role_annots])
......
......@@ -49,7 +49,7 @@ module TcType (
--------------------------------
-- Builders
mkPhiTy, mkInvSigmaTy, mkSpecSigmaTy, mkSigmaTy,
mkPhiTy, mkInfSigmaTy, mkSpecSigmaTy, mkSigmaTy,
mkNakedTyConApp, mkNakedAppTys, mkNakedAppTy,
mkNakedCastTy,
......@@ -128,7 +128,7 @@ module TcType (
--------------------------------
-- Rexported from Type
Type, PredType, ThetaType, TyBinder, VisibilityFlag(..),
Type, PredType, ThetaType, TyBinder, ArgFlag(..),
mkForAllTy, mkForAllTys, mkInvForAllTys, mkSpecForAllTys, mkInvForAllTy,
mkFunTy, mkFunTys,
......@@ -1121,8 +1121,10 @@ isRuntimeUnkSkol x
mkSigmaTy :: [TyVarBinder] -> [PredType] -> Type -> Type
mkSigmaTy bndrs theta tau = mkForAllTys bndrs (mkPhiTy theta tau)
mkInvSigmaTy :: [TyVar] -> [PredType] -> Type -> Type
mkInvSigmaTy tyvars ty = mkSigmaTy (mkTyVarBinders Invisible tyvars) ty
-- | Make a sigma ty wherea ll type variables are 'Inferred'. That is,
-- they cannot be used with visible type application.
mkInfSigmaTy :: [TyVar] -> [PredType] -> Type -> Type
mkInfSigmaTy tyvars ty = mkSigmaTy (mkTyVarBinders Inferred tyvars) ty
-- | Make a sigma ty where all type variables are "specified". That is,
-- they can be used with visible type application
......@@ -1446,30 +1448,32 @@ tcEqTypeNoKindCheck ty1 ty2
= isNothing $ tc_eq_type coreView ty1 ty2
-- | Like 'tcEqType', but returns information about whether the difference
-- is visible in the case of a mismatch. A return of Nothing means the types
-- are 'tcEqType'.
tcEqTypeVis :: TcType -> TcType -> Maybe VisibilityFlag
-- is visible in the case of a mismatch.
-- @Nothing@ : the types are equal
-- @Just True@ : the types differ, and the point of difference is visible
-- @Just False@ : the types differ, and the point of difference is invisible
tcEqTypeVis :: TcType -> TcType -> Maybe Bool
tcEqTypeVis ty1 ty2
= tc_eq_type coreView ty1 ty2 <!> invis (tc_eq_type coreView ki1 ki2)
where
ki1 = typeKind ty1
ki2 = typeKind ty2
-- convert Just Visible to Just Invisible
invis :: Maybe VisibilityFlag -> Maybe VisibilityFlag
invis = fmap (const Invisible)
-- convert Just True to Just False
invis :: Maybe Bool -> Maybe Bool
invis = fmap (const False)
(<!>) :: Maybe VisibilityFlag -> Maybe VisibilityFlag -> Maybe VisibilityFlag
Nothing <!> x = x
Just Visible <!> _ = Just Visible
Just _inv <!> Just Visible = Just Visible
Just inv <!> _ = Just inv
(<!>) :: Maybe Bool -> Maybe Bool -> Maybe Bool
Nothing <!> x = x
Just True <!> _ = Just True
Just _vis <!> Just True = Just True
Just vis <!> _ = Just vis
infixr 3 <!>
-- | Real worker for 'tcEqType'. No kind check!
tc_eq_type :: (TcType -> Maybe TcType) -- ^ @coreView@, if you want unwrapping
-> Type -> Type -> Maybe VisibilityFlag
tc_eq_type view_fun orig_ty1 orig_ty2 = go Visible orig_env orig_ty1 orig_ty2
-> Type -> Type -> Maybe Bool
tc_eq_type view_fun orig_ty1 orig_ty2 = go True orig_env orig_ty1 orig_ty2
where
go vis env t1 t2 | Just t1' <- view_fun t1 = go vis env t1' t2
go vis env t1 t2 | Just t2' <- view_fun t2 = go vis env t1 t2'
......@@ -1482,7 +1486,7 @@ tc_eq_type view_fun orig_ty1 orig_ty2 = go Visible orig_env orig_ty1 orig_ty2
go vis env (ForAllTy (TvBndr tv1 vis1) ty1)
(ForAllTy (TvBndr tv2 vis2) ty2)
= go vis1 env (tyVarKind tv1) (tyVarKind tv2)
= go (isVisibleArgFlag vis1) env (tyVarKind tv1) (tyVarKind tv2)
<!> go vis (rnBndr2 env tv1 tv2) ty1 ty2
<!> check vis (vis1 == vis2)
go vis env (FunTy arg1 res1) (FunTy arg2 res2)
......@@ -1507,17 +1511,17 @@ tc_eq_type view_fun orig_ty1 orig_ty2 = go Visible orig_env orig_ty1 orig_ty2
gos (v:_) _ _ _ = Just v
gos _ _ _ _ = panic "tc_eq_type"
tc_vis :: VisibilityFlag -> TyCon -> [VisibilityFlag]
tc_vis Visible tc = viss ++ repeat Visible
-- the repeat Visible is necessary because tycons can legitimately
tc_vis :: Bool -> TyCon -> [Bool]
tc_vis True tc = viss ++ repeat True
-- the repeat True is necessary because tycons can legitimately
-- be oversaturated
where
bndrs = tyConBinders tc
viss = map tyConBinderVisibility bndrs
tc_vis vis _ = repeat vis -- if we're not in a visible context, our args
-- aren't either
viss = map (isVisibleArgFlag . tyConBinderArgFlag) bndrs
tc_vis False _ = repeat False -- if we're not in a visible context, our args
-- aren't either
check :: VisibilityFlag -> Bool -> Maybe VisibilityFlag
check :: Bool -> Bool -> Maybe Bool
check _ True = Nothing
check vis False = Just vis
......@@ -2172,7 +2176,7 @@ to_tc_mapper
hole ftvs h r t1 t2 = mkHoleCo h r <$> to_tc_type ftvs t1
<*> to_tc_type ftvs t2
tybinder :: VarSet -> TyVar -> VisibilityFlag -> Identity (VarSet, TyVar)
tybinder :: VarSet -> TyVar -> ArgFlag -> Identity (VarSet, TyVar)
tybinder ftvs tv _vis = do { kind' <- to_tc_type ftvs (tyVarKind tv)
; let tv' = mkTcTyVar (tyVarName tv) kind'