Commit d650729f authored by Vladislav Zavialov's avatar Vladislav Zavialov Committed by Richard Eisenberg

Embrace -XTypeInType, add -XStarIsType

Summary:
Implement the "Embrace Type :: Type" GHC proposal,
.../ghc-proposals/blob/master/proposals/0020-no-type-in-type.rst

GHC 8.0 included a major change to GHC's type system: the Type :: Type
axiom. Though casual users were protected from this by hiding its
features behind the -XTypeInType extension, all programs written in GHC
8+ have the axiom behind the scenes. In order to preserve backward
compatibility, various legacy features were left unchanged. For example,
with -XDataKinds but not -XTypeInType, GADTs could not be used in types.
Now these restrictions are lifted and -XTypeInType becomes a redundant
flag that will be eventually deprecated.

* Incorporate the features currently in -XTypeInType into the
  -XPolyKinds and -XDataKinds extensions.
* Introduce a new extension -XStarIsType to control how to parse * in
  code and whether to print it in error messages.

Test Plan: Validate

Reviewers: goldfire, hvr, bgamari, alanz, simonpj

Reviewed By: goldfire, simonpj

Subscribers: rwbarton, thomie, mpickering, carter

GHC Trac Issues: #15195

Differential Revision: https://phabricator.haskell.org/D4748
parent 4672e2eb
......@@ -35,6 +35,7 @@ __pycache__
log
tags
TAGS
autom4te.cache
config.log
......
[submodule "libraries/binary"]
path = libraries/binary
url = ../packages/binary.git
url = https://github.com/kolmodin/binary.git
ignore = untracked
[submodule "libraries/bytestring"]
path = libraries/bytestring
......@@ -108,7 +108,7 @@
ignore = untracked
[submodule "utils/haddock"]
path = utils/haddock
url = ../haddock.git
url = https://github.com/int-index/haddock.git
ignore = untracked
branch = ghc-head
[submodule "nofib"]
......
......@@ -53,7 +53,7 @@ module DataCon (
isVanillaDataCon, classDataCon, dataConCannotMatch,
dataConUserTyVarsArePermuted,
isBanged, isMarkedStrict, eqHsBang, isSrcStrict, isSrcUnpacked,
specialPromotedDc, isLegacyPromotableDataCon, isLegacyPromotableTyCon,
specialPromotedDc,
-- ** Promotion related functions
promoteDataCon
......@@ -1324,26 +1324,6 @@ isVanillaDataCon dc = dcVanilla dc
specialPromotedDc :: DataCon -> Bool
specialPromotedDc = isKindTyCon . dataConTyCon
-- | Was this datacon promotable before GHC 8.0? That is, is it promotable
-- without -XTypeInType
isLegacyPromotableDataCon :: DataCon -> Bool
isLegacyPromotableDataCon dc
= null (dataConEqSpec dc) -- no GADTs
&& null (dataConTheta dc) -- no context
&& not (isFamInstTyCon (dataConTyCon dc)) -- no data instance constructors
&& uniqSetAll isLegacyPromotableTyCon (tyConsOfType (dataConUserType dc))
-- | Was this tycon promotable before GHC 8.0? That is, is it promotable
-- without -XTypeInType
isLegacyPromotableTyCon :: TyCon -> Bool
isLegacyPromotableTyCon tc
= isVanillaAlgTyCon tc ||
-- This returns True more often than it should, but it's quite painful
-- to make this fully accurate. And no harm is caused; we just don't
-- require -XTypeInType every time we need to. (We'll always require
-- -XDataKinds, though, so there's no standards-compliance issue.)
isFunTyCon tc || isKindTyCon tc
classDataCon :: Class -> DataCon
classDataCon clas = case tyConDataCons (classTyCon clas) of
(dict_constr:no_more) -> ASSERT( null no_more ) dict_constr
......
......@@ -79,7 +79,6 @@ module Name (
import GhcPrelude
import {-# SOURCE #-} TyCoRep( TyThing )
import {-# SOURCE #-} PrelNames( starKindTyConKey, unicodeStarKindTyConKey )
import OccName
import Module
......@@ -687,24 +686,6 @@ pprInfixName :: (Outputable a, NamedThing a) => a -> SDoc
pprInfixName n = pprInfixVar (isSymOcc (getOccName n)) (ppr n)
pprPrefixName :: NamedThing a => a -> SDoc
pprPrefixName thing
| name `hasKey` starKindTyConKey || name `hasKey` unicodeStarKindTyConKey
= ppr name -- See Note [Special treatment for kind *]
| otherwise
= pprPrefixVar (isSymOcc (nameOccName name)) (ppr name)
pprPrefixName thing = pprPrefixVar (isSymOcc (nameOccName name)) (ppr name)
where
name = getName thing
{-
Note [Special treatment for kind *]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Do not put parens around the kind '*'. Even though it looks like
an operator, it is really a special case.
This pprPrefixName stuff is really only used when printing HsSyn,
which has to be polymorphic in the name type, and hence has to go via
the overloaded function pprPrefixOcc. It's easier where we know the
type being pretty printed; eg the pretty-printing code in TyCoRep.
See Trac #7645, which led to this.
-}
......@@ -34,8 +34,7 @@ module RdrName (
-- ** Destruction
rdrNameOcc, rdrNameSpace, demoteRdrName,
isRdrDataCon, isRdrTyVar, isRdrTc, isQual, isQual_maybe, isUnqual,
isOrig, isOrig_maybe, isExact, isExact_maybe, isSrcRdrName, isStar,
isUniStar,
isOrig, isOrig_maybe, isExact, isExact_maybe, isSrcRdrName,
-- * Local mapping of 'RdrName' to 'Name.Name'
LocalRdrEnv, emptyLocalRdrEnv, extendLocalRdrEnv, extendLocalRdrEnvList,
......@@ -63,7 +62,10 @@ module RdrName (
pprNameProvenance,
Parent(..),
ImportSpec(..), ImpDeclSpec(..), ImpItemSpec(..),
importSpecLoc, importSpecModule, isExplicitItem, bestImport
importSpecLoc, importSpecModule, isExplicitItem, bestImport,
-- * Utils for StarIsType
starInfo
) where
#include "HsVersions.h"
......@@ -262,10 +264,6 @@ isExact_maybe :: RdrName -> Maybe Name
isExact_maybe (Exact n) = Just n
isExact_maybe _ = Nothing
isStar, isUniStar :: RdrName -> Bool
isStar = (fsLit "*" ==) . occNameFS . rdrNameOcc
isUniStar = (fsLit "★" ==) . occNameFS . rdrNameOcc
{-
************************************************************************
* *
......@@ -1277,3 +1275,87 @@ instance Outputable ImportSpec where
pprLoc :: SrcSpan -> SDoc
pprLoc (RealSrcSpan s) = text "at" <+> ppr s
pprLoc (UnhelpfulSpan {}) = empty
-- | Display info about the treatment of '*' under NoStarIsType.
--
-- With StarIsType, three properties of '*' hold:
--
-- (a) it is not an infix operator
-- (b) it is always in scope
-- (c) it is a synonym for Data.Kind.Type
--
-- However, the user might not know that he's working on a module with
-- NoStarIsType and write code that still assumes (a), (b), and (c), which
-- actually do not hold in that module.
--
-- Violation of (a) shows up in the parser. For instance, in the following
-- examples, we have '*' not applied to enough arguments:
--
-- data A :: *
-- data F :: * -> *
--
-- Violation of (b) or (c) show up in the renamer and the typechecker
-- respectively. For instance:
--
-- type K = Either * Bool
--
-- This will parse differently depending on whether StarIsType is enabled,
-- but it will parse nonetheless. With NoStarIsType it is parsed as a type
-- operator, thus we have ((*) Either Bool). Now there are two cases to
-- consider:
--
-- 1. There is no definition of (*) in scope. In this case the renamer will
-- fail to look it up. This is a violation of assumption (b).
--
-- 2. There is a definition of the (*) type operator in scope (for example
-- coming from GHC.TypeNats). In this case the user will get a kind
-- mismatch error. This is a violation of assumption (c).
--
-- Since NoStarIsType is implied by a fairly common extension TypeOperators,
-- the user might be working on a module with NoStarIsType unbeknownst to him.
-- Even if the user switched off StarIsType manually, he might have forgotten
-- about it and use '*' as 'Data.Kind.Type' out of habit.
--
-- Thus it is very important to give a hint whenever an assumption about '*' is
-- violated. Unfortunately, it is somewhat difficult to deal with (c), so we
-- limit ourselves to (a) and (b).
--
-- 'starInfo' generates an appropriate hint to the user depending on the
-- extensions enabled in the module and the name that triggered the error.
-- That is, if we have NoStarIsType and the error is related to '*' or its
-- Unicode variant, the resulting SDoc will contain a helpful suggestion.
-- Otherwise it is empty.
--
starInfo :: (Bool, Bool) -> RdrName -> SDoc
starInfo (type_operators, star_is_type) rdr_name =
-- One might ask: if can use sdocWithDynFlags here, why bother to take
-- (type_operators, star_is_type) as input? Why not refactor?
--
-- The reason is that sdocWithDynFlags would provide DynFlags that are active
-- in the module that tries to load the problematic definition, not
-- in the module that is being loaded.
--
-- So if we have 'data T :: *' in a module with NoStarIsType, then the hint
-- must be displayed even if we load this definition from a module (or GHCi)
-- with StarIsType enabled!
--
if isUnqualStar && not star_is_type
then text "With NoStarIsType" <>
(if type_operators
then text " (implied by TypeOperators), "
else text ", ") <>
quotes (ppr rdr_name) <>
text " is treated as a regular type operator. "
$$
text "Did you mean to use " <> quotes (text "Type") <>
text " from Data.Kind instead?"
else empty
where
-- Does rdr_name look like the user might have meant the '*' kind by it?
-- We focus on unqualified stars specifically, because qualified stars are
-- treated as type operators even under StarIsType.
isUnqualStar
| Unqual occName <- rdr_name
= let fs = occNameFS occName
in fs == fsLit "*" || fs == fsLit "★"
| otherwise = False
......@@ -333,6 +333,7 @@ srcSpanFirstCharacter (RealSrcSpan span) = RealSrcSpan $ mkRealSrcSpan loc1 loc2
where
loc1@(SrcLoc f l c) = realSrcSpanStart span
loc2 = SrcLoc f l (c+1)
{-
************************************************************************
* *
......@@ -511,8 +512,8 @@ pprUserRealSpan show_path (RealSrcSpan' src_path sline scol eline ecol)
data GenLocated l e = L l e
deriving (Eq, Ord, Data, Functor, Foldable, Traversable)
type Located e = GenLocated SrcSpan e
type RealLocated e = GenLocated RealSrcSpan e
type Located = GenLocated SrcSpan
type RealLocated = GenLocated RealSrcSpan
unLoc :: GenLocated l e -> e
unLoc (L _ e) = e
......
......@@ -288,10 +288,8 @@ and have Template Haskell turn it into this:
idProxy :: forall k proxy (b :: k). proxy b -> proxy b
idProxy x = x
Notice that we explicitly quantified the variable `k`! This is quite bad, as the
latter declaration requires -XTypeInType, while the former does not. Not to
mention that the latter declaration isn't even what the user wrote in the
first place.
Notice that we explicitly quantified the variable `k`! The latter declaration
isn't what the user wrote in the first place.
Usually, the culprit behind these bugs is taking implicitly quantified type
variables (often from the hsib_vars field of HsImplicitBinders) and putting
......@@ -1128,6 +1126,7 @@ repTy (HsEqTy _ t1 t2) = do
t2' <- repLTy t2
eq <- repTequality
repTapps eq [t1', t2']
repTy (HsStarTy _ _) = repTStar
repTy (HsKindSig _ t k) = do
t1 <- repLTy t
k1 <- repLTy k
......
......@@ -963,7 +963,7 @@ the trees to reflect the fixities of the underlying operators:
This is done by the renamer (see @mkOppAppRn@, @mkConOppPatRn@, and
@mkHsOpTyRn@ in RnTypes), which expects that the input will be completely
right-biased for types and left-biased for everything else. So we left-bias the
trees of @UInfixP@ and @UInfixE@ and use HsAppsTy for UInfixT.
trees of @UInfixP@ and @UInfixE@ and right-bias the trees of @UInfixT@.
Sample input:
......@@ -1332,10 +1332,8 @@ cvtTypeKind ty_str ty
}
UInfixT t1 s t2
-> do { t1' <- cvtType t1
; t2' <- cvtType t2
; s' <- tconName s
; return $ cvtOpAppT t1' s' t2'
-> do { t2' <- cvtType t2
; cvtOpAppT t1 s t2'
} -- Note [Converting UInfix]
ParensT t
......@@ -1445,23 +1443,20 @@ cvtTyLit :: TH.TyLit -> HsTyLit
cvtTyLit (TH.NumTyLit i) = HsNumTy NoSourceText i
cvtTyLit (TH.StrTyLit s) = HsStrTy NoSourceText (fsLit s)
{- | @cvtOpAppT x op y@ takes converted arguments and flattens any HsAppsTy
structure in them.
{- | @cvtOpAppT x op y@ converts @op@ and @y@ and produces the operator
application @x `op` y@. The produced tree of infix types will be right-biased,
provided @y@ is.
See the @cvtOpApp@ documentation for how this function works.
-}
cvtOpAppT :: LHsType GhcPs -> RdrName -> LHsType GhcPs -> LHsType GhcPs
cvtOpAppT t1@(L loc1 _) op t2@(L loc2 _)
= L (combineSrcSpans loc1 loc2) $
HsAppsTy noExt (t1' ++ [noLoc $ HsAppInfix noExt (noLoc op)] ++ t2')
where
t1' | L _ (HsAppsTy _ t1s) <- t1
= t1s
| otherwise
= [noLoc $ HsAppPrefix noExt t1]
t2' | L _ (HsAppsTy _ t2s) <- t2
= t2s
| otherwise
= [noLoc $ HsAppPrefix noExt t2]
cvtOpAppT :: TH.Type -> TH.Name -> LHsType GhcPs -> CvtM (LHsType GhcPs)
cvtOpAppT (UInfixT x op2 y) op1 z
= do { l <- cvtOpAppT y op1 z
; cvtOpAppT x op2 l }
cvtOpAppT x op y
= do { op' <- tconNameL op
; x' <- cvtType x
; returnL (mkHsOpTy x' op' y) }
cvtKind :: TH.Kind -> CvtM (LHsKind GhcPs)
cvtKind = cvtTypeKind "kind"
......
......@@ -784,11 +784,10 @@ variables and its return type are annotated.
- An open type family always has a CUSK -- unannotated type variables (and
return type) default to *.
- Additionally, if -XTypeInType is on, then a data definition with a top-level
:: must explicitly bind all kind variables to the right of the ::.
See test dependent/should_compile/KindLevels, which requires this case.
(Naturally, any kind variable mentioned before the :: should not be bound
after it.)
- A data definition with a top-level :: must explicitly bind all kind variables
to the right of the ::. See test dependent/should_compile/KindLevels, which
requires this case. (Naturally, any kind variable mentioned before the :: should
not be bound after it.)
-}
......
......@@ -902,7 +902,6 @@ type ForallXHsWildCardBndrs(c :: * -> Constraint) (x :: *) (b :: *) =
type family XForAllTy x
type family XQualTy x
type family XTyVar x
type family XAppsTy x
type family XAppTy x
type family XFunTy x
type family XListTy x
......@@ -912,6 +911,7 @@ type family XOpTy x
type family XParTy x
type family XIParamTy x
type family XEqTy x
type family XStarTy x
type family XKindSig x
type family XSpliceTy x
type family XDocTy x
......@@ -929,7 +929,6 @@ type ForallXType (c :: * -> Constraint) (x :: *) =
( c (XForAllTy x)
, c (XQualTy x)
, c (XTyVar x)
, c (XAppsTy x)
, c (XAppTy x)
, c (XFunTy x)
, c (XListTy x)
......@@ -939,6 +938,7 @@ type ForallXType (c :: * -> Constraint) (x :: *) =
, c (XParTy x)
, c (XIParamTy x)
, c (XEqTy x)
, c (XStarTy x)
, c (XKindSig x)
, c (XSpliceTy x)
, c (XDocTy x)
......@@ -965,18 +965,6 @@ type ForallXTyVarBndr (c :: * -> Constraint) (x :: *) =
-- ---------------------------------------------------------------------
type family XAppInfix x
type family XAppPrefix x
type family XXAppType x
type ForallXAppType (c :: * -> Constraint) (x :: *) =
( c (XAppInfix x)
, c (XAppPrefix x)
, c (XXAppType x)
)
-- ---------------------------------------------------------------------
type family XConDeclField x
type family XXConDeclField x
......
......@@ -382,11 +382,6 @@ deriving instance Data (HsType GhcPs)
deriving instance Data (HsType GhcRn)
deriving instance Data (HsType GhcTc)
-- deriving instance (DataIdLR p p) => Data (HsAppType p)
deriving instance Data (HsAppType GhcPs)
deriving instance Data (HsAppType GhcRn)
deriving instance Data (HsAppType GhcTc)
-- deriving instance (DataIdLR p p) => Data (ConDeclField p)
deriving instance Data (ConDeclField GhcPs)
deriving instance Data (ConDeclField GhcRn)
......
......@@ -28,7 +28,6 @@ module HsTypes (
HsContext, LHsContext,
HsTyLit(..),
HsIPName(..), hsIPNameFS,
HsAppType(..),LHsAppType,
LBangType, BangType,
HsSrcBang(..), HsImplBang(..),
......@@ -57,9 +56,9 @@ module HsTypes (
splitLHsInstDeclTy, getLHsInstDeclHead, getLHsInstDeclClass_maybe,
splitLHsPatSynTy,
splitLHsForAllTy, splitLHsQualTy, splitLHsSigmaTy,
splitHsFunType, splitHsAppsTy,
splitHsAppTys, getAppsTyHead_maybe, hsTyGetAppHead_maybe,
mkHsOpTy, mkHsAppTy, mkHsAppTys, mkHsAppsTy,
splitHsFunType,
splitHsAppTys, hsTyGetAppHead_maybe,
mkHsOpTy, mkHsAppTy, mkHsAppTys,
ignoreParens, hsSigType, hsSigWcType,
hsLTyVarBndrToType, hsLTyVarBndrsToTypes,
......@@ -487,11 +486,6 @@ data HsType pass
-- For details on above see note [Api annotations] in ApiAnnotation
| HsAppsTy (XAppsTy pass)
[LHsAppType pass] -- Used only before renaming,
-- Note [HsAppsTy]
-- ^ - 'ApiAnnotation.AnnKeywordId' : None
| HsAppTy (XAppTy pass)
(LHsType pass)
(LHsType pass)
......@@ -566,6 +560,11 @@ data HsType pass
-- For details on above see note [Api annotations] in ApiAnnotation
| HsStarTy (XStarTy pass)
Bool -- Is this the Unicode variant?
-- Note [HsStarTy]
-- ^ - 'ApiAnnotation.AnnKeywordId' : None
| HsKindSig (XKindSig pass)
(LHsType pass) -- (ty :: kind)
(LHsKind pass) -- A type with a kind signature
......@@ -658,7 +657,6 @@ instance Outputable NewHsTypeX where
type instance XForAllTy (GhcPass _) = NoExt
type instance XQualTy (GhcPass _) = NoExt
type instance XTyVar (GhcPass _) = NoExt
type instance XAppsTy (GhcPass _) = NoExt
type instance XAppTy (GhcPass _) = NoExt
type instance XFunTy (GhcPass _) = NoExt
type instance XListTy (GhcPass _) = NoExt
......@@ -668,6 +666,7 @@ type instance XOpTy (GhcPass _) = NoExt
type instance XParTy (GhcPass _) = NoExt
type instance XIParamTy (GhcPass _) = NoExt
type instance XEqTy (GhcPass _) = NoExt
type instance XStarTy (GhcPass _) = NoExt
type instance XKindSig (GhcPass _) = NoExt
type instance XSpliceTy GhcPs = NoExt
......@@ -709,27 +708,6 @@ newtype HsWildCardInfo -- See Note [The wildcard story for types]
-- A anonymous wild card ('_'). A fresh Name is generated for
-- each individual anonymous wildcard during renaming
-- | Located Haskell Application Type
type LHsAppType pass = Located (HsAppType pass)
-- ^ 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnSimpleQuote'
-- | Haskell Application Type
data HsAppType pass
= HsAppInfix (XAppInfix pass)
(Located (IdP pass)) -- either a symbol or an id in backticks
| HsAppPrefix (XAppPrefix pass)
(LHsType pass) -- anything else, including things like (+)
| XAppType
(XXAppType pass)
type instance XAppInfix (GhcPass _) = NoExt
type instance XAppPrefix (GhcPass _) = NoExt
type instance XXAppType (GhcPass _) = NoExt
instance (p ~ GhcPass pass, OutputableBndrId p)
=> Outputable (HsAppType p) where
ppr = ppr_app_ty
{-
Note [HsForAllTy tyvar binders]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
......@@ -785,16 +763,18 @@ HsTyVar: A name in a type or kind.
The 'Promoted' field in an HsTyVar captures whether the type was promoted in
the source code by prefixing an apostrophe.
Note [HsAppsTy]
Note [HsStarTy]
~~~~~~~~~~~~~~~
How to parse
When the StarIsType extension is enabled, we want to treat '*' and its Unicode
variant identically to 'Data.Kind.Type'. Unfortunately, doing so in the parser
would mean that when we pretty-print it back, we don't know whether the user
wrote '*' or 'Type', and lose the parse/ppr roundtrip property.
Foo * Int
As a workaround, we parse '*' as HsStarTy (if it stands for 'Data.Kind.Type')
and then desugar it to 'Data.Kind.Type' in the typechecker (see tc_hs_type).
When '*' is a regular type operator (StarIsType is disabled), HsStarTy is not
involved.
? Is it `(*) Foo Int` or `Foo GHC.Types.* Int`? There's no way to know until renaming.
So we just take type expressions like this and put each component in a list, so be
sorted out in the renamer. The sorting out is done by RnTypes.mkHsOpTyRn. This means
that the parser should never produce HsAppTy or HsOpTy.
Note [Promoted lists and tuples]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
......@@ -1042,12 +1022,6 @@ mkHsAppTys :: LHsType (GhcPass p) -> [LHsType (GhcPass p)]
-> LHsType (GhcPass p)
mkHsAppTys = foldl mkHsAppTy
mkHsAppsTy :: [LHsAppType GhcPs] -> HsType GhcPs
-- In the common case of a singleton non-operator,
-- avoid the clutter of wrapping in a HsAppsTy
mkHsAppsTy [L _ (HsAppPrefix _ (L _ ty))] = ty
mkHsAppsTy app_tys = HsAppsTy NoExt app_tys
{-
************************************************************************
* *
......@@ -1083,38 +1057,7 @@ splitHsFunType orig_ty@(L _ (HsAppTy _ t1 t2))
splitHsFunType other = ([], other)
--------------------------------
-- | Retrieves the head of an HsAppsTy, if this can be done unambiguously,
-- without consulting fixities.
getAppsTyHead_maybe :: [LHsAppType (GhcPass p)]
-> Maybe ( LHsType (GhcPass p)
, [LHsType (GhcPass p)], LexicalFixity)
getAppsTyHead_maybe tys = case splitHsAppsTy tys of
([app1:apps], []) -> -- no symbols, some normal types
Just (mkHsAppTys app1 apps, [], Prefix)
([app1l:appsl, app1r:appsr], [L loc op]) -> -- one operator