Permalink
Browse files

Revise implementation of overlapping type family instances.

This commit changes the syntax and story around overlapping type
family instances. Before, we had "unbranched" instances and
"branched" instances. Now, we have closed type families and
open ones.

The behavior of open families is completely unchanged. In particular,
coincident overlap of open type family instances still works, despite
emails to the contrary.

A closed type family is declared like this:
> type family F a where
>   F Int = Bool
>   F a   = Char
The equations are tried in order, from top to bottom, subject to
certain constraints, as described in the user manual. It is not
allowed to declare an instance of a closed family.
  • Loading branch information...
Richard Eisenberg
Richard Eisenberg committed Jun 21, 2013
1 parent 11db9cf commit 569b26526403df4d88fe2a6d64c7dade09d003ad
Showing with 1,428 additions and 1,165 deletions.
  1. +1 −1 compiler/coreSyn/CoreLint.lhs
  2. +76 −41 compiler/deSugar/DsMeta.hs
  3. +10 −5 compiler/hsSyn/Convert.lhs
  4. +33 −39 compiler/hsSyn/HsDecls.lhs
  5. +14 −13 compiler/iface/BinIface.hs
  6. +1 −1 compiler/iface/BuildTyCl.lhs
  7. +1 −1 compiler/iface/IfaceEnv.lhs
  8. +51 −23 compiler/iface/IfaceSyn.lhs
  9. +1 −1 compiler/iface/IfaceType.lhs
  10. +29 −16 compiler/iface/MkIface.lhs
  11. +27 −17 compiler/iface/TcIface.lhs
  12. +2 −2 compiler/iface/TcIface.lhs-boot
  13. +3 −3 compiler/main/GHC.hs
  14. +1 −1 compiler/main/HscMain.hs
  15. +9 −7 compiler/main/HscTypes.lhs
  16. +2 −2 compiler/main/InteractiveEval.hs
  17. +9 −4 compiler/main/PprTyThing.hs
  18. +1 −1 compiler/main/TidyPgm.lhs
  19. +12 −9 compiler/parser/Parser.y.pp
  20. +12 −20 compiler/parser/RdrHsSyn.lhs
  21. +1 −0 compiler/prelude/TysPrim.lhs
  22. +20 −10 compiler/rename/RnSource.lhs
  23. +45 −56 compiler/typecheck/FamInst.lhs
  24. +9 −12 compiler/typecheck/TcDeriv.lhs
  25. +3 −2 compiler/typecheck/TcEnv.lhs
  26. +1 −2 compiler/typecheck/TcExpr.lhs
  27. +2 −3 compiler/typecheck/TcGenDeriv.lhs
  28. +4 −6 compiler/typecheck/TcGenGenerics.lhs
  29. +1 −1 compiler/typecheck/TcHsType.lhs
  30. +24 −46 compiler/typecheck/TcInstDcls.lhs
  31. +5 −10 compiler/typecheck/TcInteract.lhs
  32. +12 −16 compiler/typecheck/TcRnDriver.lhs
  33. +1 −1 compiler/typecheck/TcRnTypes.lhs
  34. +26 −3 compiler/typecheck/TcSMonad.lhs
  35. +34 −33 compiler/typecheck/TcSplice.lhs
  36. +115 −47 compiler/typecheck/TcTyClsDecls.lhs
  37. +17 −1 compiler/typecheck/TcValidity.lhs
  38. +61 −23 compiler/types/CoAxiom.lhs
  39. +3 −57 compiler/types/Coercion.lhs
  40. +431 −445 compiler/types/FamInstEnv.lhs
  41. +12 −11 compiler/types/OptCoercion.lhs
  42. +46 −26 compiler/types/TyCon.lhs
  43. +74 −36 compiler/types/Unify.lhs
  44. +1 −2 compiler/vectorise/Vectorise.hs
  45. +1 −1 compiler/vectorise/Vectorise/Env.hs
  46. +2 −2 compiler/vectorise/Vectorise/Generic/PAMethods.hs
  47. +4 −5 compiler/vectorise/Vectorise/Generic/PData.hs
  48. +1 −1 compiler/vectorise/Vectorise/Monad/InstEnv.hs
  49. +1 −1 compiler/vectorise/Vectorise/Type/Env.hs
  50. +1 −5 compiler/vectorise/Vectorise/Utils/Base.hs
  51. +1 −1 compiler/vectorise/Vectorise/Utils/PADict.hs
  52. +24 −8 docs/core-spec/CoreLint.ott
  53. +3 −1 docs/core-spec/CoreSyn.ott
  54. +1 −0 docs/core-spec/Makefile
  55. +14 −1 docs/core-spec/core-spec.mng
  56. BIN docs/core-spec/core-spec.pdf
  57. +130 −81 docs/users_guide/glasgow_exts.xml
  58. +2 −2 ghc/InteractiveUI.hs
