ifRec :: RecFlag, -- Recursive or not?
ifGadtSyntax :: Bool, -- True <=> declared using
-- GADT syntax
- ifGeneric :: Bool, -- True <=> generic converter
- -- functions available
- -- We need this for imported
- -- data decls, since the
- -- imported modules may have
- -- been compiled with
- -- different flags to the
- -- current compilation unit
ifFamInst :: Maybe (IfaceTyCon, [IfaceType])
-- Just <=> instance of family
-- Invariant:
= IfaceLcl IfLclName
| IfaceExt IfExtName
| IfaceType IfaceType
- | IfaceTuple Boxity [IfaceExpr] -- Saturated; type arguments omitted
- | IfaceLam IfaceBndr IfaceExpr
- | IfaceApp IfaceExpr IfaceExpr
- | IfaceCase IfaceExpr IfLclName IfaceType [IfaceAlt]
- | IfaceLet IfaceBinding IfaceExpr
- | IfaceNote IfaceNote IfaceExpr
+ | IfaceCo IfaceType -- We re-use IfaceType for coercions
+ | IfaceTuple Boxity [IfaceExpr] -- Saturated; type arguments omitted
+ | IfaceLam IfaceBndr IfaceExpr
+ | IfaceApp IfaceExpr IfaceExpr
+ | IfaceCase IfaceExpr IfLclName [IfaceAlt]
+ | IfaceLet IfaceBinding IfaceExpr
+ | IfaceNote IfaceNote IfaceExpr
| IfaceCast IfaceExpr IfaceCoercion
| IfaceLit Literal
| IfaceFCall ForeignCall IfaceType
= hang (ptext (sLit "type family") <+> pprIfaceDeclHead [] tycon tyvars)
4 (dcolon <+> ppr kind)
-pprIfaceDecl (IfaceData {ifName = tycon, ifGeneric = gen, ifCtxt = context,
+pprIfaceDecl (IfaceData {ifName = tycon, ifCtxt = context,
ifTyVars = tyvars, ifCons = condecls,
ifRec = isrec, ifFamInst = mbFamInst})
= hang (pp_nd <+> pprIfaceDeclHead context tycon tyvars)
- 4 (vcat [pprRec isrec, pprGen gen, pp_condecls tycon condecls,
+ 4 (vcat [pprRec isrec, pp_condecls tycon condecls,
pprFamily mbFamInst])
where
pp_nd = case condecls of
pprRec :: RecFlag -> SDoc
pprRec isrec = ptext (sLit "RecFlag") <+> ppr isrec
-pprGen :: Bool -> SDoc
-pprGen True = ptext (sLit "Generics: yes")
-pprGen False = ptext (sLit "Generics: no")
-
pprFamily :: Maybe (IfaceTyCon, [IfaceType]) -> SDoc
pprFamily Nothing = ptext (sLit "FamilyInstance: none")
pprFamily (Just famInst) = ptext (sLit "FamilyInstance:") <+> ppr famInst
pprIfaceExpr _ (IfaceFCall cc ty) = braces (ppr cc <+> ppr ty)
pprIfaceExpr _ (IfaceTick m ix) = braces (text "tick" <+> ppr m <+> ppr ix)
pprIfaceExpr _ (IfaceType ty) = char '@' <+> pprParendIfaceType ty
+pprIfaceExpr _ (IfaceCo co) = text "@~" <+> pprParendIfaceType co
pprIfaceExpr add_par app@(IfaceApp _ _) = add_par (pprIfaceApp app [])
pprIfaceExpr _ (IfaceTuple c as) = tupleParens c (interpp'SP as)
collect bs (IfaceLam b e) = collect (b:bs) e
collect bs e = (reverse bs, e)
-pprIfaceExpr add_par (IfaceCase scrut bndr ty [(con, bs, rhs)])
- = add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty
- <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
- <+> ppr bndr <+> char '{' <+> ppr_con_bs con bs <+> arrow,
- pprIfaceExpr noParens rhs <+> char '}'])
+pprIfaceExpr add_par (IfaceCase scrut bndr [(con, bs, rhs)])
+ = add_par (sep [ptext (sLit "case")
+ <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
+ <+> ppr bndr <+> char '{' <+> ppr_con_bs con bs <+> arrow,
+ pprIfaceExpr noParens rhs <+> char '}'])
-pprIfaceExpr add_par (IfaceCase scrut bndr ty alts)
- = add_par (sep [ptext (sLit "case") <+> char '@' <+> pprParendIfaceType ty
- <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
- <+> ppr bndr <+> char '{',
- nest 2 (sep (map ppr_alt alts)) <+> char '}'])
+pprIfaceExpr add_par (IfaceCase scrut bndr alts)
+ = add_par (sep [ptext (sLit "case")
+ <+> pprIfaceExpr noParens scrut <+> ptext (sLit "of")
+ <+> ppr bndr <+> char '{',
+ nest 2 (sep (map ppr_alt alts)) <+> char '}'])
pprIfaceExpr _ (IfaceCast expr co)
= sep [pprParendIfaceExpr expr,
freeNamesIfType (IfaceForAllTy tv t) =
freeNamesIfTvBndr tv &&& freeNamesIfType t
freeNamesIfType (IfaceFunTy s t) = freeNamesIfType s &&& freeNamesIfType t
+freeNamesIfType (IfaceCoConApp tc ts) =
+ freeNamesIfCo tc &&& fnList freeNamesIfType ts
freeNamesIfTvBndrs :: [IfaceTvBndr] -> NameSet
freeNamesIfTvBndrs = fnList freeNamesIfTvBndr
freeNamesIfExpr (IfaceExt v) = unitNameSet v
freeNamesIfExpr (IfaceFCall _ ty) = freeNamesIfType ty
freeNamesIfExpr (IfaceType ty) = freeNamesIfType ty
+freeNamesIfExpr (IfaceCo co) = freeNamesIfType co
freeNamesIfExpr (IfaceTuple _ as) = fnList freeNamesIfExpr as
freeNamesIfExpr (IfaceLam b body) = freeNamesIfBndr b &&& freeNamesIfExpr body
freeNamesIfExpr (IfaceApp f a) = freeNamesIfExpr f &&& freeNamesIfExpr a
freeNamesIfExpr (IfaceCast e co) = freeNamesIfExpr e &&& freeNamesIfType co
freeNamesIfExpr (IfaceNote _n r) = freeNamesIfExpr r
-freeNamesIfExpr (IfaceCase s _ ty alts)
- = freeNamesIfExpr s
+freeNamesIfExpr (IfaceCase s _ alts)
+ = freeNamesIfExpr s
&&& fnList fn_alt alts &&& fn_cons alts
- &&& freeNamesIfType ty
where
fn_alt (_con,_bs,r) = freeNamesIfExpr r
-- ToDo: shouldn't we include IfaceIntTc & co.?
freeNamesIfTc _ = emptyNameSet
+freeNamesIfCo :: IfaceCoCon -> NameSet
+freeNamesIfCo (IfaceCoAx tc) = unitNameSet tc
+freeNamesIfCo _ = emptyNameSet
+
freeNamesIfRule :: IfaceRule -> NameSet
freeNamesIfRule (IfaceRule { ifRuleBndrs = bs, ifRuleHead = f
, ifRuleArgs = es, ifRuleRhs = rhs })