Commit 44dc0aad authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Eta expand data family instances before printing them

Fixes Trac #8674
parent 9433f1da
......@@ -178,17 +178,30 @@ pprFamInst famInst
pprFamInstHdr :: FamInst -> SDoc
pprFamInstHdr fi@(FamInst {fi_flavor = flavor})
= pprTyConSort <+> pp_instance <+> pprHead
= pprTyConSort <+> pp_instance <+> pp_head
where
(fam_tc, tys) = famInstSplitLHS fi
-- For *associated* types, say "type T Int = blah"
-- For *top level* type instances, say "type instance T Int = blah"
pp_instance
| isTyConAssoc fam_tc = empty
| otherwise = ptext (sLit "instance")
pprHead = pprTypeApp fam_tc tys
(fam_tc, etad_lhs_tys) = famInstSplitLHS fi
vanilla_pp_head = pprTypeApp fam_tc etad_lhs_tys
pp_head | DataFamilyInst rep_tc <- flavor
, isAlgTyCon rep_tc
, let extra_tvs = dropList etad_lhs_tys (tyConTyVars rep_tc)
, not (null extra_tvs)
= getPprStyle $ \ sty ->
if debugStyle sty
then vanilla_pp_head -- With -dppr-debug just show it as-is
else pprTypeApp fam_tc (etad_lhs_tys ++ mkTyVarTys extra_tvs)
-- Without -dppr-debug, eta-expand
-- See Trac #8674
| otherwise
= vanilla_pp_head
pprTyConSort = case flavor of
SynFamilyInst -> ptext (sLit "type")
DataFamilyInst tycon
......@@ -199,7 +212,6 @@ pprFamInstHdr fi@(FamInst {fi_flavor = flavor})
pprFamInsts :: [FamInst] -> SDoc
pprFamInsts finsts = vcat (map pprFamInst finsts)
\end{code}
Note [Lazy axiom match]
......
{-# LANGUAGE TypeFamilies, DataKinds, PolyKinds #-}
module T8557 where
data family Sing (a :: k)
data instance Sing (a :: [k]) = SNil
data instance Sing Bool = SBool
type role Sing nominal
data family Sing (a :: k)
-- Defined at T8674.hs:4:1
data instance Sing Bool -- Defined at T8674.hs:6:15
data instance Sing a -- Defined at T8674.hs:5:15
......@@ -164,3 +164,4 @@ test('T8639', normal, ghci_script, ['T8639.script'])
test('T8640', normal, ghci_script, ['T8640.script'])
test('T8579', normal, ghci_script, ['T8579.script'])
test('T8649', normal, ghci_script, ['T8649.script'])
test('T8674', normal, ghci_script, ['T8674.script'])
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment