[commit: ghc] master: Tidy up IfaceEqualityTyCon (29ae833)
git at git.haskell.org
git at git.haskell.org
Tue Oct 31 12:13:27 UTC 2017
Repository : ssh://git@git.haskell.org/ghc
On branch : master
Link : http://ghc.haskell.org/trac/ghc/changeset/29ae83374647e227d76acd896b89590fc15590d6/ghc
>---------------------------------------------------------------
commit 29ae83374647e227d76acd896b89590fc15590d6
Author: Simon Peyton Jones <simonpj at microsoft.com>
Date: Tue Oct 31 11:01:17 2017 +0000
Tidy up IfaceEqualityTyCon
This commit
commit 85aa1f4253163985fe07d172f8da73b784bb7b4b
Date: Sun Oct 29 20:48:19 2017 -0400
Fix #14390 by making toIfaceTyCon aware of equality
was a bit over-complicated. This patch simplifies the (horribly
ad-hoc) treatement of IfaceEqualityTyCon, and documents it better.
No visible change in behaviour.
>---------------------------------------------------------------
29ae83374647e227d76acd896b89590fc15590d6
compiler/iface/IfaceType.hs | 71 +++++++++++++++++++++++++--------------------
compiler/iface/ToIface.hs | 18 +++---------
2 files changed, 44 insertions(+), 45 deletions(-)
diff --git a/compiler/iface/IfaceType.hs b/compiler/iface/IfaceType.hs
index c287d56..41120da 100644
--- a/compiler/iface/IfaceType.hs
+++ b/compiler/iface/IfaceType.hs
@@ -186,10 +186,12 @@ data IfaceTyConSort = IfaceNormalTyCon -- ^ a regular tycon
| IfaceSumTyCon !Arity
-- ^ e.g. @(a | b | c)@
- | IfaceEqualityTyCon !Bool
- -- ^ a type equality. 'True' indicates kind-homogeneous.
- -- See Note [Equality predicates in IfaceType] for
- -- details.
+ | IfaceEqualityTyCon
+ -- ^ A heterogeneous equality TyCon
+ -- (i.e. eqPrimTyCon, eqReprPrimTyCon, heqTyCon)
+ -- that is actually being applied to two types
+ -- of the same kind. This affects pretty-printing
+ -- only: see Note [Equality predicates in IfaceType]
deriving (Eq)
{- Note [Free tyvars in IfaceType]
@@ -216,24 +218,27 @@ We do the same for covars, naturally.
Note [Equality predicates in IfaceType]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
GHC has several varieties of type equality (see Note [The equality types story]
-in TysPrim for details) which all must be rendered with different surface syntax
-during pretty-printing. Which syntax we use depends upon,
-
- 1. Which predicate tycon was used
- 2. Whether the types being compared are of the same kind.
-
-Unfortunately, determining (2) from an IfaceType isn't possible since we can't
-see through type synonyms. Consequently, we need to record whether the equality
-is homogeneous or not in IfaceTyConSort for the purposes of pretty-printing.
-
-Namely we handle these cases,
-
- Predicate Homogeneous Heterogeneous
- ---------------- ----------- -------------
- eqTyCon ~ N/A
- heqTyCon ~ ~~
- eqPrimTyCon ~# ~~
- eqReprPrimTyCon Coercible Coercible
+in TysPrim for details). In an effort to avoid confusing users, we suppress
+the differences during "normal" pretty printing. Specifically we display them
+like this:
+
+ Predicate Pretty-printed as
+ Homogeneous case Heterogeneous case
+ ---------------- ----------------- -------------------
+ (~) eqTyCon ~ N/A
+ (~~) heqTyCon ~ ~~
+ (~#) eqPrimTyCon ~# ~~
+ (~R#) eqReprPrimTyCon Coercible Coercible
+
+By "homogeneeous case" we mean cases where a hetero-kinded equality
+(all but the first above) is actually applied to two identical kinds.
+Unfortunately, determining this from an IfaceType isn't possible since
+we can't see through type synonyms. Consequently, we need to record
+whether this particular application is homogeneous in IfaceTyConSort
+for the purposes of pretty-printing.
+
+All this suppresses information. To get the ground truth, use -dppr-debug
+(see 'print_eqs' in 'ppr_equality').
See Note [The equality types story] in TysPrim.
-}
@@ -919,6 +924,11 @@ pprTyTcApp' ctxt_prec tc tys dflags style
tys_wo_kinds = tcArgsIfaceTypes $ stripInvisArgs dflags tys
-- | Pretty-print a type-level equality.
+-- Returns (Just doc) if the argument is a /saturated/ application
+-- of eqTyCon (~)
+-- eqPrimTyCon (~#)
+-- eqReprPrimTyCon (~R#)
+-- hEqTyCon (~~)
--
-- See Note [Equality predicates in IfaceType]
-- and Note [The equality types story] in TysPrim
@@ -936,8 +946,11 @@ ppr_equality ctxt_prec tc args
= Nothing
where
homogeneous = case ifaceTyConSort $ ifaceTyConInfo tc of
- IfaceEqualityTyCon hom -> hom
- _other -> pprPanic "ppr_equality: homogeneity" (ppr tc)
+ IfaceEqualityTyCon -> True
+ _other -> False
+ -- True <=> a heterogeneous equality whose arguments
+ -- are (in this case) of the same kind
+
tc_name = ifaceTyConName tc
pp = ppr_ty
hom_eq_tc = tc_name `hasKey` eqTyConKey -- (~)
@@ -950,7 +963,7 @@ ppr_equality ctxt_prec tc args
print_equality' args style dflags
print_equality' (ki1, ki2, ty1, ty2) style dflags
- | print_eqs
+ | print_eqs -- No magic, just print the original TyCon
= ppr_infix_eq (ppr tc)
| hetero_eq_tc
@@ -1154,9 +1167,7 @@ instance Binary IfaceTyConSort where
put_ bh IfaceNormalTyCon = putByte bh 0
put_ bh (IfaceTupleTyCon arity sort) = putByte bh 1 >> put_ bh arity >> put_ bh sort
put_ bh (IfaceSumTyCon arity) = putByte bh 2 >> put_ bh arity
- put_ bh (IfaceEqualityTyCon hom)
- | hom = putByte bh 3
- | otherwise = putByte bh 4
+ put_ bh IfaceEqualityTyCon = putByte bh 3
get bh = do
n <- getByte bh
@@ -1164,9 +1175,7 @@ instance Binary IfaceTyConSort where
0 -> return IfaceNormalTyCon
1 -> IfaceTupleTyCon <$> get bh <*> get bh
2 -> IfaceSumTyCon <$> get bh
- 3 -> return $ IfaceEqualityTyCon True
- 4 -> return $ IfaceEqualityTyCon False
- _ -> fail "Binary(IfaceTyConSort): fail"
+ _ -> return IfaceEqualityTyCon
instance Binary IfaceTyConInfo where
put_ bh (IfaceTyConInfo i s) = put_ bh i >> put_ bh s
diff --git a/compiler/iface/ToIface.hs b/compiler/iface/ToIface.hs
index 6f71af5..e28abdf 100644
--- a/compiler/iface/ToIface.hs
+++ b/compiler/iface/ToIface.hs
@@ -139,15 +139,11 @@ toIfaceTypeX fr (TyConApp tc tys)
, n_tys == 2*arity
= IfaceTupleTy BoxedTuple IsPromoted (toIfaceTcArgsX fr tc (drop arity tys))
- -- type equalities: see Note [Equality predicates in IfaceType]
- | tyConName tc == eqTyConName
- = let info = IfaceTyConInfo IsNotPromoted (IfaceEqualityTyCon True)
- in IfaceTyConApp (IfaceTyCon (tyConName tc) info) (toIfaceTcArgsX fr tc tys)
-
| tc `elem` [ eqPrimTyCon, eqReprPrimTyCon, heqTyCon ]
- , [k1, k2, _t1, _t2] <- tys
- = let homogeneous = k1 `eqType` k2
- info = IfaceTyConInfo IsNotPromoted (IfaceEqualityTyCon homogeneous)
+ , (k1:k2:_) <- tys
+ = let info = IfaceTyConInfo IsNotPromoted sort
+ sort | k1 `eqType` k2 = IfaceEqualityTyCon
+ | otherwise = IfaceNormalTyCon
in IfaceTyConApp (IfaceTyCon (tyConName tc) info) (toIfaceTcArgsX fr tc tys)
-- other applications
@@ -195,12 +191,6 @@ toIfaceTyCon tc
| isUnboxedSumTyCon tc
, Just cons <- isDataSumTyCon_maybe tc = IfaceSumTyCon (length cons)
- | tyConName tc == eqTyConName || tc == eqPrimTyCon
- = IfaceEqualityTyCon True
-
- | tc `elem` [heqTyCon, eqReprPrimTyCon]
- = IfaceEqualityTyCon False
-
| otherwise = IfaceNormalTyCon
More information about the ghc-commits
mailing list