Commit 575a98e4 authored by Simon Peyton Jones's avatar Simon Peyton Jones

Refactor named wildcards (again)

Michal's work on #10982, #11098, refactored the handling of named
wildcards by making them more like ordinary type variables.

This patch takes the same idea to its logical conclusion, resulting
in a much tidier, tighter implementation.

Read Note [The wildcard story for types] in HsTypes.

Changes:

 * Named wildcards are ordinary type variables, throughout

 * HsType no longer has a data constructor for named wildcards
   (was NamedWildCard in HsWildCardInfo).  Named wildcards are
   simply HsTyVars

 * Similarly named wildcards disappear from Template Haskell

 * I refactored RnTypes to avoid polluting LocalRdrEnv with something
   as narrow as named wildcards.  Instead the named wildcard set is
   carried in RnTyKiEnv.

There is a submodule update for Haddock.
parent 01b0461e
......@@ -41,7 +41,6 @@ module RdrName (
lookupLocalRdrEnv, lookupLocalRdrOcc,
elemLocalRdrEnv, inLocalRdrEnvScope,
localRdrEnvElts, delLocalRdrEnvList,
extendLocalRdrEnvNwcs, inLocalRdrEnvNwcsRdrName, delLocalRdrEnvNwcs,
-- * Global mapping of 'RdrName' to 'GlobalRdrElt's
GlobalRdrEnv, emptyGlobalRdrEnv, mkGlobalRdrEnv, plusGlobalRdrEnv,
......@@ -327,17 +326,14 @@ instance Ord RdrName where
-- be replaced with named wildcards.
-- See Note [Renaming named wild cards] in RnTypes
data LocalRdrEnv = LRE { lre_env :: OccEnv Name
, lre_in_scope :: NameSet
, lre_nwcs :: NameSet }
, lre_in_scope :: NameSet }
instance Outputable LocalRdrEnv where
ppr (LRE {lre_env = env, lre_in_scope = ns, lre_nwcs = nwcs})
ppr (LRE {lre_env = env, lre_in_scope = ns})
= hang (ptext (sLit "LocalRdrEnv {"))
2 (vcat [ ptext (sLit "env =") <+> pprOccEnv ppr_elt env
, ptext (sLit "in_scope =")
<+> braces (pprWithCommas ppr (nameSetElems ns))
, ptext (sLit "nwcs =")
<+> braces (pprWithCommas ppr (nameSetElems nwcs))
] <+> char '}')
where
ppr_elt name = parens (ppr (getUnique (nameOccName name))) <+> ppr name
......@@ -345,8 +341,7 @@ instance Outputable LocalRdrEnv where
emptyLocalRdrEnv :: LocalRdrEnv
emptyLocalRdrEnv = LRE { lre_env = emptyOccEnv
, lre_in_scope = emptyNameSet
, lre_nwcs = emptyNameSet }
, lre_in_scope = emptyNameSet }
extendLocalRdrEnv :: LocalRdrEnv -> Name -> LocalRdrEnv
-- The Name should be a non-top-level thing
......@@ -387,27 +382,6 @@ delLocalRdrEnvList :: LocalRdrEnv -> [OccName] -> LocalRdrEnv
delLocalRdrEnvList lre@(LRE { lre_env = env }) occs
= lre { lre_env = delListFromOccEnv env occs }
extendLocalRdrEnvNwcs:: LocalRdrEnv -> [Name] -> LocalRdrEnv
extendLocalRdrEnvNwcs lre@(LRE { lre_nwcs = nwcs }) names
= lre { lre_nwcs = extendNameSetList nwcs names }
inLocalRdrEnvNwcs :: Name -> LocalRdrEnv -> Bool
inLocalRdrEnvNwcs name (LRE { lre_nwcs = nwcs }) = name `elemNameSet` nwcs
inLocalRdrEnvNwcsRdrName :: RdrName -> LocalRdrEnv -> Bool
inLocalRdrEnvNwcsRdrName rdr_name lcl_env@(LRE { lre_nwcs = nwcs })
| isEmptyNameSet nwcs = False
| otherwise = case rdr_name of
Unqual occ -> case lookupLocalRdrOcc lcl_env occ of
Just name -> inLocalRdrEnvNwcs name lcl_env
Nothing -> False
Exact name -> inLocalRdrEnvNwcs name lcl_env
_ -> False
delLocalRdrEnvNwcs :: LocalRdrEnv -> [Name] -> LocalRdrEnv
delLocalRdrEnvNwcs lre@(LRE { lre_nwcs = nwcs }) names
= lre { lre_nwcs = delListFromNameSet nwcs names }
{-
Note [Local bindings with Exact Names]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
......
......@@ -965,9 +965,6 @@ repTy (HsTyLit lit) = do
lit' <- repTyLit lit
repTLit lit'
repTy (HsWildCardTy (AnonWildCard _)) = repTWildCard
repTy (HsWildCardTy (NamedWildCard (L _ n))) = do
nwc <- lookupOcc n
repTNamedWildCard nwc
repTy ty = notHandled "Exotic form of type" (ppr ty)
......@@ -2045,10 +2042,6 @@ repTLit (MkC lit) = rep2 litTName [lit]
repTWildCard :: DsM (Core TH.TypeQ)
repTWildCard = rep2 wildCardTName []
repTNamedWildCard :: Core TH.Name -> DsM (Core TH.TypeQ)
repTNamedWildCard (MkC s) = rep2 namedWildCardTName [s]
--------- Type constructors --------------
repNamedTyCon :: Core TH.Name -> DsM (Core TH.TypeQ)
......
......@@ -1142,13 +1142,9 @@ cvtTypeKind ty_str ty
LitT lit
-> returnL (HsTyLit (cvtTyLit lit))
WildCardT Nothing
WildCardT
-> mk_apps mkAnonWildCardTy tys'
WildCardT (Just nm)
-> do { nm' <- tNameL nm
; mk_apps (mkNamedWildCardTy nm') tys' }
InfixT t1 s t2
-> do { s' <- tconName s
; t1' <- cvtType t1
......
......@@ -43,9 +43,8 @@ module HsTypes (
rdrNameAmbiguousFieldOcc, selectorAmbiguousFieldOcc,
unambiguousFieldOcc, ambiguousFieldOcc,
HsWildCardInfo(..), mkAnonWildCardTy, mkNamedWildCardTy,
wildCardName, sameWildCard, sameNamedWildCard,
isAnonWildCard, isNamedWildCard,
HsWildCardInfo(..), mkAnonWildCardTy,
wildCardName, sameWildCard,
mkHsImplicitBndrs, mkHsWildCardBndrs, hsImplicitBody,
mkEmptyImplicitBndrs, mkEmptyWildCardBndrs,
......@@ -178,6 +177,44 @@ is a bit complicated. Here's how it works.
class C (a :: k -> *) where ...
The 'k' is implicitly bound in the hsq_tvs field of LHsQTyVars
Note [The wildcard story for types]
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Types can have wildcards in them, to support partial type signatures,
like f :: Int -> (_ , _a) -> _a
A wildcard in a type can be
* An anonymous wildcard,
written '_'
In HsType this is represented by HsWildCardTy.
After the renamer, this contains a Name which uniquely
identifies this particular occurrence.
* A named wildcard,
written '_a', '_foo', etc
In HsType this is represented by (HsTyVar "_a")
i.e. a perfectly ordinary type variable that happens
to start with an underscore
Note carefully:
* When NamedWildCards is off, type variables that start with an
underscore really /are/ ordinary type variables. And indeed, even
when NamedWildCards is on you can bind _a explicitly as an ordinary
type variable:
data T _a _b = MkT _b _a
Or even:
f :: forall _a. _a -> _b
Here _a is an ordinary forall'd binder, but (With NamedWildCards)
_b is a named wildcard. (See the comments in Trac #10982)
* All wildcards, whether named or anonymous, are bound by the
HsWildCardBndrs construct, which wraps types that are allowed
to have wildcards.
* After type checking is done, we report what types the wildcards
got unified with.
-}
type LHsContext name = Located (HsContext name)
......@@ -242,7 +279,9 @@ data HsImplicitBndrs name thing -- See Note [HsType binders]
}
deriving (Typeable)
data HsWildCardBndrs name thing -- See Note [HsType binders]
data HsWildCardBndrs name thing
-- See Note [HsType binders]
-- See Note [The wildcard story for types]
= HsWC { hswc_wcs :: PostRn name [Name]
-- Wild cards, both named and anonymous
......@@ -517,6 +556,7 @@ data HsType name
-- For details on above see note [Api annotations] in ApiAnnotation
| HsWildCardTy (HsWildCardInfo name) -- A type wildcard
-- See Note [The wildcard story for types]
-- ^ - 'ApiAnnotation.AnnKeywordId' : None
-- For details on above see note [Api annotations] in ApiAnnotation
......@@ -533,12 +573,10 @@ data HsTyLit
mkHsOpTy :: LHsType name -> Located name -> LHsType name -> HsType name
mkHsOpTy ty1 op ty2 = HsOpTy ty1 op ty2
data HsWildCardInfo name
newtype HsWildCardInfo name -- See Note [The wildcard story for types]
= AnonWildCard (PostRn name (Located Name))
-- A anonymous wild card ('_'). A fresh Name is generated for
-- each individual anonymous wildcard during renaming
| NamedWildCard (Located name)
-- A named wild card ('_a').
deriving (Typeable)
deriving instance (DataId name) => Data (HsWildCardInfo name)
......@@ -891,36 +929,13 @@ hsLTyVarBndrsToTypes (HsQTvs { hsq_explicit = tvbs }) = map hsLTyVarBndrToType t
mkAnonWildCardTy :: HsType RdrName
mkAnonWildCardTy = HsWildCardTy (AnonWildCard PlaceHolder)
mkNamedWildCardTy :: Located n -> HsType n
mkNamedWildCardTy = HsWildCardTy . NamedWildCard
isAnonWildCard :: HsWildCardInfo name -> Bool
isAnonWildCard (AnonWildCard _) = True
isAnonWildCard _ = False
isNamedWildCard :: HsWildCardInfo name -> Bool
isNamedWildCard = not . isAnonWildCard
wildCardName :: HsWildCardInfo Name -> Name
wildCardName (NamedWildCard (L _ n)) = n
wildCardName (AnonWildCard (L _ n)) = n
-- Two wild cards are the same when: they're both named and have the same
-- name, or they're both anonymous and have the same location.
sameWildCard :: Eq name
=> Located (HsWildCardInfo name)
-- Two wild cards are the same when they have the same location
sameWildCard :: Located (HsWildCardInfo name)
-> Located (HsWildCardInfo name) -> Bool
sameWildCard (L l1 (AnonWildCard _)) (L l2 (AnonWildCard _)) = l1 == l2
sameWildCard (L _ (NamedWildCard (L _ n1)))
(L _ (NamedWildCard (L _ n2))) = n1 == n2
sameWildCard _ _ = False
sameNamedWildCard :: Eq name
=> Located (HsWildCardInfo name)
-> Located (HsWildCardInfo name) -> Bool
sameNamedWildCard (L _ (NamedWildCard (L _ n1)))
(L _ (NamedWildCard (L _ n2))) = n1 == n2
sameNamedWildCard _ _ = False
splitHsAppTys :: LHsType Name -> [LHsType Name] -> (LHsType Name, [LHsType Name])
-- no need to worry about HsAppsTy here
......@@ -1030,9 +1045,8 @@ instance (Outputable thing) => Outputable (HsImplicitBndrs name thing) where
instance (Outputable thing) => Outputable (HsWildCardBndrs name thing) where
ppr (HsWC { hswc_body = ty }) = ppr ty
instance (Outputable name) => Outputable (HsWildCardInfo name) where
instance Outputable (HsWildCardInfo name) where
ppr (AnonWildCard _) = char '_'
ppr (NamedWildCard n) = ppr n
pprHsForAll :: OutputableBndr name => [LHsTyVarBndr name] -> LHsContext name -> SDoc
pprHsForAll = pprHsForAllExtra Nothing
......@@ -1145,7 +1159,6 @@ ppr_mono_ty _ (HsExplicitListTy _ tys) = quote $ brackets (interpp'SP tys)
ppr_mono_ty _ (HsExplicitTupleTy _ tys) = quote $ parens (interpp'SP tys)
ppr_mono_ty _ (HsTyLit t) = ppr_tylit t
ppr_mono_ty _ (HsWildCardTy (AnonWildCard _)) = char '_'
ppr_mono_ty _ (HsWildCardTy (NamedWildCard name)) = ppr name
ppr_mono_ty ctxt_prec (HsEqTy ty1 ty2)
= maybeParen ctxt_prec TyOpPrec $
......
......@@ -89,7 +89,7 @@ templateHaskellNames = [
forallTName, varTName, conTName, appTName, equalityTName,
tupleTName, unboxedTupleTName, arrowTName, listTName, sigTName, litTName,
promotedTName, promotedTupleTName, promotedNilTName, promotedConsTName,
wildCardTName, namedWildCardTName,
wildCardTName,
-- TyLit
numTyLitName, strTyLitName,
-- TyVarBndr
......@@ -391,7 +391,7 @@ forallTName, varTName, conTName, tupleTName, unboxedTupleTName, arrowTName,
listTName, appTName, sigTName, equalityTName, litTName,
promotedTName, promotedTupleTName,
promotedNilTName, promotedConsTName,
wildCardTName, namedWildCardTName :: Name
wildCardTName :: Name
forallTName = libFun (fsLit "forallT") forallTIdKey
varTName = libFun (fsLit "varT") varTIdKey
conTName = libFun (fsLit "conT") conTIdKey
......@@ -408,8 +408,6 @@ promotedTupleTName = libFun (fsLit "promotedTupleT") promotedTupleTIdKey
promotedNilTName = libFun (fsLit "promotedNilT") promotedNilTIdKey
promotedConsTName = libFun (fsLit "promotedConsT") promotedConsTIdKey
wildCardTName = libFun (fsLit "wildCardT") wildCardTIdKey
namedWildCardTName = libFun (fsLit "namedWildCardT") namedWildCardTIdKey
-- data TyLit = ...
numTyLitName, strTyLitName :: Name
......@@ -849,7 +847,7 @@ forallTIdKey, varTIdKey, conTIdKey, tupleTIdKey, unboxedTupleTIdKey, arrowTIdKey
listTIdKey, appTIdKey, sigTIdKey, equalityTIdKey, litTIdKey,
promotedTIdKey, promotedTupleTIdKey,
promotedNilTIdKey, promotedConsTIdKey,
wildCardTIdKey, namedWildCardTIdKey :: Unique
wildCardTIdKey :: Unique
forallTIdKey = mkPreludeMiscIdUnique 380
varTIdKey = mkPreludeMiscIdUnique 381
conTIdKey = mkPreludeMiscIdUnique 382
......@@ -866,7 +864,6 @@ promotedTupleTIdKey = mkPreludeMiscIdUnique 392
promotedNilTIdKey = mkPreludeMiscIdUnique 393
promotedConsTIdKey = mkPreludeMiscIdUnique 394
wildCardTIdKey = mkPreludeMiscIdUnique 395
namedWildCardTIdKey = mkPreludeMiscIdUnique 396
-- data TyLit = ...
numTyLitIdKey, strTyLitIdKey :: Unique
......
......@@ -1667,7 +1667,7 @@ rnConDeclDetails _ doc (InfixCon ty1 ty2)
rnConDeclDetails con doc (RecCon (L l fields))
= do { fls <- lookupConstructorFields con
; (new_fields, fvs) <- rnConDeclFields fls doc fields
; (new_fields, fvs) <- rnConDeclFields doc fls fields
-- No need to check for duplicate fields
-- since that is done by RnNames.extendGlobalRdrEnvRn
; return (RecCon (L l new_fields), fvs) }
......
This diff is collapsed.
......@@ -618,10 +618,7 @@ equalityT :: TypeQ
equalityT = return EqualityT
wildCardT :: TypeQ
wildCardT = return (WildCardT Nothing)
namedWildCardT :: Name -> TypeQ
namedWildCardT = return . WildCardT . Just
wildCardT = return WildCardT
{-# DEPRECATED classP "As of template-haskell-2.10, constraint predicates (Pred) are just types (Type), in keeping with ConstraintKinds. Please use 'conT' and 'appT'." #-}
classP :: Name -> [Q Type] -> Q Pred
......
......@@ -611,7 +611,7 @@ pprParendType PromotedConsT = text "(':)"
pprParendType StarT = char '*'
pprParendType ConstraintT = text "Constraint"
pprParendType (SigT ty k) = parens (ppr ty <+> text "::" <+> ppr k)
pprParendType (WildCardT mbName) = char '_' <> maybe empty ppr mbName
pprParendType WildCardT = char '_'
pprParendType (InfixT x n y) = parens (ppr x <+> pprName' Infix n <+> ppr y)
pprParendType t@(UInfixT {}) = parens (pprUInfixT t)
pprParendType (ParensT t) = ppr t
......
......@@ -1698,7 +1698,7 @@ data Type = ForallT [TyVarBndr] Cxt Type -- ^ @forall \<vars\>. \<ctxt\> -> \<t
| StarT -- ^ @*@
| ConstraintT -- ^ @Constraint@
| LitT TyLit -- ^ @0,1,2, etc.@
| WildCardT (Maybe Name) -- ^ @_, _a, etc.@
| WildCardT -- ^ @_,
deriving( Show, Eq, Ord, Data, Typeable, Generic )
data TyVarBndr = PlainTV Name -- ^ @a@
......
[SigD foo_1 (ForallT [PlainTV a_0] [] (AppT (AppT ArrowT (VarT a_0)) (VarT a_0))),FunD foo_1 [Clause [VarP x_2] (NormalB (VarE x_2)) []]]
"[SigD foo_ (AppT (AppT ArrowT (WildCardT (Just _a_))) (WildCardT (Just _a_))),FunD foo_ [Clause [VarP x_] (NormalB (VarE x_)) []]]"
[SigD foo_6 (ForallT [PlainTV _a_5] [] (AppT (AppT ArrowT (VarT _a_5)) (VarT _a_5))),FunD foo_6 [Clause [VarP x_7] (NormalB (VarE x_7)) []]]
[SigD foo_1 (ForallT [PlainTV a_0] [] (AppT (AppT ArrowT (VarT a_0)) (VarT a_0))),FunD foo_1 [Clause [VarP x_2] (NormalB (VarE x_2)) []]]
"[SigD foo_ (AppT (AppT ArrowT (VarT _a_)) (VarT _a_)),FunD foo_ [Clause [VarP x_] (NormalB (VarE x_)) []]]"
[SigD foo_6 (ForallT [PlainTV _a_5] [] (AppT (AppT ArrowT (VarT _a_5)) (VarT _a_5))),FunD foo_6 [Clause [VarP x_7] (NormalB (VarE x_7)) []]]
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE NamedWildCards #-}
{-# LANGUAGE TemplateHaskell, NamedWildCards #-}
module Splices where
import Language.Haskell.TH
......
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE PartialTypeSignatures #-}
{-# LANGUAGE TemplateHaskell, PartialTypeSignatures, NamedWildCards #-}
module SplicesUsed where
import Splices
......
{-# LANGUAGE PartialTypeSignatures, NamedWildCards #-}
{-# LANGUAGE ConstraintKinds, PartialTypeSignatures, NamedWildCards #-}
module NamedExtraConstraintsWildcard where
foo :: (Eq a, _a) => a -> a
......
NamedExtraConstraintsWildcard.hs:4:15: error:
Named wildcard ‘_a’ not allowed as an extra-contraint
Use an anonymous wildcard instead
in the type signature for ‘foo’
NamedExtraConstraintsWildcard.hs:5:1: error:
• Could not deduce: t0
from the context: (Eq a, t)
bound by the inferred type for ‘foo’:
(Eq a, t) => a -> a
at NamedExtraConstraintsWildcard.hs:5:1-15
• In the ambiguity check for the inferred type for ‘foo’
To defer the ambiguity check to use sites, enable AllowAmbiguousTypes
When checking the inferred type
foo :: forall a (t :: Constraint). (Eq a, t) => a -> a
Subproject commit a8d1ea9a6735209746b184001e40da26a83f0509
Subproject commit fef5e32ca541eb70b22d8e8da611e4a2b797e00c
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