summaryrefslogtreecommitdiff
path: root/compiler/iface
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/iface')
-rw-r--r--compiler/iface/BuildTyCl.hs60
-rw-r--r--compiler/iface/IfaceSyn.hs4
-rw-r--r--compiler/iface/IfaceType.hs76
-rw-r--r--compiler/iface/MkIface.hs23
-rw-r--r--compiler/iface/TcIface.hs33
5 files changed, 99 insertions, 97 deletions
diff --git a/compiler/iface/BuildTyCl.hs b/compiler/iface/BuildTyCl.hs
index f62e5eeacb..c20a5ee9e2 100644
--- a/compiler/iface/BuildTyCl.hs
+++ b/compiler/iface/BuildTyCl.hs
@@ -29,7 +29,7 @@ import MkId
import Class
import TyCon
import Type
-import TyCoRep( TyBinder(..) )
+import TyCoRep( TyBinder(..), TyVarBinder(..) )
import Id
import TcType
@@ -112,9 +112,8 @@ buildDataCon :: FamInstEnvs
-> Maybe [HsImplBang]
-- See Note [Bangs on imported data constructors] in MkId
-> [FieldLabel] -- Field labels
- -> [TyVar] -> [TyBinder] -- Universals; see
- -- Note [TyBinders in DataCons] in DataCon
- -> [TyVar] -> [TyBinder] -- existentials
+ -> [TyVar] -> [TyBinder] -- Universals
+ -> [TyVarBinder] -- existentials
-> [EqSpec] -- Equality spec
-> ThetaType -- Does not include the "stupid theta"
-- or the GADT equalities
@@ -125,9 +124,9 @@ buildDataCon :: FamInstEnvs
-- a) makes the worker Id
-- b) makes the wrapper Id if necessary, including
-- allocating its unique (hence monadic)
--- c) Sorts out the TyBinders. See Note [TyBinders in DataCons] in DataCon
+-- c) Sorts out the TyVarBinders. See mkDataConUnivTyBinders
buildDataCon fam_envs src_name declared_infix prom_info src_bangs impl_bangs field_lbls
- univ_tvs univ_bndrs ex_tvs ex_bndrs eq_spec ctxt arg_tys res_ty rep_tycon
+ univ_tvs univ_bndrs ex_tvs eq_spec ctxt arg_tys res_ty rep_tycon
= do { wrap_name <- newImplicitBinder src_name mkDataConWrapperOcc
; work_name <- newImplicitBinder src_name mkDataConWorkerOcc
-- This last one takes the name of the data constructor in the source
@@ -137,11 +136,11 @@ buildDataCon fam_envs src_name declared_infix prom_info src_bangs impl_bangs fie
; traceIf (text "buildDataCon 1" <+> ppr src_name)
; us <- newUniqueSupply
; dflags <- getDynFlags
- ; let dc_bndrs = mkDataConUnivTyBinders univ_bndrs univ_tvs
+ ; let dc_bndrs = mkDataConUnivTyVarBinders univ_tvs univ_bndrs
stupid_ctxt = mkDataConStupidTheta rep_tycon arg_tys univ_tvs
data_con = mkDataCon src_name declared_infix prom_info
src_bangs field_lbls
- univ_tvs dc_bndrs ex_tvs ex_bndrs eq_spec ctxt
+ dc_bndrs ex_tvs eq_spec ctxt
arg_tys res_ty NoRRI rep_tycon
stupid_ctxt dc_wrk dc_rep
dc_wrk = mkDataConWorkId work_name data_con
@@ -171,25 +170,25 @@ mkDataConStupidTheta tycon arg_tys univ_tvs
tyCoVarsOfType pred `intersectVarSet` arg_tyvars
-mkDataConUnivTyBinders :: [TyBinder] -> [TyVar] -- From the TyCon
- -> [TyBinder] -- For the DataCon
+mkDataConUnivTyVarBinders :: [TyVar] -> [TyBinder] -- From the TyCon
+ -> [TyVarBinder] -- For the DataCon
-- See Note [Building the TyBinders for a DataCon]
-mkDataConUnivTyBinders bndrs tvs
- = zipWith mk_binder bndrs tvs
+mkDataConUnivTyVarBinders tvs bndrs
+ = zipWith mk_binder tvs bndrs
where
- mk_binder bndr tv = mkNamedBinder vis tv
+ mk_binder tv bndr = mkTyVarBinder vis tv
where
vis = case bndr of
- Anon _ -> Specified
- Named _ Visible -> Specified
- Named _ vis -> vis
+ Anon _ -> Specified
+ Named (TvBndr _ Visible) -> Specified
+ Named (TvBndr _ vis) -> vis
{- Note [Building the TyBinders for a DataCon]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
A DataCon needs to keep track of the visibility of its universals and
existentials, so that visible type application can work properly. This
-is done by storing the universal and existential TyBinders, along with
-the TyVars. See Note [TyBinders in DataCons] in DataCon.
+is done by storing the universal and existential TyVarBinders.
+See Note [TyVarBinders in DataCons] in DataCon.
During construction of a DataCon, we often start from the TyBinders of
the parent TyCon. For example
@@ -203,8 +202,8 @@ of the DataCon. Here is an example:
The TyCon has
- tyConTyVars = [ k:*, a:k->*, b:k]
- tyConTyBinders = [ Named (k :: *) Invisible, Anon (k->*), Anon k ]
+ tyConTyVars = [ k:*, a:k->*, b:k]
+ tyConTyBinders = [ Named (TvBndr (k :: *) Invisible), Anon (k->*), Anon k ]
The TyBinders for App line up with App's kind, given above.
@@ -213,9 +212,9 @@ But the DataCon MkApp has the type
That is, its TyBinders should be
- dataConUnivTyVars = [ Named (k:*) Invisible
- , Named (a:k->*) Specified
- , Named (b:k) Specified ]
+ dataConUnivTyVarBinders = [ TvBndr (k:*) Invisible
+ , TvBndr (a:k->*) Specified
+ , TvBndr (b:k) Specified ]
So we want to take the TyCon's TyBinders and the TyCon's TyVars and
merge them, pulling
@@ -237,15 +236,15 @@ DataCon (mkDataCon does no further work).
------------------------------------------------------
buildPatSyn :: Name -> Bool
-> (Id,Bool) -> Maybe (Id, Bool)
- -> ([TyVar], [TyBinder], ThetaType) -- ^ Univ and req
- -> ([TyVar], [TyBinder], ThetaType) -- ^ Ex and prov
+ -> ([TyVarBinder], ThetaType) -- ^ Univ and req
+ -> ([TyVarBinder], ThetaType) -- ^ Ex and prov
-> [Type] -- ^ Argument types
-> Type -- ^ Result type
-> [FieldLabel] -- ^ Field labels for
-- a record pattern synonym
-> PatSyn
buildPatSyn src_name declared_infix matcher@(matcher_id,_) builder
- (univ_tvs, univ_bndrs, req_theta) (ex_tvs, ex_bndrs, prov_theta) arg_tys
+ (univ_tvs, req_theta) (ex_tvs, prov_theta) arg_tys
pat_ty field_labels
= -- The assertion checks that the matcher is
-- compatible with the pattern synonym
@@ -263,17 +262,17 @@ buildPatSyn src_name declared_infix matcher@(matcher_id,_) builder
, ppr req_theta <+> twiddle <+> ppr req_theta1
, ppr arg_tys <+> twiddle <+> ppr arg_tys1]))
mkPatSyn src_name declared_infix
- (univ_tvs, univ_bndrs, req_theta) (ex_tvs, ex_bndrs, prov_theta)
+ (univ_tvs, req_theta) (ex_tvs, prov_theta)
arg_tys pat_ty
matcher builder field_labels
where
((_:_:univ_tvs1), req_theta1, tau) = tcSplitSigmaTy $ idType matcher_id
- ([pat_ty1, cont_sigma, _], _) = tcSplitFunTys tau
- (ex_tvs1, prov_theta1, cont_tau) = tcSplitSigmaTy cont_sigma
+ ([pat_ty1, cont_sigma, _], _) = tcSplitFunTys tau
+ (ex_tvs1, prov_theta1, cont_tau) = tcSplitSigmaTy cont_sigma
(arg_tys1, _) = tcSplitFunTys cont_tau
twiddle = char '~'
subst = zipTvSubst (univ_tvs1 ++ ex_tvs1)
- (mkTyVarTys (univ_tvs ++ ex_tvs))
+ (mkTyVarTys (map binderVar (univ_tvs ++ ex_tvs)))
------------------------------------------------------
type TcMethInfo = (Name, Type, Maybe (DefMethSpec Type))
@@ -342,7 +341,6 @@ buildClass tycon_name tvs roles sc_theta binders
[{- No fields -}]
tvs binders
[{- no existentials -}]
- [{- no existentials -}]
[{- No GADT equalities -}]
[{- No theta -}]
arg_tys
diff --git a/compiler/iface/IfaceSyn.hs b/compiler/iface/IfaceSyn.hs
index a95d8c92af..0ad4b0f5db 100644
--- a/compiler/iface/IfaceSyn.hs
+++ b/compiler/iface/IfaceSyn.hs
@@ -1314,8 +1314,8 @@ freeNamesIfForAllBndr :: IfaceForAllBndr -> NameSet
freeNamesIfForAllBndr (IfaceTv tv _) = freeNamesIfTvBndr tv
freeNamesIfTyBinder :: IfaceTyConBinder -> NameSet
-freeNamesIfTyBinder (IfaceAnon _ ty) = freeNamesIfType ty
-freeNamesIfTyBinder (IfaceNamed b) = freeNamesIfForAllBndr b
+freeNamesIfTyBinder (IfaceAnon b) = freeNamesIfTvBndr b
+freeNamesIfTyBinder (IfaceNamed b) = freeNamesIfForAllBndr b
freeNamesIfTyBinders :: [IfaceTyConBinder] -> NameSet
freeNamesIfTyBinders = fnList freeNamesIfTyBinder
diff --git a/compiler/iface/IfaceType.hs b/compiler/iface/IfaceType.hs
index 45732ca5f7..fb2b3df1cc 100644
--- a/compiler/iface/IfaceType.hs
+++ b/compiler/iface/IfaceType.hs
@@ -101,13 +101,15 @@ data IfaceBndr -- Local (non-top-level) binders
type IfaceIdBndr = (IfLclName, IfaceType)
type IfaceTvBndr = (IfLclName, IfaceKind)
+ifaceTvBndrName :: IfaceTvBndr -> IfLclName
+ifaceTvBndrName (n,_) = n
+
+type IfaceLamBndr = (IfaceBndr, IfaceOneShot)
data IfaceOneShot -- See Note [Preserve OneShotInfo] in CoreTicy
= IfaceNoOneShot -- and Note [The oneShot function] in MkId
| IfaceOneShot
-type IfaceLamBndr
- = (IfaceBndr, IfaceOneShot)
{-
%************************************************************************
@@ -148,8 +150,8 @@ data IfaceForAllBndr
= IfaceTv IfaceTvBndr VisibilityFlag
data IfaceTyConBinder
- = IfaceAnon IfLclName IfaceType -- like Anon, but it includes a name from
- -- which to produce a tyConTyVar
+ = IfaceAnon IfaceTvBndr -- Like Anon, but it includes a name from
+ -- which to produce a tyConTyVar
| IfaceNamed IfaceForAllBndr
-- See Note [Suppressing invisible arguments]
@@ -159,8 +161,9 @@ data IfaceTyConBinder
-- type/kind) there'll just be one.
data IfaceTcArgs
= ITC_Nil
- | ITC_Vis IfaceType IfaceTcArgs
- | ITC_Invis IfaceKind IfaceTcArgs
+ | ITC_Vis IfaceType IfaceTcArgs -- "Vis" means show when pretty-printing
+ | ITC_Invis IfaceKind IfaceTcArgs -- "Invis" means don't show when pretty-printin
+ -- except with -fprint-explicit-kinds
-- Encodes type constructors, kind constructors,
-- coercion constructors, the lot.
@@ -266,13 +269,12 @@ isIfaceInvisBndr _ = False
-- | Extract a IfaceTvBndr from a IfaceTyConBinder
ifTyConBinderTyVar :: IfaceTyConBinder -> IfaceTvBndr
-ifTyConBinderTyVar (IfaceAnon name ki) = (name, ki)
+ifTyConBinderTyVar (IfaceAnon tv) = tv
ifTyConBinderTyVar (IfaceNamed (IfaceTv tv _)) = tv
-- | Extract the variable name from a IfaceTyConBinder
ifTyConBinderName :: IfaceTyConBinder -> IfLclName
-ifTyConBinderName (IfaceAnon name _) = name
-ifTyConBinderName (IfaceNamed (IfaceTv (name, _) _)) = name
+ifTyConBinderName tcb = ifaceTvBndrName (ifTyConBinderTyVar tcb)
ifTyVarsOfType :: IfaceType -> UniqSet IfLclName
ifTyVarsOfType ty
@@ -533,12 +535,15 @@ toIfaceTcArgs tc ty_args
go env ty ts
| Just ty' <- coreView ty
= go env ty' ts
- go env (ForAllTy bndr res) (t:ts)
- | isVisibleBinder bndr = ITC_Vis t' ts'
- | otherwise = ITC_Invis t' ts'
+ go env (ForAllTy (TvBndr tv vis) res) (t:ts)
+ | isVisible vis = ITC_Vis t' ts'
+ | otherwise = ITC_Invis t' ts'
where
t' = toIfaceType t
- ts' = go (extendTvSubstBinder env bndr t) res ts
+ ts' = go (extendTvSubst env tv t) res ts
+
+ go env (FunTy _ res) (t:ts) -- No type-class args in tycon apps
+ = ITC_Vis (toIfaceType t) (go env res ts)
go env (TyVarTy tv) ts
| Just ki <- lookupTyVar env tv = go env ki ts
@@ -554,9 +559,8 @@ tcArgsIfaceTypes (ITC_Vis t ts) = t : tcArgsIfaceTypes ts
Note [Suppressing invisible arguments]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
We use the IfaceTcArgs to specify which of the arguments to a type
-constructor should be visible.
-This in turn used to control suppression when printing types,
-under the control of -fprint-explicit-kinds.
+constructor should be displayed when pretty-printing, under
+the control of -fprint-explicit-kinds.
See also Type.filterOutInvisibleTypes.
For example, given
T :: forall k. (k->*) -> k -> * -- Ordinary kind polymorphism
@@ -608,8 +612,7 @@ pprIfaceTvBndr (tv, ki)
pprIfaceTyConBinders :: [IfaceTyConBinder] -> SDoc
pprIfaceTyConBinders = sep . map go
where
- go (IfaceAnon name ki) = pprIfaceTvBndr (name, ki)
- go (IfaceNamed (IfaceTv tv _)) = pprIfaceTvBndr tv
+ go tcb = pprIfaceTvBndr (ifTyConBinderTyVar tcb)
instance Binary IfaceBndr where
put_ bh (IfaceIdBndr aa) = do
@@ -1004,16 +1007,15 @@ instance Binary IfaceForAllBndr where
return (IfaceTv tv vis)
instance Binary IfaceTyConBinder where
- put_ bh (IfaceAnon n ty) = putByte bh 0 >> put_ bh n >> put_ bh ty
- put_ bh (IfaceNamed b) = putByte bh 1 >> put_ bh b
+ put_ bh (IfaceAnon b) = putByte bh 0 >> put_ bh b
+ put_ bh (IfaceNamed b) = putByte bh 1 >> put_ bh b
get bh =
do c <- getByte bh
case c of
0 -> do
- n <- get bh
- ty <- get bh
- return $! IfaceAnon n ty
+ b <- get bh
+ return $! IfaceAnon b
_ -> do
b <- get bh
return $! IfaceNamed b
@@ -1283,7 +1285,7 @@ instance Binary (DefMethSpec IfaceType) where
-}
----------------
-toIfaceTvBndr :: TyVar -> (IfLclName, IfaceKind)
+toIfaceTvBndr :: TyVar -> IfaceTvBndr
toIfaceTvBndr tyvar = ( occNameFS (getOccName tyvar)
, toIfaceKind (tyVarKind tyvar)
)
@@ -1308,9 +1310,8 @@ toIfaceType :: Type -> IfaceType
toIfaceType (TyVarTy tv) = IfaceTyVar (toIfaceTyVar tv)
toIfaceType (AppTy t1 t2) = IfaceAppTy (toIfaceType t1) (toIfaceType t2)
toIfaceType (LitTy n) = IfaceLitTy (toIfaceTyLit n)
-toIfaceType (ForAllTy (Named tv vis) t)
- = IfaceForAllTy (varToIfaceForAllBndr tv vis) (toIfaceType t)
-toIfaceType (ForAllTy (Anon t1) t2)
+toIfaceType (ForAllTy b t) = IfaceForAllTy (toIfaceForAllBndr b) (toIfaceType t)
+toIfaceType (FunTy t1 t2)
| isPredTy t1 = IfaceDFunTy (toIfaceType t1) (toIfaceType t2)
| otherwise = IfaceFunTy (toIfaceType t1) (toIfaceType t2)
toIfaceType (CastTy ty co) = IfaceCastTy (toIfaceType ty) (toIfaceCoercion co)
@@ -1338,14 +1339,12 @@ toIfaceTyVar = occNameFS . getOccName
toIfaceCoVar :: CoVar -> FastString
toIfaceCoVar = occNameFS . getOccName
-varToIfaceForAllBndr :: TyVar -> VisibilityFlag -> IfaceForAllBndr
-varToIfaceForAllBndr v vis
+toIfaceForAllBndr :: TyVarBinder -> IfaceForAllBndr
+toIfaceForAllBndr (TvBndr v vis)
= IfaceTv (toIfaceTvBndr v) vis
-binderToIfaceForAllBndr :: TyBinder -> IfaceForAllBndr
-binderToIfaceForAllBndr (Named v vis) = IfaceTv (toIfaceTvBndr v) vis
-binderToIfaceForAllBndr binder
- = pprPanic "binderToIfaceForAllBndr" (ppr binder)
+binderToIfaceForAllBndr :: TyVarBinder -> IfaceForAllBndr
+binderToIfaceForAllBndr (TvBndr v vis) = IfaceTv (toIfaceTvBndr v) vis
----------------
toIfaceTyCon :: TyCon -> IfaceTyCon
@@ -1419,14 +1418,15 @@ toIfaceUnivCoProv (HoleProv h) = pprPanic "toIfaceUnivCoProv hit a hole" (ppr h)
zipIfaceBinders :: [TyVar] -> [TyBinder] -> [IfaceTyConBinder]
zipIfaceBinders = zipWith go
where
- go tv (Anon _) = let (name, ki) = toIfaceTvBndr tv in
- IfaceAnon name ki
- go tv (Named _ vis) = IfaceNamed (IfaceTv (toIfaceTvBndr tv) vis)
+ go tv (Anon _) = IfaceAnon (toIfaceTvBndr tv)
+ go tv (Named tvb) = IfaceNamed (IfaceTv (toIfaceTvBndr tv) (binderVisibility tvb))
+ -- Ugh! take the tidied tyvar from the first arg,
+ -- and visiblity from the second
-- | Make IfaceTyConBinders without tyConTyVars. Used for pretty-printing only
toDegenerateBinders :: [TyBinder] -> [IfaceTyConBinder]
toDegenerateBinders = zipWith go [1..]
where
go :: Int -> TyBinder -> IfaceTyConBinder
- go n (Anon ty) = IfaceAnon (mkFastString ("t" ++ show n)) (toIfaceType ty)
- go _ (Named tv vis) = IfaceNamed (IfaceTv (toIfaceTvBndr tv) vis)
+ go n (Anon ty) = IfaceAnon (mkFastString ("t" ++ show n), toIfaceType ty)
+ go _ (Named tvb) = IfaceNamed (toIfaceForAllBndr tvb)
diff --git a/compiler/iface/MkIface.hs b/compiler/iface/MkIface.hs
index fcf63af369..aedec424ae 100644
--- a/compiler/iface/MkIface.hs
+++ b/compiler/iface/MkIface.hs
@@ -1321,10 +1321,10 @@ patSynToIfaceDecl ps
}
where
(_univ_tvs, req_theta, _ex_tvs, prov_theta, args, rhs_ty) = patSynSig ps
- univ_bndrs = patSynUnivTyBinders ps
- ex_bndrs = patSynExTyBinders ps
- (env1, univ_bndrs') = tidyTyBinders emptyTidyEnv univ_bndrs
- (env2, ex_bndrs') = tidyTyBinders env1 ex_bndrs
+ univ_bndrs = patSynUnivTyVarBinders ps
+ ex_bndrs = patSynExTyVarBinders ps
+ (env1, univ_bndrs') = tidyTyVarBinders emptyTidyEnv univ_bndrs
+ (env2, ex_bndrs') = tidyTyVarBinders env1 ex_bndrs
to_if_pr (id, needs_dummy) = (idName id, needs_dummy)
--------------------------
@@ -1415,12 +1415,15 @@ tyConToIfaceDecl env tycon
ifParent = parent })
| otherwise -- FunTyCon, PrimTyCon, promoted TyCon/DataCon
- -- For pretty printing purposes only.
+ -- We only convert these TyCons to IfaceTyCons when we are
+ -- just about to pretty-print them, not because we are going
+ -- to put them into interface files
= ( env
, IfaceData { ifName = getOccName tycon,
ifBinders = if_degenerate_binders,
ifResKind = if_degenerate_res_kind,
- -- These don't have `tyConTyVars`, hence "degenerate"
+ -- FunTyCon, PrimTyCon etc don't have
+ -- `tyConTyVars`, hence "degenerate"
ifCType = Nothing,
ifRoles = tyConRoles tycon,
ifCtxt = [],
@@ -1438,7 +1441,7 @@ tyConToIfaceDecl env tycon
if_syn_type ty = tidyToIfaceType tc_env1 ty
if_res_var = getOccFS `fmap` tyConFamilyResVar_maybe tycon
- -- use these when you don't have tyConTyVars
+ -- Use these when you don't have tyConTyVars
(degenerate_binders, degenerate_res_kind)
= splitPiTys (tidyType env (tyConKind tycon))
if_degenerate_binders = toDegenerateBinders degenerate_binders
@@ -1492,7 +1495,7 @@ tyConToIfaceDecl env tycon
where
(univ_tvs, _ex_tvs, eq_spec, theta, arg_tys, _)
= dataConFullSig data_con
- ex_bndrs = dataConExTyBinders data_con
+ ex_bndrs = dataConExTyVarBinders data_con
-- Tidy the univ_tvs of the data constructor to be identical
-- to the tyConTyVars of the type constructor. This means
@@ -1504,8 +1507,8 @@ tyConToIfaceDecl env tycon
con_env1 = (fst tc_env1, mkVarEnv (zipEqual "ifaceConDecl" univ_tvs tc_tyvars))
-- A bit grimy, perhaps, but it's simple!
- (con_env2, ex_bndrs') = tidyTyBinders con_env1 ex_bndrs
- to_eq_spec (tv,ty) = (toIfaceTyVar (tidyTyVar con_env2 tv), tidyToIfaceType con_env2 ty)
+ (con_env2, ex_bndrs') = tidyTyVarBinders con_env1 ex_bndrs
+ to_eq_spec (tv,ty) = (toIfaceTyVar (tidyTyVar con_env2 tv), tidyToIfaceType con_env2 ty)
ifaceOverloaded flds = case dFsEnvElts flds of
fl:_ -> flIsOverloaded fl
diff --git a/compiler/iface/TcIface.hs b/compiler/iface/TcIface.hs
index a6486f3222..35d83259aa 100644
--- a/compiler/iface/TcIface.hs
+++ b/compiler/iface/TcIface.hs
@@ -493,16 +493,16 @@ tc_iface_decl _ _ (IfacePatSyn{ ifName = occ_name
; traceIf (text "tc_iface_decl" <+> ppr name)
; matcher <- tc_pr if_matcher
; builder <- fmapMaybeM tc_pr if_builder
- ; bindIfaceForAllBndrs univ_bndrs $ \univ_tvs univ_bndrs -> do
- { bindIfaceForAllBndrs ex_bndrs $ \ex_tvs ex_bndrs -> do
+ ; bindIfaceForAllBndrs univ_bndrs $ \univ_tvs -> do
+ { bindIfaceForAllBndrs ex_bndrs $ \ex_tvs -> do
{ patsyn <- forkM (mk_doc name) $
do { prov_theta <- tcIfaceCtxt prov_ctxt
; req_theta <- tcIfaceCtxt req_ctxt
; pat_ty <- tcIfaceType pat_ty
; arg_tys <- mapM tcIfaceType args
; return $ buildPatSyn name is_infix matcher builder
- (univ_tvs, univ_bndrs, req_theta)
- (ex_tvs, ex_bndrs, prov_theta)
+ (univ_tvs, req_theta)
+ (ex_tvs, prov_theta)
arg_tys pat_ty field_labels }
; return $ AConLike . PatSynCon $ patsyn }}}
where
@@ -553,7 +553,7 @@ tcIfaceDataCons tycon_name tycon tc_tyvars tc_tybinders if_cons
ifConSrcStricts = if_src_stricts})
= -- Universally-quantified tyvars are shared with
-- parent TyCon, and are alrady in scope
- bindIfaceForAllBndrs ex_bndrs $ \ ex_tvs ex_binders' -> do
+ bindIfaceForAllBndrs ex_bndrs $ \ ex_tvs -> do
{ traceIf (text "Start interface-file tc_con_decl" <+> ppr occ)
; dc_name <- lookupIfaceTop occ
@@ -595,7 +595,7 @@ tcIfaceDataCons tycon_name tycon tc_tyvars tc_tybinders if_cons
-- worker.
-- See Note [Bangs on imported data constructors] in MkId
lbl_names
- tc_tyvars tc_tybinders ex_tvs ex_binders'
+ tc_tyvars tc_tybinders ex_tvs
eq_spec theta
arg_tys orig_res_ty tycon
; traceIf (text "Done interface-file tc_con_decl" <+> ppr dc_name)
@@ -890,15 +890,16 @@ tcIfaceType = go
go (IfaceTyVar n) = TyVarTy <$> tcIfaceTyVar n
go (IfaceAppTy t1 t2) = AppTy <$> go t1 <*> go t2
go (IfaceLitTy l) = LitTy <$> tcIfaceTyLit l
- go (IfaceFunTy t1 t2) = ForAllTy <$> (Anon <$> go t1) <*> go t2
- go (IfaceDFunTy t1 t2) = ForAllTy <$> (Anon <$> go t1) <*> go t2
+ go (IfaceFunTy t1 t2) = FunTy <$> go t1 <*> go t2
+ go (IfaceDFunTy t1 t2) = FunTy <$> go t1 <*> go t2
go (IfaceTupleTy s i tks) = tcIfaceTupleTy s i tks
go (IfaceTyConApp tc tks)
= do { tc' <- tcIfaceTyCon tc
; tks' <- mapM go (tcArgsIfaceTypes tks)
; return (mkTyConApp tc' tks') }
go (IfaceForAllTy bndr t)
- = bindIfaceForAllBndr bndr $ \ tv' vis -> mkNamedForAllTy tv' vis <$> go t
+ = bindIfaceForAllBndr bndr $ \ tv' vis ->
+ ForAllTy (TvBndr tv' vis) <$> go t
go (IfaceCastTy ty co) = CastTy <$> go ty <*> tcIfaceCo co
go (IfaceCoercionTy co) = CoercionTy <$> tcIfaceCo co
@@ -1436,12 +1437,12 @@ bindIfaceBndrs (b:bs) thing_inside
thing_inside (b':bs')
-----------------------
-bindIfaceForAllBndrs :: [IfaceForAllBndr] -> ([TyVar] -> [TyBinder] -> IfL a) -> IfL a
-bindIfaceForAllBndrs [] thing_inside = thing_inside [] []
+bindIfaceForAllBndrs :: [IfaceForAllBndr] -> ([TyVarBinder] -> IfL a) -> IfL a
+bindIfaceForAllBndrs [] thing_inside = thing_inside []
bindIfaceForAllBndrs (bndr:bndrs) thing_inside
= bindIfaceForAllBndr bndr $ \tv vis ->
- bindIfaceForAllBndrs bndrs $ \tvs bndrs' ->
- thing_inside (tv:tvs) (mkNamedBinder vis tv : bndrs')
+ bindIfaceForAllBndrs bndrs $ \bndrs' ->
+ thing_inside (mkTyVarBinder vis tv : bndrs')
bindIfaceForAllBndr :: IfaceForAllBndr -> (TyVar -> VisibilityFlag -> IfL a) -> IfL a
bindIfaceForAllBndr (IfaceTv tv vis) thing_inside
@@ -1488,9 +1489,9 @@ bindIfaceTyConBinders_AT (b : bs) thing_inside
bindIfaceTyConBinderX :: (IfaceTvBndr -> (TyVar -> IfL a) -> IfL a)
-> IfaceTyConBinder
-> (TyVar -> TyBinder -> IfL a) -> IfL a
-bindIfaceTyConBinderX bind_tv (IfaceAnon name ki) thing_inside
- = bind_tv (name, ki) $ \ tv' ->
+bindIfaceTyConBinderX bind_tv (IfaceAnon tv) thing_inside
+ = bind_tv tv $ \ tv' ->
thing_inside tv' (Anon (tyVarKind tv'))
bindIfaceTyConBinderX bind_tv (IfaceNamed (IfaceTv tv vis)) thing_inside
= bind_tv tv $ \tv' ->
- thing_inside tv' (Named tv' vis)
+ thing_inside tv' (Named (mkTyVarBinder vis tv'))
View Lorry Controller Status