@@ -939,7 +939,7 @@ lintCoercion co@(AxiomInstCo con ind cos)
; let lhs' = Type.substTys subst_l lhs
rhs' = Type.substTy subst_r rhs
; case checkAxInstCo co of
Just bad_index -> bad_ax $ ptext (sLit "inconsistent with") <+> (ppr bad_index)
Just bad_branch -> bad_ax $ ptext (sLit "inconsistent with") <+> (pprCoAxBranch (coAxiomTyCon con) bad_branch)
Nothing -> return ()
; return (typeKind rhs', mkTyConApp (coAxiomTyCon con) lhs', rhs') }
where
@@ -258,18 +258,29 @@ repSynDecl tc bndrs ty
; repTySyn tc bndrs ty1 }

repFamilyDecl :: LFamilyDecl Name -> DsM (SrcSpan, Core TH.DecQ)
repFamilyDecl (L loc (FamilyDecl { fdFlavour = flavour,
repFamilyDecl (L loc (FamilyDecl { fdInfo = info,
fdLName = tc,
fdTyVars = tvs,
fdKindSig = opt_kind }))
= do { tc1 <- lookupLOcc tc -- See note [Binders and occurrences]
; dec <- addTyClTyVarBinds tvs $ \bndrs ->
do { flav <- repFamilyFlavour flavour
; case opt_kind of
Nothing -> repFamilyNoKind flav tc1 bndrs
Just ki -> do { ki1 <- repLKind ki
; repFamilyKind flav tc1 bndrs ki1 }
}
case (opt_kind, info) of
(Nothing, ClosedTypeFamily eqns) ->
do { eqns1 <- mapM repTyFamEqn eqns
; eqns2 <- coreList tySynEqnQTyConName eqns1
; repClosedFamilyNoKind tc1 bndrs eqns2 }
(Just ki, ClosedTypeFamily eqns) ->
do { eqns1 <- mapM repTyFamEqn eqns
; eqns2 <- coreList tySynEqnQTyConName eqns1
; ki1 <- repLKind ki
; repClosedFamilyKind tc1 bndrs ki1 eqns2 }
(Nothing, _) ->
do { info' <- repFamilyInfo info
; repFamilyNoKind info' tc1 bndrs }
(Just ki, _) ->
do { info' <- repFamilyInfo info
; ki1 <- repLKind ki
; repFamilyKind info' tc1 bndrs ki1 }
; return (loc, dec)
}

@@ -317,9 +328,10 @@ repLFunDep (L _ (xs, ys)) = do xs' <- repList nameTyConName lookupBinder xs

-- represent family declaration flavours
--
repFamilyFlavour :: FamilyFlavour -> DsM (Core TH.FamFlavour)
repFamilyFlavour TypeFamily = rep2 typeFamName []
repFamilyFlavour DataFamily = rep2 dataFamName []
repFamilyInfo :: FamilyInfo Name -> DsM (Core TH.FamFlavour)
repFamilyInfo OpenTypeFamily = rep2 typeFamName []
repFamilyInfo DataFamily = rep2 dataFamName []
repFamilyInfo ClosedTypeFamily {} = panic "repFamilyInfo"

-- Represent instance declarations
--
@@ -362,12 +374,11 @@ repClsInstD (ClsInstDecl { cid_poly_ty = ty, cid_binds = binds
Just (tvs, cxt, cls, tys) = splitLHsInstDeclTy_maybe ty

repTyFamInstD :: TyFamInstDecl Name -> DsM (Core TH.DecQ)
repTyFamInstD decl@(TyFamInstDecl { tfid_eqns = eqns })
repTyFamInstD decl@(TyFamInstDecl { tfid_eqn = eqn })
= do { let tc_name = tyFamInstDeclLName decl
; tc <- lookupLOcc tc_name -- See note [Binders and occurrences]
; eqns1 <- mapM repTyFamEqn eqns
; eqns2 <- coreList tySynEqnQTyConName eqns1
; repTySynInst tc eqns2 }
; tc <- lookupLOcc tc_name -- See note [Binders and occurrences]
; eqn1 <- repTyFamEqn eqn
; repTySynInst tc eqn1 }

repTyFamEqn :: LTyFamInstEqn Name -> DsM (Core TH.TySynEqnQ)
repTyFamEqn (L loc (TyFamInstEqn { tfie_pats = HsWB { hswb_cts = tys
@@ -1688,9 +1699,24 @@ repFamilyKind :: Core TH.FamFlavour -> Core TH.Name -> Core [TH.TyVarBndr]
repFamilyKind (MkC flav) (MkC nm) (MkC tvs) (MkC ki)
= rep2 familyKindDName [flav, nm, tvs, ki]

repTySynInst :: Core TH.Name -> Core [TH.TySynEqnQ] -> DsM (Core TH.DecQ)
repTySynInst (MkC nm) (MkC eqns)
= rep2 tySynInstDName [nm, eqns]
repTySynInst :: Core TH.Name -> Core TH.TySynEqnQ -> DsM (Core TH.DecQ)
repTySynInst (MkC nm) (MkC eqn)
= rep2 tySynInstDName [nm, eqn]

repClosedFamilyNoKind :: Core TH.Name
-> Core [TH.TyVarBndr]
-> Core [TH.TySynEqnQ]
-> DsM (Core TH.DecQ)
repClosedFamilyNoKind (MkC nm) (MkC tvs) (MkC eqns)
= rep2 closedTypeFamilyNoKindDName [nm, tvs, eqns]

repClosedFamilyKind :: Core TH.Name
-> Core [TH.TyVarBndr]
-> Core TH.Kind
-> Core [TH.TySynEqnQ]
-> DsM (Core TH.DecQ)
repClosedFamilyKind (MkC nm) (MkC tvs) (MkC ki) (MkC eqns)
= rep2 closedTypeFamilyKindDName [nm, tvs, ki, eqns]

repTySynEqn :: Core [TH.TypeQ] -> Core TH.TypeQ -> DsM (Core TH.TySynEqnQ)
repTySynEqn (MkC lhs) (MkC rhs)
@@ -1994,7 +2020,8 @@ templateHaskellNames = [
pragInlDName, pragSpecDName, pragSpecInlDName, pragSpecInstDName,
pragRuleDName,
familyNoKindDName, familyKindDName, dataInstDName, newtypeInstDName,
tySynInstDName, infixLDName, infixRDName, infixNDName,
tySynInstDName, closedTypeFamilyKindDName, closedTypeFamilyNoKindDName,
infixLDName, infixRDName, infixNDName,
-- Cxt
cxtName,
-- Pred
@@ -2207,6 +2234,7 @@ funDName, valDName, dataDName, newtypeDName, tySynDName, classDName,
instanceDName, sigDName, forImpDName, pragInlDName, pragSpecDName,
pragSpecInlDName, pragSpecInstDName, pragRuleDName, familyNoKindDName,
familyKindDName, dataInstDName, newtypeInstDName, tySynInstDName,
closedTypeFamilyKindDName, closedTypeFamilyNoKindDName,
infixLDName, infixRDName, infixNDName :: Name
funDName = libFun (fsLit "funD") funDIdKey
valDName = libFun (fsLit "valD") valDIdKey
@@ -2227,6 +2255,10 @@ familyKindDName = libFun (fsLit "familyKindD") familyKindDIdKey
dataInstDName = libFun (fsLit "dataInstD") dataInstDIdKey
newtypeInstDName = libFun (fsLit "newtypeInstD") newtypeInstDIdKey
tySynInstDName = libFun (fsLit "tySynInstD") tySynInstDIdKey
closedTypeFamilyKindDName
= libFun (fsLit "closedTypeFamilyKindD") closedTypeFamilyKindDIdKey
closedTypeFamilyNoKindDName
= libFun (fsLit "closedTypeFamilyNoKindD") closedTypeFamilyNoKindDIdKey
infixLDName = libFun (fsLit "infixLD") infixLDIdKey
infixRDName = libFun (fsLit "infixRD") infixRDIdKey
infixNDName = libFun (fsLit "infixND") infixNDIdKey
@@ -2543,29 +2575,32 @@ funDIdKey, valDIdKey, dataDIdKey, newtypeDIdKey, tySynDIdKey,
pragSpecDIdKey, pragSpecInlDIdKey, pragSpecInstDIdKey, pragRuleDIdKey,
familyNoKindDIdKey, familyKindDIdKey,
dataInstDIdKey, newtypeInstDIdKey, tySynInstDIdKey,
closedTypeFamilyKindDIdKey, closedTypeFamilyNoKindDIdKey,
infixLDIdKey, infixRDIdKey, infixNDIdKey :: Unique
funDIdKey = mkPreludeMiscIdUnique 330
valDIdKey = mkPreludeMiscIdUnique 331
dataDIdKey = mkPreludeMiscIdUnique 332
newtypeDIdKey = mkPreludeMiscIdUnique 333
tySynDIdKey = mkPreludeMiscIdUnique 334
classDIdKey = mkPreludeMiscIdUnique 335
instanceDIdKey = mkPreludeMiscIdUnique 336
sigDIdKey = mkPreludeMiscIdUnique 337
forImpDIdKey = mkPreludeMiscIdUnique 338
pragInlDIdKey = mkPreludeMiscIdUnique 339
pragSpecDIdKey = mkPreludeMiscIdUnique 340
pragSpecInlDIdKey = mkPreludeMiscIdUnique 341
pragSpecInstDIdKey = mkPreludeMiscIdUnique 412
pragRuleDIdKey = mkPreludeMiscIdUnique 413
familyNoKindDIdKey = mkPreludeMiscIdUnique 342
familyKindDIdKey = mkPreludeMiscIdUnique 343
dataInstDIdKey = mkPreludeMiscIdUnique 344
newtypeInstDIdKey = mkPreludeMiscIdUnique 345
tySynInstDIdKey = mkPreludeMiscIdUnique 346
infixLDIdKey = mkPreludeMiscIdUnique 347
infixRDIdKey = mkPreludeMiscIdUnique 348
infixNDIdKey = mkPreludeMiscIdUnique 349
funDIdKey = mkPreludeMiscIdUnique 330
valDIdKey = mkPreludeMiscIdUnique 331
dataDIdKey = mkPreludeMiscIdUnique 332
newtypeDIdKey = mkPreludeMiscIdUnique 333
tySynDIdKey = mkPreludeMiscIdUnique 334
classDIdKey = mkPreludeMiscIdUnique 335
instanceDIdKey = mkPreludeMiscIdUnique 336
sigDIdKey = mkPreludeMiscIdUnique 337
forImpDIdKey = mkPreludeMiscIdUnique 338
pragInlDIdKey = mkPreludeMiscIdUnique 339
pragSpecDIdKey = mkPreludeMiscIdUnique 340
pragSpecInlDIdKey = mkPreludeMiscIdUnique 341
pragSpecInstDIdKey = mkPreludeMiscIdUnique 412
pragRuleDIdKey = mkPreludeMiscIdUnique 413
familyNoKindDIdKey = mkPreludeMiscIdUnique 342
familyKindDIdKey = mkPreludeMiscIdUnique 343
dataInstDIdKey = mkPreludeMiscIdUnique 344
newtypeInstDIdKey = mkPreludeMiscIdUnique 345
tySynInstDIdKey = mkPreludeMiscIdUnique 346
closedTypeFamilyKindDIdKey = mkPreludeMiscIdUnique 347
closedTypeFamilyNoKindDIdKey = mkPreludeMiscIdUnique 348
infixLDIdKey = mkPreludeMiscIdUnique 349
infixRDIdKey = mkPreludeMiscIdUnique 350
infixNDIdKey = mkPreludeMiscIdUnique 351

-- type Cxt = ...
cxtIdKey :: Unique
@@ -215,7 +215,7 @@ cvtDec (FamilyD flav tc tvs kind)
; kind' <- cvtMaybeKind kind
; returnL $ TyClD (FamDecl (FamilyDecl (cvtFamFlavour flav) tc' tvs' kind')) }
where
cvtFamFlavour TypeFam = TypeFamily
cvtFamFlavour TypeFam = OpenTypeFamily
cvtFamFlavour DataFam = DataFamily
cvtDec (DataInstD ctxt tc tys constrs derivs)
@@ -243,13 +243,18 @@ cvtDec (NewtypeInstD ctxt tc tys constr derivs)
{ dfid_inst = DataFamInstDecl { dfid_tycon = tc', dfid_pats = typats'
, dfid_defn = defn, dfid_fvs = placeHolderNames } }}
cvtDec (TySynInstD tc eqns)
cvtDec (TySynInstD tc eqn)
= do { tc' <- tconNameL tc
; eqns' <- mapM (cvtTySynEqn tc') eqns
; eqn' <- cvtTySynEqn tc' eqn
; returnL $ InstD $ TyFamInstD
{ tfid_inst = TyFamInstDecl { tfid_eqns = eqns'
, tfid_group = (length eqns' /= 1)
{ tfid_inst = TyFamInstDecl { tfid_eqn = eqn'
, tfid_fvs = placeHolderNames } } }
cvtDec (ClosedTypeFamilyD tc tyvars mkind eqns)
= do { (_, tc', tvs') <- cvt_tycl_hdr [] tc tyvars
; mkind' <- cvtMaybeKind mkind
; eqns' <- mapM (cvtTySynEqn tc') eqns
; returnL $ TyClD (FamDecl (FamilyDecl (ClosedTypeFamily eqns') tc' tvs' mkind')) }
----------------
cvtTySynEqn :: Located RdrName -> TySynEqn -> CvtM (LTyFamInstEqn RdrName)
cvtTySynEqn tc (TySynEqn lhs rhs)
@@ -24,7 +24,7 @@ module HsDecls (
FamilyDecl(..), LFamilyDecl,
-- ** Instance declarations
InstDecl(..), LInstDecl, NewOrData(..), FamilyFlavour(..),
InstDecl(..), LInstDecl, NewOrData(..), FamilyInfo(..),
TyFamInstDecl(..), LTyFamInstDecl, instDeclDataFamInsts,
DataFamInstDecl(..), LDataFamInstDecl, pprDataFamInstFlavour,
TyFamInstEqn(..), LTyFamInstEqn,
@@ -470,16 +470,17 @@ data TyClDecl name
type LFamilyDecl name = Located (FamilyDecl name)
data FamilyDecl name = FamilyDecl
{ fdFlavour :: FamilyFlavour -- type or data
{ fdInfo :: FamilyInfo name -- type or data, closed or open
, fdLName :: Located name -- type constructor
, fdTyVars :: LHsTyVarBndrs name -- type variables
, fdKindSig :: Maybe (LHsKind name) } -- result kind
deriving( Data, Typeable )
data FamilyFlavour
= TypeFamily
| DataFamily
deriving( Data, Typeable, Eq )
data FamilyInfo name
= DataFamily
| OpenTypeFamily
| ClosedTypeFamily [LTyFamInstEqn name]
deriving( Data, Typeable )
\end{code}

@@ -510,12 +511,15 @@ isFamilyDecl _other = False
-- | type family declaration
isTypeFamilyDecl :: TyClDecl name -> Bool
isTypeFamilyDecl (FamDecl d) = fdFlavour d == TypeFamily
isTypeFamilyDecl _other = False
isTypeFamilyDecl (FamDecl (FamilyDecl { fdInfo = info })) = case info of
OpenTypeFamily -> True
ClosedTypeFamily {} -> True
_ -> False
isTypeFamilyDecl _ = False
-- | data family declaration
isDataFamilyDecl :: TyClDecl name -> Bool
isDataFamilyDecl (FamDecl d) = fdFlavour d == DataFamily
isDataFamilyDecl (FamDecl (FamilyDecl { fdInfo = DataFamily })) = True
isDataFamilyDecl _other = False
\end{code}

@@ -528,11 +532,9 @@ tyFamInstDeclName = unLoc . tyFamInstDeclLName
tyFamInstDeclLName :: OutputableBndr name
=> TyFamInstDecl name -> Located name
tyFamInstDeclLName (TyFamInstDecl { tfid_eqns =
(L _ (TyFamInstEqn { tfie_tycon = ln })) : _ })
-- there may be more than one equation, but grab the name from the first
tyFamInstDeclLName (TyFamInstDecl { tfid_eqn =
(L _ (TyFamInstEqn { tfie_tycon = ln })) })
= ln
tyFamInstDeclLName decl = pprPanic "tyFamInstDeclLName" (ppr decl)
tyClDeclLName :: TyClDecl name -> Located name
tyClDeclLName (FamDecl { tcdFam = FamilyDecl { fdLName = ln } }) = ln
@@ -598,17 +600,26 @@ instance OutputableBndr name
<+> pprFundeps (map unLoc fds)
instance (OutputableBndr name) => Outputable (FamilyDecl name) where
ppr (FamilyDecl { fdFlavour = flavour, fdLName = ltycon,
ppr (FamilyDecl { fdInfo = info, fdLName = ltycon,
fdTyVars = tyvars, fdKindSig = mb_kind})
= ppr flavour <+> pp_vanilla_decl_head ltycon tyvars [] <+> pp_kind
= vcat [ pprFlavour info <+> pp_vanilla_decl_head ltycon tyvars [] <+> pp_kind <+> pp_where
, nest 2 $ pp_eqns ]
where
pp_kind = case mb_kind of
Nothing -> empty
Just kind -> dcolon <+> ppr kind
(pp_where, pp_eqns) = case info of
ClosedTypeFamily eqns -> ( ptext (sLit "where")
, vcat $ map ppr eqns )
_ -> (empty, empty)
pprFlavour :: FamilyInfo name -> SDoc
pprFlavour DataFamily = ptext (sLit "data family")
pprFlavour OpenTypeFamily = ptext (sLit "type family")
pprFlavour (ClosedTypeFamily {}) = ptext (sLit "type family")
instance Outputable FamilyFlavour where
ppr TypeFamily = ptext (sLit "type family")
ppr DataFamily = ptext (sLit "data family")
instance Outputable (FamilyInfo name) where
ppr = pprFlavour
pp_vanilla_decl_head :: OutputableBndr name
=> Located name
@@ -838,10 +849,9 @@ pprConDecl decl@(ConDecl { con_details = InfixCon ty1 ty2, con_res = ResTyGADT {
\begin{code}
----------------- Type synonym family instances -------------
-- See note [Family instance equation groups]
type LTyFamInstEqn name = Located (TyFamInstEqn name)
-- | One equation in a family instance declaration
-- | One equation in a type family instance declaration
data TyFamInstEqn name
= TyFamInstEqn
{ tfie_tycon :: Located name
@@ -854,15 +864,10 @@ data TyFamInstEqn name
type LTyFamInstDecl name = Located (TyFamInstDecl name)
data TyFamInstDecl name
= TyFamInstDecl
{ tfid_eqns :: [LTyFamInstEqn name] -- ^ list of (possibly-overlapping) eqns
-- Always non-empty
, tfid_group :: Bool -- Was this declared with the "where" syntax?
, tfid_fvs :: NameSet } -- The group is type-checked as one,
-- so one NameSet will do
-- INVARIANT: tfid_group == False --> length tfid_eqns == 1
{ tfid_eqn :: LTyFamInstEqn name
, tfid_fvs :: NameSet }
deriving( Typeable, Data )
----------------- Data family instances -------------
type LDataFamInstDecl name = Located (DataFamInstDecl name)
@@ -925,24 +930,13 @@ tvs are fv(pat_tys), *including* ones that are already in scope
so that we can compare the type patter in the 'instance' decl and
in the associated 'type' decl

Note [Family instance equation groups]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
A TyFamInstDecl contains a list of FamInstEqn's, one for each
equation defined in the instance group. For a standalone
instance declaration, this list contains exactly one element.
It is not possible for this list to have 0 elements --
'type instance where' without anything else is not allowed.

\begin{code}
instance (OutputableBndr name) => Outputable (TyFamInstDecl name) where
ppr = pprTyFamInstDecl TopLevel
pprTyFamInstDecl :: OutputableBndr name => TopLevelFlag -> TyFamInstDecl name -> SDoc
pprTyFamInstDecl top_lvl (TyFamInstDecl { tfid_group = False, tfid_eqns = [eqn] })
pprTyFamInstDecl top_lvl (TyFamInstDecl { tfid_eqn = eqn })
= ptext (sLit "type") <+> ppr_instance_keyword top_lvl <+> (ppr eqn)
pprTyFamInstDecl top_lvl (TyFamInstDecl { tfid_eqns = eqns })
= hang (ptext (sLit "type") <+> ppr_instance_keyword top_lvl <+> ptext (sLit "where"))
2 (vcat (map ppr eqns))
ppr_instance_keyword :: TopLevelFlag -> SDoc
ppr_instance_keyword TopLevel = ptext (sLit "instance")
Oops, something went wrong.

0 comments on commit 569b265

Please sign in to comment.