\begin{code}
module TyCon(
- TyCon, KindCon, SuperKindCon,
+ TyCon, KindCon, SuperKindCon, ArgVrcs,
isFunTyCon, isUnLiftedTyCon, isBoxedTyCon, isProductTyCon,
isAlgTyCon, isDataTyCon, isSynTyCon, isNewTyCon, isPrimTyCon,
tyConKind,
tyConUnique,
tyConTyVars,
+ tyConArgVrcs_maybe,
tyConDataCons,
tyConFamilySize,
tyConDerivings,
tyConKind :: Kind,
tyConArity :: Arity,
- tyConTyVars :: [TyVar],
- dataTyConTheta :: [(Class,[Type])],
+ tyConTyVars :: [TyVar],
+ dataTyConTheta :: [(Class,[Type])],
+ dataTyConArgVrcs :: ArgVrcs,
dataCons :: [DataCon],
-- Its data constructors, with fully polymorphic types
tyConName :: Name,
tyConKind :: Kind,
tyConArity :: Arity,
+ primTyConArgVrcs :: ArgVrcs,
primTyConRep :: PrimRep
}
tyConKind :: Kind,
tyConArity :: Arity,
- tyConTyVars :: [TyVar], -- Bound tyvars
- synTyConDefn :: Type -- Right-hand side, mentioning these type vars.
+ tyConTyVars :: [TyVar], -- Bound tyvars
+ synTyConDefn :: Type, -- Right-hand side, mentioning these type vars.
-- Acts as a template for the expansion when
-- the tycon is applied to some types.
+ synTyConArgVrcs :: ArgVrcs
}
| KindCon { -- Type constructor at the kind level
tyConUnique :: Unique,
tyConName :: Name
}
+
+type ArgVrcs = [(Bool,Bool)] -- Tyvar variance info: [(occPos,occNeg)]
+ -- *NB*: this is tyvar variance info, *not*
+ -- termvar usage info.
\end{code}
%************************************************************************
tyConArity = 2
}
-mkAlgTyCon name kind tyvars theta cons derivs maybe_clas flavour rec
+mkAlgTyCon name kind tyvars theta argvrcs cons derivs maybe_clas flavour rec
= AlgTyCon {
tyConName = name,
tyConUnique = nameUnique name,
tyConArity = length tyvars,
tyConTyVars = tyvars,
dataTyConTheta = theta,
+ dataTyConArgVrcs = argvrcs,
dataCons = cons,
dataTyConDerivings = derivs,
dataTyConClass_maybe = maybe_clas,
dataCon = con
}
-mkPrimTyCon name kind arity rep
+mkPrimTyCon name kind arity arg_vrcs rep
= PrimTyCon {
tyConName = name,
tyConUnique = nameUnique name,
tyConKind = kind,
tyConArity = arity,
+ primTyConArgVrcs = arg_vrcs,
primTyConRep = rep
}
-mkSynTyCon name kind arity tyvars rhs
+mkSynTyCon name kind arity tyvars rhs argvrcs
= SynTyCon {
tyConName = name,
tyConUnique = nameUnique name,
tyConKind = kind,
tyConArity = arity,
tyConTyVars = tyvars,
- synTyConDefn = rhs
+ synTyConDefn = rhs,
+ synTyConArgVrcs = argvrcs
}
setTyConName tc name = tc {tyConName = name, tyConUnique = nameUnique name}
-- should ask about anything else
\end{code}
+@tyConArgVrcs_maybe@ gives a list of (occPos,occNeg) flags, one for
+each tyvar, if available. See @calcAlgTyConArgVrcs@ for how this is
+actually computed (in another file).
+
+\begin{code}
+tyConArgVrcs_maybe :: TyCon -> Maybe ArgVrcs
+
+tyConArgVrcs_maybe (FunTyCon {} ) = Just [(False,True),(True,False)]
+tyConArgVrcs_maybe (AlgTyCon {dataTyConArgVrcs = oi}) = Just oi
+tyConArgVrcs_maybe (PrimTyCon {primTyConArgVrcs = oi}) = Just oi
+tyConArgVrcs_maybe (TupleTyCon {tyConArity = arity }) = Just (replicate arity (True,False))
+tyConArgVrcs_maybe (SynTyCon {synTyConArgVrcs = oi }) = Just oi
+tyConArgVrcs_maybe _ = Nothing
+\end{code}
+
\begin{code}
getSynTyConDefn :: TyCon -> ([TyVar], Type)
getSynTyConDefn (SynTyCon {tyConTyVars = tyvars, synTyConDefn = ty}) = (tyvars,ty)
maybeTyConSingleCon (AlgTyCon {}) = Nothing
maybeTyConSingleCon (TupleTyCon {dataCon = con}) = Just con
maybeTyConSingleCon (PrimTyCon {}) = Nothing
-maybeTyConSingleCon other = panic (showSDoc (ppr other))
+maybeTyConSingleCon (FunTyCon {}) = Nothing -- case at funty
+maybeTyConSingleCon tc = pprPanic "maybeTyConSingleCon: unexpected tycon " $
+ ppr tc
\end{code}
\begin{code}