summaryrefslogtreecommitdiff
path: root/compiler/iface
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/iface')
-rw-r--r--compiler/iface/BinIface.hs18
-rw-r--r--compiler/iface/BuildTyCl.lhs18
-rw-r--r--compiler/iface/IfaceSyn.lhs25
-rw-r--r--compiler/iface/MkIface.lhs10
-rw-r--r--compiler/iface/TcIface.lhs14
5 files changed, 33 insertions, 52 deletions
diff --git a/compiler/iface/BinIface.hs b/compiler/iface/BinIface.hs
index 513bf2048b..13be0491c0 100644
--- a/compiler/iface/BinIface.hs
+++ b/compiler/iface/BinIface.hs
@@ -903,7 +903,7 @@ instance Binary IfaceDecl where
put_ bh idinfo
put_ bh (IfaceForeign ae af) =
error "Binary.put_(IfaceDecl): IfaceForeign"
- put_ bh (IfaceData a1 a2 a3 a4 a5 a6 a7 a8) = do
+ put_ bh (IfaceData a1 a2 a3 a4 a5 a6 a7) = do
putByte bh 2
put_ bh a1
put_ bh a2
@@ -912,15 +912,13 @@ instance Binary IfaceDecl where
put_ bh a5
put_ bh a6
put_ bh a7
- put_ bh a8
- put_ bh (IfaceSyn aq ar as at) = do
+ put_ bh (IfaceSyn aq ar as) = do
putByte bh 3
put_ bh aq
put_ bh ar
put_ bh as
- put_ bh at
- put_ bh (IfaceClass a1 a2 a3 a4 a5 a6 a7) = do
+ put_ bh (IfaceClass a1 a2 a3 a4 a5 a6) = do
putByte bh 4
put_ bh a1
put_ bh a2
@@ -928,7 +926,6 @@ instance Binary IfaceDecl where
put_ bh a4
put_ bh a5
put_ bh a6
- put_ bh a7
get bh = do
h <- getByte bh
case h of
@@ -945,14 +942,12 @@ instance Binary IfaceDecl where
a5 <- get bh
a6 <- get bh
a7 <- get bh
- a8 <- get bh
- return (IfaceData a1 a2 a3 a4 a5 a6 a7 a8)
+ return (IfaceData a1 a2 a3 a4 a5 a6 a7)
3 -> do
aq <- get bh
ar <- get bh
as <- get bh
- at <- get bh
- return (IfaceSyn aq ar as at)
+ return (IfaceSyn aq ar as)
_ -> do
a1 <- get bh
a2 <- get bh
@@ -960,8 +955,7 @@ instance Binary IfaceDecl where
a4 <- get bh
a5 <- get bh
a6 <- get bh
- a7 <- get bh
- return (IfaceClass a1 a2 a3 a4 a5 a6 a7)
+ return (IfaceClass a1 a2 a3 a4 a5 a6)
instance Binary IfaceInst where
put_ bh (IfaceInst cls tys dfun flag orph) = do
diff --git a/compiler/iface/BuildTyCl.lhs b/compiler/iface/BuildTyCl.lhs
index 5c76d55ab6..e4c392b6a5 100644
--- a/compiler/iface/BuildTyCl.lhs
+++ b/compiler/iface/BuildTyCl.lhs
@@ -29,7 +29,7 @@ import Class ( mkClass, Class( classTyCon), FunDep, DefMeth(..) )
import TyCon ( mkSynTyCon, mkAlgTyCon, visibleDataCons, tyConStupidTheta,
tyConDataCons, isNewTyCon, mkClassTyCon, TyCon( tyConTyVars ),
isRecursiveTyCon, tyConArity,
- ArgVrcs, AlgTyConRhs(..), newTyConRhs )
+ AlgTyConRhs(..), newTyConRhs )
import Type ( mkArrowKinds, liftedTypeKind, typeKind,
tyVarsOfType, tyVarsOfTypes, tyVarsOfPred,
splitTyConApp_maybe, splitAppTy_maybe, getTyVar_maybe,
@@ -45,8 +45,8 @@ import List ( nub )
\begin{code}
------------------------------------------------------
-buildSynTyCon name tvs rhs_ty arg_vrcs
- = mkSynTyCon name kind tvs rhs_ty arg_vrcs
+buildSynTyCon name tvs rhs_ty
+ = mkSynTyCon name kind tvs rhs_ty
where
kind = mkArrowKinds (map tyVarKind tvs) (typeKind rhs_ty)
@@ -55,13 +55,13 @@ buildSynTyCon name tvs rhs_ty arg_vrcs
buildAlgTyCon :: Name -> [TyVar]
-> ThetaType -- Stupid theta
-> AlgTyConRhs
- -> ArgVrcs -> RecFlag
+ -> RecFlag
-> Bool -- True <=> want generics functions
-> Bool -- True <=> was declared in GADT syntax
-> TcRnIf m n TyCon
-buildAlgTyCon tc_name tvs stupid_theta rhs arg_vrcs is_rec want_generics gadt_syn
- = do { let { tycon = mkAlgTyCon tc_name kind tvs arg_vrcs stupid_theta
+buildAlgTyCon tc_name tvs stupid_theta rhs is_rec want_generics gadt_syn
+ = do { let { tycon = mkAlgTyCon tc_name kind tvs stupid_theta
rhs fields is_rec want_generics gadt_syn
; kind = mkArrowKinds (map tyVarKind tvs) liftedTypeKind
; fields = mkTyConSelIds tycon rhs
@@ -207,10 +207,10 @@ mkTyConSelIds tycon rhs
buildClass :: Name -> [TyVar] -> ThetaType
-> [FunDep TyVar] -- Functional dependencies
-> [(Name, DefMeth, Type)] -- Method info
- -> RecFlag -> ArgVrcs -- Info for type constructor
+ -> RecFlag -- Info for type constructor
-> TcRnIf m n Class
-buildClass class_name tvs sc_theta fds sig_stuff tc_isrec tc_vrcs
+buildClass class_name tvs sc_theta fds sig_stuff tc_isrec
= do { tycon_name <- newImplicitBinder class_name mkClassTyConOcc
; datacon_name <- newImplicitBinder class_name mkClassDataConOcc
-- The class name is the 'parent' for this datacon, not its tycon,
@@ -253,7 +253,7 @@ buildClass class_name tvs sc_theta fds sig_stuff tc_isrec tc_vrcs
; let { clas_kind = mkArrowKinds (map tyVarKind tvs) liftedTypeKind
; tycon = mkClassTyCon tycon_name clas_kind tvs
- tc_vrcs rhs rec_clas tc_isrec
+ rhs rec_clas tc_isrec
-- A class can be recursive, and in the case of newtypes
-- this matters. For example
-- class C a where { op :: C b => a -> b -> Int }
diff --git a/compiler/iface/IfaceSyn.lhs b/compiler/iface/IfaceSyn.lhs
index ec5d54413f..e01cc312f6 100644
--- a/compiler/iface/IfaceSyn.lhs
+++ b/compiler/iface/IfaceSyn.lhs
@@ -38,7 +38,6 @@ import IfaceType
import NewDemand ( StrictSig, pprIfaceStrictSig )
import TcType ( deNoteType )
import Class ( FunDep, DefMeth, pprFundeps )
-import TyCon ( ArgVrcs )
import OccName ( OccName, parenSymOcc, occNameFS,
OccSet, unionOccSets, unitOccSet )
import UniqFM ( UniqFM, emptyUFM, addToUFM, lookupUFM )
@@ -76,7 +75,6 @@ data IfaceDecl
ifCtxt :: IfaceContext, -- The "stupid theta"
ifCons :: IfaceConDecls, -- Includes new/data info
ifRec :: RecFlag, -- Recursive or not?
- ifVrcs :: ArgVrcs,
ifGadtSyntax :: Bool, -- True <=> declared using GADT syntax
ifGeneric :: Bool -- True <=> generic converter functions available
} -- We need this for imported data decls, since the
@@ -85,7 +83,6 @@ data IfaceDecl
| IfaceSyn { ifName :: OccName, -- Type constructor
ifTyVars :: [IfaceTvBndr], -- Type variables
- ifVrcs :: ArgVrcs,
ifSynRhs :: IfaceType -- synonym expansion
}
@@ -94,8 +91,7 @@ data IfaceDecl
ifTyVars :: [IfaceTvBndr], -- Type variables
ifFDs :: [FunDep FastString], -- Functional dependencies
ifSigs :: [IfaceClassOp], -- Method signatures
- ifRec :: RecFlag, -- Is newtype/datatype associated with the class recursive?
- ifVrcs :: ArgVrcs -- ... and what are its argument variances ...
+ ifRec :: RecFlag -- Is newtype/datatype associated with the class recursive?
}
| IfaceForeign { ifName :: OccName, -- Needs expanding when we move beyond .NET
@@ -233,16 +229,15 @@ pprIfaceDecl (IfaceId {ifName = var, ifType = ty, ifIdInfo = info})
pprIfaceDecl (IfaceForeign {ifName = tycon})
= hsep [ptext SLIT("foreign import type dotnet"), ppr tycon]
-pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars, ifSynRhs = mono_ty, ifVrcs = vrcs})
+pprIfaceDecl (IfaceSyn {ifName = tycon, ifTyVars = tyvars, ifSynRhs = mono_ty})
= hang (ptext SLIT("type") <+> pprIfaceDeclHead [] tycon tyvars)
- 4 (vcat [equals <+> ppr mono_ty,
- pprVrcs vrcs])
+ 4 (equals <+> ppr mono_ty)
pprIfaceDecl (IfaceData {ifName = tycon, ifGeneric = gen, ifCtxt = context,
ifTyVars = tyvars, ifCons = condecls,
- ifRec = isrec, ifVrcs = vrcs})
+ ifRec = isrec})
= hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars)
- 4 (vcat [pprVrcs vrcs, pprRec isrec, pprGen gen, pp_condecls tycon condecls])
+ 4 (vcat [pprRec isrec, pprGen gen, pp_condecls tycon condecls])
where
pp_nd = case condecls of
IfAbstractTyCon -> ptext SLIT("data")
@@ -250,13 +245,11 @@ pprIfaceDecl (IfaceData {ifName = tycon, ifGeneric = gen, ifCtxt = context,
IfNewTyCon _ -> ptext SLIT("newtype")
pprIfaceDecl (IfaceClass {ifCtxt = context, ifName = clas, ifTyVars = tyvars,
- ifFDs = fds, ifSigs = sigs, ifVrcs = vrcs, ifRec = isrec})
+ ifFDs = fds, ifSigs = sigs, ifRec = isrec})
= hang (ptext SLIT("class") <+> pprIfaceDeclHead context clas tyvars <+> pprFundeps fds)
- 4 (vcat [pprVrcs vrcs,
- pprRec isrec,
+ 4 (vcat [pprRec isrec,
sep (map ppr sigs)])
-pprVrcs vrcs = ptext SLIT("Variances") <+> ppr vrcs
pprRec isrec = ptext SLIT("RecFlag") <+> ppr isrec
pprGen True = ptext SLIT("Generics: yes")
pprGen False = ptext SLIT("Generics: no")
@@ -514,7 +507,6 @@ eqIfDecl d1@(IfaceForeign {}) d2@(IfaceForeign {})
eqIfDecl d1@(IfaceData {}) d2@(IfaceData {})
= bool (ifName d1 == ifName d2 &&
ifRec d1 == ifRec d2 &&
- ifVrcs d1 == ifVrcs d2 &&
ifGadtSyntax d1 == ifGadtSyntax d2 &&
ifGeneric d1 == ifGeneric d2) &&&
eqWith (ifTyVars d1) (ifTyVars d2) (\ env ->
@@ -533,8 +525,7 @@ eqIfDecl d1@(IfaceSyn {}) d2@(IfaceSyn {})
eqIfDecl d1@(IfaceClass {}) d2@(IfaceClass {})
= bool (ifName d1 == ifName d2 &&
- ifRec d1 == ifRec d2 &&
- ifVrcs d1 == ifVrcs d2) &&&
+ ifRec d1 == ifRec d2) &&&
eqWith (ifTyVars d1) (ifTyVars d2) (\ env ->
eq_ifContext env (ifCtxt d1) (ifCtxt d2) &&&
eqListBy (eq_hsFD env) (ifFDs d1) (ifFDs d2) &&&
diff --git a/compiler/iface/MkIface.lhs b/compiler/iface/MkIface.lhs
index 656ba36180..be6b8ec0b2 100644
--- a/compiler/iface/MkIface.lhs
+++ b/compiler/iface/MkIface.lhs
@@ -186,7 +186,7 @@ import Class ( classExtraBigSig, classTyCon )
import TyCon ( TyCon, AlgTyConRhs(..), isRecursiveTyCon, isForeignTyCon,
isSynTyCon, isAlgTyCon, isPrimTyCon, isFunTyCon,
isTupleTyCon, tupleTyConBoxity, tyConStupidTheta,
- tyConHasGenerics, tyConArgVrcs, synTyConRhs, isGadtSyntaxTyCon,
+ tyConHasGenerics, synTyConRhs, isGadtSyntaxTyCon,
tyConArity, tyConTyVars, algTyConRhs, tyConExtName )
import DataCon ( dataConName, dataConFieldLabels, dataConStrictMarks,
dataConTyCon, dataConIsInfix, dataConUnivTyVars, dataConExTyVars, dataConEqSpec,
@@ -995,8 +995,7 @@ tyThingToIfaceDecl ext (AClass clas)
ifTyVars = toIfaceTvBndrs clas_tyvars,
ifFDs = map toIfaceFD clas_fds,
ifSigs = map toIfaceClassOp op_stuff,
- ifRec = boolToRecFlag (isRecursiveTyCon tycon),
- ifVrcs = tyConArgVrcs tycon }
+ ifRec = boolToRecFlag (isRecursiveTyCon tycon) }
where
(clas_tyvars, clas_fds, sc_theta, _, op_stuff) = classExtraBigSig clas
tycon = classTyCon clas
@@ -1019,7 +1018,6 @@ tyThingToIfaceDecl ext (ATyCon tycon)
| isSynTyCon tycon
= IfaceSyn { ifName = getOccName tycon,
ifTyVars = toIfaceTvBndrs tyvars,
- ifVrcs = tyConArgVrcs tycon,
ifSynRhs = toIfaceType ext syn_ty }
| isAlgTyCon tycon
@@ -1029,7 +1027,6 @@ tyThingToIfaceDecl ext (ATyCon tycon)
ifCons = ifaceConDecls (algTyConRhs tycon),
ifRec = boolToRecFlag (isRecursiveTyCon tycon),
ifGadtSyntax = isGadtSyntaxTyCon tycon,
- ifVrcs = tyConArgVrcs tycon,
ifGeneric = tyConHasGenerics tycon }
| isForeignTyCon tycon
@@ -1044,8 +1041,7 @@ tyThingToIfaceDecl ext (ATyCon tycon)
ifCons = IfAbstractTyCon,
ifGadtSyntax = False,
ifGeneric = False,
- ifRec = NonRecursive,
- ifVrcs = tyConArgVrcs tycon }
+ ifRec = NonRecursive}
| otherwise = pprPanic "toIfaceDecl" (ppr tycon)
where
diff --git a/compiler/iface/TcIface.lhs b/compiler/iface/TcIface.lhs
index 813467680b..04154ef3ac 100644
--- a/compiler/iface/TcIface.lhs
+++ b/compiler/iface/TcIface.lhs
@@ -354,7 +354,7 @@ tcIfaceDecl (IfaceData {ifName = occ_name,
ifTyVars = tv_bndrs,
ifCtxt = ctxt, ifGadtSyntax = gadt_syn,
ifCons = rdr_cons,
- ifVrcs = arg_vrcs, ifRec = is_rec,
+ ifRec = is_rec,
ifGeneric = want_generic })
= do { tc_name <- lookupIfaceTop occ_name
; bindIfaceTyVars tv_bndrs $ \ tyvars -> do
@@ -363,23 +363,23 @@ tcIfaceDecl (IfaceData {ifName = occ_name,
{ stupid_theta <- tcIfaceCtxt ctxt
; cons <- tcIfaceDataCons tc_name tycon tyvars rdr_cons
; buildAlgTyCon tc_name tyvars stupid_theta
- cons arg_vrcs is_rec want_generic gadt_syn
+ cons is_rec want_generic gadt_syn
})
; traceIf (text "tcIfaceDecl4" <+> ppr tycon)
; return (ATyCon tycon)
}}
tcIfaceDecl (IfaceSyn {ifName = occ_name, ifTyVars = tv_bndrs,
- ifSynRhs = rdr_rhs_ty, ifVrcs = arg_vrcs})
+ ifSynRhs = rdr_rhs_ty})
= bindIfaceTyVars tv_bndrs $ \ tyvars -> do
{ tc_name <- lookupIfaceTop occ_name
; rhs_ty <- tcIfaceType rdr_rhs_ty
- ; return (ATyCon (buildSynTyCon tc_name tyvars rhs_ty arg_vrcs))
+ ; return (ATyCon (buildSynTyCon tc_name tyvars rhs_ty))
}
tcIfaceDecl (IfaceClass {ifCtxt = rdr_ctxt, ifName = occ_name, ifTyVars = tv_bndrs,
ifFDs = rdr_fds, ifSigs = rdr_sigs,
- ifVrcs = tc_vrcs, ifRec = tc_isrec })
+ ifRec = tc_isrec })
-- ToDo: in hs-boot files we should really treat abstract classes specially,
-- as we do abstract tycons
= bindIfaceTyVars tv_bndrs $ \ tyvars -> do
@@ -387,7 +387,7 @@ tcIfaceDecl (IfaceClass {ifCtxt = rdr_ctxt, ifName = occ_name, ifTyVars = tv_bnd
; ctxt <- tcIfaceCtxt rdr_ctxt
; sigs <- mappM tc_sig rdr_sigs
; fds <- mappM tc_fd rdr_fds
- ; cls <- buildClass cls_name tyvars ctxt fds sigs tc_isrec tc_vrcs
+ ; cls <- buildClass cls_name tyvars ctxt fds sigs tc_isrec
; return (AClass cls) }
where
tc_sig (IfaceClassOp occ dm rdr_ty)
@@ -407,7 +407,7 @@ tcIfaceDecl (IfaceClass {ifCtxt = rdr_ctxt, ifName = occ_name, ifTyVars = tv_bnd
tcIfaceDecl (IfaceForeign {ifName = rdr_name, ifExtName = ext_name})
= do { name <- lookupIfaceTop rdr_name
; return (ATyCon (mkForeignTyCon name ext_name
- liftedTypeKind 0 [])) }
+ liftedTypeKind 0)) }
tcIfaceDataCons tycon_name tycon tc_tyvars if_cons
= case if_cons of
View Lorry Controller Status