Commit 6100eb44 authored by Simon Peyton Jones's avatar Simon Peyton Jones
Browse files

Fix Trac #5952, by changing the Outputable TyCon instance,

so that it does not print a quote in front of a promoted
TyCon in a Kind.

I also systematically renamed
   PromotedTypeTyCon  -->   PromotedTyCon
   PromotedDataTyCon  -->   PromotedDataCon
parent 4caef1c4
......@@ -989,7 +989,7 @@ buildPromotedTyCon tc
buildPromotedDataCon :: DataCon -> TyCon
buildPromotedDataCon dc
= ASSERT ( isPromotableType ty )
mkPromotedDataTyCon dc (getName dc) (getUnique dc) kind arity
mkPromotedDataCon dc (getName dc) (getUnique dc) kind arity
where
ty = dataConUserType dc
kind = promoteType ty
......
......@@ -485,10 +485,11 @@ designed to mark functions like "filter" as strong loop breakers on the basis th
1. The RHS of filter mentions the local function "filterFB"
2. We have a rule which mentions "filterFB" on the LHS and "filter" on the RHS
So for each RULE for an *imported* function we are going to add dependency edges between
the FVS of the rule LHS and the FVS of the rule RHS. We don't do anything special for
RULES on local functions because the standard occurrence analysis stuff is pretty good
at getting loop-breakerness correct there.
So for each RULE for an *imported* function we are going to add
dependency edges between the *local* FVS of the rule LHS and the
*local* FVS of the rule RHS. We don't do anything special for RULES on
local functions because the standard occurrence analysis stuff is
pretty good at getting loop-breakerness correct there.
It is important to note that even with this extra hack we aren't always going to get
things right. For example, it might be that the rule LHS mentions an imported Id,
......
......@@ -212,7 +212,7 @@ isSubKind (FunTy a1 r1) (FunTy a2 r2)
= (isSubKind a2 a1) && (isSubKind r1 r2)
isSubKind k1@(TyConApp kc1 k1s) k2@(TyConApp kc2 k2s)
| isPromotedTypeTyCon kc1 || isPromotedTypeTyCon kc2
| isPromotedTyCon kc1 || isPromotedTyCon kc2
-- handles promoted kinds (List *, Nat, etc.)
= eqKind k1 k2
......
......@@ -30,7 +30,7 @@ module TyCon(
mkTupleTyCon,
mkSynTyCon,
mkForeignTyCon,
mkPromotedDataTyCon,
mkPromotedDataCon,
mkPromotedTyCon,
-- ** Predicates on TyCons
......@@ -42,7 +42,7 @@ module TyCon(
isSynTyCon, isClosedSynTyCon,
isDecomposableTyCon,
isForeignTyCon,
isPromotedDataTyCon, isPromotedTypeTyCon,
isPromotedDataCon, isPromotedTyCon,
isInjectiveTyCon,
isDataTyCon, isProductTyCon, isEnumerationTyCon,
......@@ -393,7 +393,7 @@ data TyCon
}
-- | Represents promoted data constructor.
| PromotedDataTyCon { -- See Note [Promoted data constructors]
| PromotedDataCon { -- See Note [Promoted data constructors]
tyConUnique :: Unique, -- ^ Same Unique as the data constructor
tyConName :: Name, -- ^ Same Name as the data constructor
tyConArity :: Arity,
......@@ -402,7 +402,7 @@ data TyCon
}
-- | Represents promoted type constructor.
| PromotedTypeTyCon {
| PromotedTyCon {
tyConUnique :: Unique, -- ^ Same Unique as the type constructor
tyConName :: Name, -- ^ Same Name as the type constructor
tyConArity :: Arity, -- ^ n if ty_con :: * -> ... -> * n times
......@@ -588,7 +588,7 @@ data SynTyConRhs
Note [Promoted data constructors]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
A data constructor can be promoted to become a type constructor,
via the PromotedDataTyCon alternative in TyCon.
via the PromotedTyCon alternative in TyCon.
* Only "vanilla" data constructors are promoted; ones with no GADT
stuff, no existentials, etc. We might generalise this later.
......@@ -602,7 +602,7 @@ via the PromotedDataTyCon alternative in TyCon.
kind of (promoted) tycon Just :: forall (a:box). a -> Maybe a
The kind is not identical to the type, because of the */box
kind signature on the forall'd variable; so the tc_kind field of
PromotedDataTyCon is not identical to the dataConUserType of the
PromotedTyCon is not identical to the dataConUserType of the
DataCon. But it's the same modulo changing the variable kinds,
done by Kind.promoteType.
......@@ -945,10 +945,11 @@ mkSynTyCon name kind tyvars rhs parent
-- | Create a promoted data constructor 'TyCon'
-- Somewhat dodgily, we give it the same Name
-- as the data constructor itself
mkPromotedDataTyCon :: DataCon -> Name -> Unique -> Kind -> Arity -> TyCon
mkPromotedDataTyCon con name unique kind arity
-- as the data constructor itself; when we pretty-print
-- the TyCon we add a quote; see the Outputable TyCon instance
mkPromotedDataCon :: DataCon -> Name -> Unique -> Kind -> Arity -> TyCon
mkPromotedDataCon con name unique kind arity
= PromotedDataCon {
tyConName = name,
tyConUnique = unique,
tyConArity = arity,
......@@ -961,7 +962,7 @@ mkPromotedDataTyCon con name unique kind arity
-- as the type constructor itself
mkPromotedTyCon :: TyCon -> Kind -> TyCon
mkPromotedTyCon tc kind
= PromotedTypeTyCon {
= PromotedTyCon {
tyConName = getName tc,
tyConUnique = getUnique tc,
tyConArity = tyConArity tc,
......@@ -1038,7 +1039,7 @@ isDistinctTyCon (AlgTyCon {algTcRhs = rhs}) = isDistinctAlgRhs rhs
isDistinctTyCon (FunTyCon {}) = True
isDistinctTyCon (TupleTyCon {}) = True
isDistinctTyCon (PrimTyCon {}) = True
isDistinctTyCon (PromotedDataTyCon {}) = True
isDistinctTyCon (PromotedDataCon {}) = True
isDistinctTyCon _ = False
isDistinctAlgRhs :: AlgTyConRhs -> Bool
......@@ -1196,15 +1197,15 @@ isForeignTyCon :: TyCon -> Bool
isForeignTyCon (PrimTyCon {tyConExtName = Just _}) = True
isForeignTyCon _ = False
-- | Is this a PromotedDataTyCon?
isPromotedDataTyCon :: TyCon -> Bool
isPromotedDataTyCon (PromotedDataTyCon {}) = True
isPromotedDataTyCon _ = False
-- | Is this a PromotedDataCon?
isPromotedDataCon :: TyCon -> Bool
isPromotedDataCon (PromotedDataCon {}) = True
isPromotedDataCon _ = False
-- | Is this a PromotedTypeTyCon?
isPromotedTypeTyCon :: TyCon -> Bool
isPromotedTypeTyCon (PromotedTypeTyCon {}) = True
isPromotedTypeTyCon _ = False
-- | Is this a PromotedTyCon?
isPromotedTyCon :: TyCon -> Bool
isPromotedTyCon (PromotedTyCon {}) = True
isPromotedTyCon _ = False
-- | Identifies implicit tycons that, in particular, do not go into interface
-- files (because they are implicitly reconstructed when the interface is
......@@ -1480,9 +1481,10 @@ instance Outputable TyCon where
ppr tc = pprPromotionQuote tc <> ppr (tyConName tc)
pprPromotionQuote :: TyCon -> SDoc
pprPromotionQuote (PromotedTypeTyCon {}) = char '\''
pprPromotionQuote (PromotedDataTyCon {}) = char '\''
pprPromotionQuote _ = empty
pprPromotionQuote (PromotedDataCon {}) = char '\'' -- Quote promoted DataCons in types
pprPromotionQuote _ = empty -- However, we don't quote TyCons in kinds
-- e.g. type family T a :: Bool -> *
-- cf Trac #5952
instance NamedThing TyCon where
getName = tyConName
......
......@@ -1576,7 +1576,7 @@ type SimpleKind = Kind
\begin{code}
typeKind :: Type -> Kind
typeKind (TyConApp tc tys)
| isPromotedTypeTyCon tc
| isPromotedTyCon tc
= ASSERT( tyConArity tc == length tys ) superKind
| otherwise
= kindAppResult (tyConKind tc) tys
......
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