summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorAlan Zimmerman <alan.zimm@gmail.com>2017-10-21 20:22:59 +0200
committerAlan Zimmerman <alan.zimm@gmail.com>2017-10-21 20:22:59 +0200
commitdd5caaaa88407f97ae913b2b4a2bea57d1da301c (patch)
treef0ab4addb00432b37d4ce4f0c49dac88feb09bfe
parent6994048621498a2d36c81f485fc9f35716a370b4 (diff)
downloadhaskell-wip/ttg-2017-10-13.tar.gz
Remove PostRn / PostTc from HsType, using TTGwip/ttg-2017-10-13
And update haddock submodule to match
Diffstat
-rw-r--r--compiler/deSugar/DsMeta.hs18
-rw-r--r--compiler/hsSyn/Convert.hs11
-rw-r--r--compiler/hsSyn/HsTypes.hs46
-rw-r--r--compiler/hsSyn/HsUtils.hs2
-rw-r--r--compiler/parser/Parser.y10
-rw-r--r--compiler/rename/RnSplice.hs10
-rw-r--r--compiler/rename/RnSplice.hs-boot4
-rw-r--r--compiler/rename/RnTypes.hs59
-rw-r--r--compiler/typecheck/TcHsType.hs14
-rw-r--r--testsuite/tests/parser/should_compile/DumpParsedAst.stderr1
-rw-r--r--testsuite/tests/parser/should_compile/DumpRenamedAst.stderr87
m---------utils/haddock0
12 files changed, 130 insertions, 132 deletions
diff --git a/compiler/deSugar/DsMeta.hs b/compiler/deSugar/DsMeta.hs
index 025710e2e5..3a1b7af4f1 100644
--- a/compiler/deSugar/DsMeta.hs
+++ b/compiler/deSugar/DsMeta.hs
@@ -1053,18 +1053,18 @@ repTy (HsKindSig _ t k) = do
t1 <- repLTy t
k1 <- repLTy k
repTSig t1 k1
-repTy (HsSpliceTy _ splice _) = repSplice splice
-repTy (HsExplicitListTy _ _ _ tys) = do
- tys1 <- repLTys tys
- repTPromotedList tys1
-repTy (HsExplicitTupleTy _ _ tys) = do
- tys1 <- repLTys tys
- tcon <- repPromotedTupleTyCon (length tys)
- repTapps tcon tys1
+repTy (HsSpliceTy _ splice) = repSplice splice
+repTy (HsExplicitListTy _ _ tys) = do
+ tys1 <- repLTys tys
+ repTPromotedList tys1
+repTy (HsExplicitTupleTy _ tys) = do
+ tys1 <- repLTys tys
+ tcon <- repPromotedTupleTyCon (length tys)
+ repTapps tcon tys1
repTy (HsTyLit _ lit) = do
lit' <- repTyLit lit
repTLit lit'
-repTy (HsWildCardTy _ (AnonWildCard _)) = repTWildCard
+repTy (HsWildCardTy (AnonWildCard _)) = repTWildCard
repTy ty = notHandled "Exotic form of type" (ppr ty)
diff --git a/compiler/hsSyn/Convert.hs b/compiler/hsSyn/Convert.hs
index 0c1f700e0e..412ec5901e 100644
--- a/compiler/hsSyn/Convert.hs
+++ b/compiler/hsSyn/Convert.hs
@@ -1294,20 +1294,17 @@ cvtTypeKind ty_str ty
| n == 1
-> failWith (ptext (sLit ("Illegal promoted 1-tuple " ++ ty_str)))
| m == n -- Saturated
- -> do { let kis = replicate m placeHolderKind
- ; returnL (HsExplicitTupleTy PlaceHolder kis tys')
- }
+ -> returnL (HsExplicitTupleTy PlaceHolder tys')
where
m = length tys'
PromotedNilT
- -> returnL (HsExplicitListTy PlaceHolder Promoted placeHolderKind [])
+ -> returnL (HsExplicitListTy PlaceHolder Promoted [])
PromotedConsT -- See Note [Representing concrete syntax in types]
-- in Language.Haskell.TH.Syntax
- | [ty1, L _ (HsExplicitListTy _ ip _ tys2)] <- tys'
- -> returnL (HsExplicitListTy PlaceHolder ip
- placeHolderKind (ty1:tys2))
+ | [ty1, L _ (HsExplicitListTy _ ip tys2)] <- tys'
+ -> returnL (HsExplicitListTy PlaceHolder ip (ty1:tys2))
| otherwise
-> mk_apps (HsTyVar PlaceHolder NotPromoted (noLoc (getRdrName consDataCon)))
tys'
diff --git a/compiler/hsSyn/HsTypes.hs b/compiler/hsSyn/HsTypes.hs
index 01a21532ca..2766c40dcb 100644
--- a/compiler/hsSyn/HsTypes.hs
+++ b/compiler/hsSyn/HsTypes.hs
@@ -45,7 +45,7 @@ module HsTypes (
rdrNameAmbiguousFieldOcc, selectorAmbiguousFieldOcc,
unambiguousFieldOcc, ambiguousFieldOcc,
- HsWildCardInfo(..), mkAnonWildCardTy,
+ HsWildCardInfo(..), mkAnonWildCardTy, pprAnonWildCard,
wildCardName, sameWildCard,
mkHsImplicitBndrs, mkHsWildCardBndrs, hsImplicitBody,
@@ -555,7 +555,7 @@ data HsType pass
| HsSpliceTy (XSpliceTy pass)
(HsSplice pass) -- Includes quasi-quotes
- (PostTc pass Kind)
+ -- (PostTc pass Kind)
-- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @'$('@,
-- 'ApiAnnotation.AnnClose' @')'@
@@ -592,7 +592,7 @@ data HsType pass
| HsExplicitListTy -- A promoted explicit list
(XExplicitListTy pass)
Promoted -- whether explcitly promoted, for pretty printer
- (PostTc pass Kind) -- See Note [Promoted lists and tuples]
+ -- (PostTc pass Kind) -- See Note [Promoted lists and tuples]
[LHsType pass]
-- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @"'["@,
-- 'ApiAnnotation.AnnClose' @']'@
@@ -601,7 +601,7 @@ data HsType pass
| HsExplicitTupleTy -- A promoted explicit tuple
(XExplicitTupleTy pass)
- [PostTc pass Kind] -- See Note [Promoted lists and tuples]
+ -- [PostTc pass Kind] -- See Note [Promoted lists and tuples]
[LHsType pass]
-- ^ - 'ApiAnnotation.AnnKeywordId' : 'ApiAnnotation.AnnOpen' @"'("@,
-- 'ApiAnnotation.AnnClose' @')'@
@@ -613,7 +613,8 @@ data HsType pass
-- For details on above see note [Api annotations] in ApiAnnotation
- | HsWildCardTy (XWildCardTy pass) (HsWildCardInfo pass) -- A type wildcard
+ | HsWildCardTy (XWildCardTy pass) -- A type wildcard
+ -- (HsWildCardInfo pass)
-- See Note [The wildcard story for types]
-- ^ - 'ApiAnnotation.AnnKeywordId' : None
@@ -649,23 +650,30 @@ type instance XIParamTy (GhcPass _) = PlaceHolder
type instance XEqTy (GhcPass _) = PlaceHolder
type instance XKindSig (GhcPass _) = PlaceHolder
--- type instance XSpliceTy (GhcPass _) = PostTc pass Kind
-type instance XSpliceTy (GhcPass _) = PlaceHolder
+type instance XSpliceTy GhcPs = PlaceHolder
+type instance XSpliceTy GhcRn = PlaceHolder
+type instance XSpliceTy GhcTc = Kind
type instance XDocTy (GhcPass _) = PlaceHolder
type instance XBangTy (GhcPass _) = PlaceHolder
type instance XRecTy (GhcPass _) = PlaceHolder
-type instance XExplicitListTy (GhcPass _) = PlaceHolder
-- type instance XExplicitListTy (GhcPass _) = PostTc pass Kind
+type instance XExplicitListTy GhcPs = PlaceHolder
+type instance XExplicitListTy GhcRn = PlaceHolder
+type instance XExplicitListTy GhcTc = Kind
-- type instance XExplicitTupleTy (GhcPass _) = [PostTc pass Kind]
-type instance XExplicitTupleTy (GhcPass _) = PlaceHolder
+type instance XExplicitTupleTy GhcPs = PlaceHolder
+type instance XExplicitTupleTy GhcRn = PlaceHolder
+type instance XExplicitTupleTy GhcTc = [Kind]
type instance XTyLit (GhcPass _) = PlaceHolder
-- type instance XWildCardTy (GhcPass _) = HsWildCardInfo pass
-type instance XWildCardTy (GhcPass _) = PlaceHolder
+type instance XWildCardTy GhcPs = PlaceHolder
+type instance XWildCardTy GhcRn = HsWildCardInfo GhcRn
+type instance XWildCardTy GhcTc = HsWildCardInfo GhcTc
type instance XNewType (GhcPass _) = NewHsTypeX
-- type instance XNewType (GhcPass _) = PlaceHolder
@@ -679,7 +687,8 @@ data HsTyLit
| HsStrTy SourceText FastString
deriving Data
-newtype HsWildCardInfo pass -- See Note [The wildcard story for types]
+-- AZ: fold this into the XWildCardTy completely, removing the type
+newtype HsWildCardInfo pass -- See Note [The wildcard story for types]
= AnonWildCard (PostRn pass (Located Name))
-- A anonymous wild card ('_'). A fresh Name is generated for
-- each individual anonymous wildcard during renaming
@@ -1005,7 +1014,7 @@ ignoreParens ty = ty
-}
mkAnonWildCardTy :: HsType GhcPs
-mkAnonWildCardTy = HsWildCardTy PlaceHolder (AnonWildCard PlaceHolder)
+mkAnonWildCardTy = HsWildCardTy PlaceHolder
mkHsOpTy :: LHsType (GhcPass p) -> Located (IdP (GhcPass p))
-> LHsType (GhcPass p) -> HsType (GhcPass p)
@@ -1269,6 +1278,9 @@ instance (Outputable thing) => Outputable (HsWildCardBndrs pass thing) where
instance Outputable (HsWildCardInfo pass) where
ppr (AnonWildCard _) = char '_'
+pprAnonWildCard :: SDoc
+pprAnonWildCard = char '_'
+
pprHsForAll :: (SourceTextX (GhcPass p), OutputableBndrId (GhcPass p))
=> [LHsTyVarBndr (GhcPass p)] -> LHsContext (GhcPass p) -> SDoc
pprHsForAll = pprHsForAllExtra Nothing
@@ -1389,14 +1401,14 @@ ppr_mono_ty (HsKindSig _ ty kind)
ppr_mono_ty (HsListTy _ ty) = brackets (ppr_mono_lty ty)
ppr_mono_ty (HsPArrTy _ ty) = paBrackets (ppr_mono_lty ty)
ppr_mono_ty (HsIParamTy _ n ty) = (ppr n <+> dcolon <+> ppr_mono_lty ty)
-ppr_mono_ty (HsSpliceTy _ s _) = pprSplice s
-ppr_mono_ty (HsExplicitListTy _ Promoted _ tys)
+ppr_mono_ty (HsSpliceTy _ s) = pprSplice s
+ppr_mono_ty (HsExplicitListTy _ Promoted tys)
= quote $ brackets (interpp'SP tys)
-ppr_mono_ty (HsExplicitListTy _ NotPromoted _ tys)
+ppr_mono_ty (HsExplicitListTy _ NotPromoted tys)
= brackets (interpp'SP tys)
-ppr_mono_ty (HsExplicitTupleTy _ _ tys) = quote $ parens (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 {}) = char '_'
+ppr_mono_ty (HsWildCardTy {}) = char '_'
ppr_mono_ty (HsEqTy _ ty1 ty2)
= ppr_mono_lty ty1 <+> char '~' <+> ppr_mono_lty ty2
diff --git a/compiler/hsSyn/HsUtils.hs b/compiler/hsSyn/HsUtils.hs
index 516895603d..e5907d8d2b 100644
--- a/compiler/hsSyn/HsUtils.hs
+++ b/compiler/hsSyn/HsUtils.hs
@@ -342,7 +342,7 @@ mkHsSpliceTE hasParen e = HsSpliceE (HsTypedSplice hasParen unqualSplice e)
mkHsSpliceTy :: SpliceDecoration -> LHsExpr GhcPs -> HsType GhcPs
mkHsSpliceTy hasParen e = HsSpliceTy PlaceHolder
- (HsUntypedSplice hasParen unqualSplice e) placeHolderKind
+ (HsUntypedSplice hasParen unqualSplice e)
mkHsQuasiQuote :: RdrName -> SrcSpan -> FastString -> HsSplice GhcPs
mkHsQuasiQuote quoter span quote = HsQuasiQuote unqualSplice quoter span quote
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index 2304e2cacc..268576f0c8 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -1896,7 +1896,7 @@ atype :: { LHsType GhcPs }
| '(' ctype ')' {% ams (sLL $1 $> $ HsParTy PlaceHolder $2) [mop $1,mcp $3] }
| '(' ctype '::' kind ')' {% ams (sLL $1 $> $ HsKindSig PlaceHolder $2 $4)
[mop $1,mu AnnDcolon $3,mcp $5] }
- | quasiquote { sL1 $1 (HsSpliceTy PlaceHolder (unLoc $1) placeHolderKind) }
+ | quasiquote { sL1 $1 (HsSpliceTy PlaceHolder (unLoc $1)) }
| '$(' exp ')' {% ams (sLL $1 $> $ mkHsSpliceTy HasParens $2)
[mj AnnOpenPE $1,mj AnnCloseP $3] }
| TH_ID_SPLICE {%ams (sLL $1 $> $ mkHsSpliceTy HasDollar $ sL1 $1 $ HsVar $
@@ -1906,10 +1906,9 @@ atype :: { LHsType GhcPs }
| SIMPLEQUOTE qcon_nowiredlist {% ams (sLL $1 $> $ HsTyVar PlaceHolder Promoted $2) [mj AnnSimpleQuote $1,mj AnnName $2] }
| SIMPLEQUOTE '(' ctype ',' comma_types1 ')'
{% addAnnotation (gl $3) AnnComma (gl $4) >>
- ams (sLL $1 $> $ HsExplicitTupleTy PlaceHolder [] ($3 : $5))
+ ams (sLL $1 $> $ HsExplicitTupleTy PlaceHolder ($3 : $5))
[mj AnnSimpleQuote $1,mop $2,mcp $6] }
- | SIMPLEQUOTE '[' comma_types0 ']' {% ams (sLL $1 $> $ HsExplicitListTy PlaceHolder Promoted
- placeHolderKind $3)
+ | SIMPLEQUOTE '[' comma_types0 ']' {% ams (sLL $1 $> $ HsExplicitListTy PlaceHolder Promoted $3)
[mj AnnSimpleQuote $1,mos $2,mcs $4] }
| SIMPLEQUOTE var {% ams (sLL $1 $> $ HsTyVar PlaceHolder Promoted $2)
[mj AnnSimpleQuote $1,mj AnnName $2] }
@@ -1920,8 +1919,7 @@ atype :: { LHsType GhcPs }
-- so you have to quote those.)
| '[' ctype ',' comma_types1 ']' {% addAnnotation (gl $2) AnnComma
(gl $3) >>
- ams (sLL $1 $> $ HsExplicitListTy PlaceHolder NotPromoted
- placeHolderKind ($2 : $4))
+ ams (sLL $1 $> $ HsExplicitListTy PlaceHolder NotPromoted ($2 : $4))
[mos $1,mcs $5] }
| INTEGER { sLL $1 $> $ HsTyLit PlaceHolder $ HsNumTy (getINTEGERs $1)
(il_value (getINTEGER $1)) }
diff --git a/compiler/rename/RnSplice.hs b/compiler/rename/RnSplice.hs
index 9577a4c262..f1ea99f361 100644
--- a/compiler/rename/RnSplice.hs
+++ b/compiler/rename/RnSplice.hs
@@ -18,7 +18,6 @@ import NameSet
import HsSyn
import RdrName
import TcRnMonad
-import Kind
import RnEnv
import RnUtils ( HsDocContext(..), newLocalBndrRn )
@@ -521,14 +520,13 @@ References:
-}
----------------------
-rnSpliceType :: HsSplice GhcPs -> PostTc GhcRn Kind
- -> RnM (HsType GhcRn, FreeVars)
-rnSpliceType splice k
+rnSpliceType :: HsSplice GhcPs -> RnM (HsType GhcRn, FreeVars)
+rnSpliceType splice
= rnSpliceGen run_type_splice pend_type_splice splice
where
pend_type_splice rn_splice
= ( makePending UntypedTypeSplice rn_splice
- , HsSpliceTy PlaceHolder rn_splice k)
+ , HsSpliceTy PlaceHolder rn_splice)
run_type_splice rn_splice
= do { traceRn "rnSpliceType: untyped type splice" empty
@@ -538,7 +536,7 @@ rnSpliceType splice k
; checkNoErrs $ rnLHsType doc hs_ty2 }
-- checkNoErrs: see Note [Renamer errors]
-- See Note [Delaying modFinalizers in untyped splices].
- ; return ( HsParTy PlaceHolder $ flip (HsSpliceTy PlaceHolder) k
+ ; return ( HsParTy PlaceHolder $ HsSpliceTy PlaceHolder
. HsSpliced (ThModFinalizers mod_finalizers)
. HsSplicedTy <$>
hs_ty3
diff --git a/compiler/rename/RnSplice.hs-boot b/compiler/rename/RnSplice.hs-boot
index d8f0f1fc7f..7844acd2c9 100644
--- a/compiler/rename/RnSplice.hs-boot
+++ b/compiler/rename/RnSplice.hs-boot
@@ -4,11 +4,9 @@ import GhcPrelude
import HsSyn
import TcRnMonad
import NameSet
-import Kind
-rnSpliceType :: HsSplice GhcPs -> PostTc GhcRn Kind
- -> RnM (HsType GhcRn, FreeVars)
+rnSpliceType :: HsSplice GhcPs -> RnM (HsType GhcRn, FreeVars)
rnSplicePat :: HsSplice GhcPs -> RnM ( Either (Pat GhcPs) (Pat GhcRn)
, FreeVars )
rnSpliceDecl :: SpliceDecl GhcPs -> RnM (SpliceDecl GhcRn, FreeVars)
diff --git a/compiler/rename/RnTypes.hs b/compiler/rename/RnTypes.hs
index 9d50d6bc87..709f3d0315 100644
--- a/compiler/rename/RnTypes.hs
+++ b/compiler/rename/RnTypes.hs
@@ -161,12 +161,12 @@ rnWcBody ctxt nwc_rdrs hs_ty
rn_ty env (HsQualTy { hst_ctxt = L cx hs_ctxt, hst_body = hs_ty })
| Just (hs_ctxt1, hs_ctxt_last) <- snocView hs_ctxt
- , L lx (HsWildCardTy _ wc) <- ignoreParens hs_ctxt_last
+ , L lx (HsWildCardTy _) <- ignoreParens hs_ctxt_last
= do { (hs_ctxt1', fvs1) <- mapFvRn (rn_top_constraint env) hs_ctxt1
; wc' <- setSrcSpan lx $
- do { checkExtraConstraintWildCard env wc
- ; rnAnonWildCard wc }
- ; let hs_ctxt' = hs_ctxt1' ++ [L lx (HsWildCardTy PlaceHolder wc')]
+ do { checkExtraConstraintWildCard env
+ ; rnAnonWildCard }
+ ; let hs_ctxt' = hs_ctxt1' ++ [L lx (HsWildCardTy wc')]
; (hs_ty', fvs2) <- rnLHsTyKi env hs_ty
; return (HsQualTy { hst_xqual = PlaceHolder
, hst_ctxt = L cx hs_ctxt', hst_body = hs_ty' }
@@ -184,17 +184,16 @@ rnWcBody ctxt nwc_rdrs hs_ty
rn_top_constraint env = rnLHsTyKi (env { rtke_what = RnTopConstraint })
-checkExtraConstraintWildCard :: RnTyKiEnv -> HsWildCardInfo GhcPs
- -> RnM ()
+checkExtraConstraintWildCard :: RnTyKiEnv -> RnM ()
-- Rename the extra-constraint spot in a type signature
-- (blah, _) => type
-- Check that extra-constraints are allowed at all, and
-- if so that it's an anonymous wildcard
-checkExtraConstraintWildCard env wc
+checkExtraConstraintWildCard env
= checkWildCard env mb_bad
where
mb_bad | not (extraConstraintWildCardsAllowed env)
- = Just (text "Extra-constraint wildcard" <+> quotes (ppr wc)
+ = Just (text "Extra-constraint wildcard" <+> quotes (pprAnonWildCard)
<+> text "not allowed")
| otherwise
= Nothing
@@ -689,8 +688,8 @@ rnHsTyKi env t@(HsEqTy _ ty1 ty2)
; (ty2', fvs2) <- rnLHsTyKi env ty2
; return (HsEqTy PlaceHolder ty1' ty2', fvs1 `plusFV` fvs2) }
-rnHsTyKi _ (HsSpliceTy _ sp k)
- = rnSpliceType sp k
+rnHsTyKi _ (HsSpliceTy _ sp)
+ = rnSpliceType sp
rnHsTyKi env (HsDocTy _ ty haddock_doc)
= do { (ty', fvs) <- rnLHsTyKi env ty
@@ -702,24 +701,24 @@ rnHsTyKi _ (NewHsType (NHsCoreTy ty))
-- The emptyFVs probably isn't quite right
-- but I don't think it matters
-rnHsTyKi env ty@(HsExplicitListTy _ ip k tys)
+rnHsTyKi env ty@(HsExplicitListTy _ ip tys)
= do { checkTypeInType env ty
; data_kinds <- xoptM LangExt.DataKinds
; unless data_kinds (addErr (dataKindsErr env ty))
; (tys', fvs) <- mapFvRn (rnLHsTyKi env) tys
- ; return (HsExplicitListTy PlaceHolder ip k tys', fvs) }
+ ; return (HsExplicitListTy PlaceHolder ip tys', fvs) }
-rnHsTyKi env ty@(HsExplicitTupleTy _ kis tys)
+rnHsTyKi env ty@(HsExplicitTupleTy _ tys)
= do { checkTypeInType env ty
; data_kinds <- xoptM LangExt.DataKinds
; unless data_kinds (addErr (dataKindsErr env ty))
; (tys', fvs) <- mapFvRn (rnLHsTyKi env) tys
- ; return (HsExplicitTupleTy PlaceHolder kis tys', fvs) }
+ ; return (HsExplicitTupleTy PlaceHolder tys', fvs) }
-rnHsTyKi env (HsWildCardTy _ wc)
- = do { checkAnonWildCard env wc
- ; wc' <- rnAnonWildCard wc
- ; return (HsWildCardTy PlaceHolder wc', emptyFVs) }
+rnHsTyKi env (HsWildCardTy _)
+ = do { checkAnonWildCard env
+ ; wc' <- rnAnonWildCard
+ ; return (HsWildCardTy wc', emptyFVs) }
-- emptyFVs: this occurrence does not refer to a
-- user-written binding site, so don't treat
-- it as a free variable
@@ -765,21 +764,21 @@ checkWildCard env (Just doc)
checkWildCard _ Nothing
= return ()
-checkAnonWildCard :: RnTyKiEnv -> HsWildCardInfo GhcPs -> RnM ()
+checkAnonWildCard :: RnTyKiEnv -> RnM ()
-- Report an error if an anonymous wildcard is illegal here
-checkAnonWildCard env wc
+checkAnonWildCard env
= checkWildCard env mb_bad
where
mb_bad :: Maybe SDoc
mb_bad | not (wildCardsAllowed env)
- = Just (notAllowed (ppr wc))
+ = Just (notAllowed pprAnonWildCard)
| otherwise
= case rtke_what env of
RnTypeBody -> Nothing
RnConstraint -> Just constraint_msg
RnTopConstraint -> Just constraint_msg
- constraint_msg = hang (notAllowed (ppr wc) <+> text "in a constraint")
+ constraint_msg = hang (notAllowed pprAnonWildCard <+> text "in a constraint")
2 hint_msg
hint_msg = vcat [ text "except as the last top-level constraint of a type signature"
, nest 2 (text "e.g f :: (Eq a, _) => blah") ]
@@ -815,8 +814,8 @@ wildCardsAllowed env
HsTypeCtx {} -> True
_ -> False
-rnAnonWildCard :: HsWildCardInfo GhcPs -> RnM (HsWildCardInfo GhcRn)
-rnAnonWildCard (AnonWildCard _)
+rnAnonWildCard :: RnM (HsWildCardInfo GhcRn)
+rnAnonWildCard
= do { loc <- getSrcSpanM
; uniq <- newUnique
; let name = mkInternalName uniq (mkTyVarOcc "_") loc
@@ -1091,7 +1090,7 @@ collectAnonWildCards :: LHsType GhcRn -> [Name]
collectAnonWildCards lty = go lty
where
go (L _ ty) = case ty of
- HsWildCardTy _ (AnonWildCard (L _ wc)) -> [wc]
+ HsWildCardTy (AnonWildCard (L _ wc)) -> [wc]
HsAppsTy _ tys -> gos (mapMaybe (prefix_types_only . unLoc) tys)
HsAppTy _ ty1 ty2 -> go ty1 `mappend` go ty2
HsFunTy _ ty1 ty2 -> go ty1 `mappend` go ty2
@@ -1107,14 +1106,14 @@ collectAnonWildCards lty = go lty
HsDocTy _ ty _ -> go ty
HsBangTy _ _ ty -> go ty
HsRecTy _ flds -> gos $ map (cd_fld_type . unLoc) flds
- HsExplicitListTy _ _ _ tys -> gos tys
- HsExplicitTupleTy _ _ tys -> gos tys
+ HsExplicitListTy _ _ tys -> gos tys
+ HsExplicitTupleTy _ tys -> gos tys
HsForAllTy { hst_bndrs = bndrs
, hst_body = ty } -> collectAnonWildCardsBndrs bndrs
`mappend` go ty
HsQualTy { hst_ctxt = L _ ctxt
, hst_body = ty } -> gos ctxt `mappend` go ty
- HsSpliceTy _ (HsSpliced _ (HsSplicedTy ty)) _ -> go $ L noSrcSpan ty
+ HsSpliceTy _ (HsSpliced _ (HsSplicedTy ty)) -> go $ L noSrcSpan ty
HsSpliceTy{} -> mempty
HsTyLit{} -> mempty
HsTyVar{} -> mempty
@@ -1796,8 +1795,8 @@ extract_lty t_or_k (L _ ty) acc
HsParTy _ ty -> extract_lty t_or_k ty acc
HsSpliceTy {} -> return acc -- Type splices mention no tvs
HsDocTy _ ty _ -> extract_lty t_or_k ty acc
- HsExplicitListTy _ _ _ tys -> extract_ltys t_or_k tys acc
- HsExplicitTupleTy _ _ tys -> extract_ltys t_or_k tys acc
+ HsExplicitListTy _ _ tys -> extract_ltys t_or_k tys acc
+ HsExplicitTupleTy _ tys -> extract_ltys t_or_k tys acc
HsTyLit _ _ -> return acc
HsKindSig _ ty ki -> extract_lty t_or_k ty =<<
extract_lkind ki acc
diff --git a/compiler/typecheck/TcHsType.hs b/compiler/typecheck/TcHsType.hs
index 633e586901..d055f965c5 100644
--- a/compiler/typecheck/TcHsType.hs
+++ b/compiler/typecheck/TcHsType.hs
@@ -506,7 +506,7 @@ tc_infer_hs_type mode (HsKindSig _ ty sig)
-- splices or not.
--
-- See Note [Delaying modFinalizers in untyped splices].
-tc_infer_hs_type mode (HsSpliceTy _ (HsSpliced _ (HsSplicedTy ty)) _)
+tc_infer_hs_type mode (HsSpliceTy _ (HsSpliced _ (HsSplicedTy ty)))
= tc_infer_hs_type mode ty
tc_infer_hs_type mode (HsDocTy _ ty _) = tc_infer_lhs_type mode ty
tc_infer_hs_type _ (NewHsType (NHsCoreTy ty)) = return (ty, typeKind ty)
@@ -559,9 +559,7 @@ tc_hs_type _ ty@(HsRecTy _ _) _
-- while capturing the local environment.
--
-- See Note [Delaying modFinalizers in untyped splices].
-tc_hs_type mode (HsSpliceTy _ (HsSpliced mod_finalizers (HsSplicedTy ty))
- _
- )
+tc_hs_type mode (HsSpliceTy _ (HsSpliced mod_finalizers (HsSplicedTy ty)))
exp_kind
= do addModFinalizersWithLclEnv mod_finalizers
tc_hs_type mode ty exp_kind
@@ -671,7 +669,7 @@ tc_hs_type mode rn_ty@(HsSumTy _ hs_tys) exp_kind
}
--------- Promoted lists and tuples
-tc_hs_type mode rn_ty@(HsExplicitListTy _ _ _k tys) exp_kind
+tc_hs_type mode rn_ty@(HsExplicitListTy _ _ tys) exp_kind
= do { tks <- mapM (tc_infer_lhs_type mode) tys
; (taus', kind) <- unifyKinds tys tks
; let ty = (foldr (mk_cons kind) (mk_nil kind) taus')
@@ -680,7 +678,7 @@ tc_hs_type mode rn_ty@(HsExplicitListTy _ _ _k tys) exp_kind
mk_cons k a b = mkTyConApp (promoteDataCon consDataCon) [k, a, b]
mk_nil k = mkTyConApp (promoteDataCon nilDataCon) [k]
-tc_hs_type mode rn_ty@(HsExplicitTupleTy _ _ tys) exp_kind
+tc_hs_type mode rn_ty@(HsExplicitTupleTy _ tys) exp_kind
-- using newMetaKindVar means that we force instantiations of any polykinded
-- types. At first, I just used tc_infer_lhs_type, but that led to #11255.
= do { ks <- replicateM arity newMetaKindVar
@@ -726,7 +724,7 @@ tc_hs_type mode ty@(HsOpTy {}) ek = tc_infer_hs_type_ek mode ty ek
tc_hs_type mode ty@(HsKindSig {}) ek = tc_infer_hs_type_ek mode ty ek
tc_hs_type mode ty@(NewHsType (NHsCoreTy {})) ek = tc_infer_hs_type_ek mode ty ek
-tc_hs_type _ (HsWildCardTy _ wc) exp_kind
+tc_hs_type _ (HsWildCardTy wc) exp_kind
= do { wc_tv <- tcWildCardOcc wc exp_kind
; return (mkTyVarTy wc_tv) }
@@ -2027,7 +2025,7 @@ tcHsPartialSigType ctxt sig_ty
tcPartialContext :: HsContext GhcRn -> TcM (TcThetaType, Maybe TcTyVar)
tcPartialContext hs_theta
| Just (hs_theta1, hs_ctxt_last) <- snocView hs_theta
- , L _ (HsWildCardTy _ wc) <- ignoreParens hs_ctxt_last
+ , L _ (HsWildCardTy wc) <- ignoreParens hs_ctxt_last
= do { wc_tv <- tcWildCardOcc wc constraintKind
; theta <- mapM tcLHsPredType hs_theta1
; return (theta, Just wc_tv) }
diff --git a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr
index 194fb2ad80..01ebfb049a 100644
--- a/testsuite/tests/parser/should_compile/DumpParsedAst.stderr
+++ b/testsuite/tests/parser/should_compile/DumpParsedAst.stderr
@@ -152,7 +152,6 @@
(HsExplicitListTy
(PlaceHolder)
(Promoted)
- (PlaceHolder)
[]))]
(Prefix)
({ DumpParsedAst.hs:9:21-24 }
diff --git a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
index a4508f5946..822e67f39f 100644
--- a/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
+++ b/testsuite/tests/parser/should_compile/DumpRenamedAst.stderr
@@ -6,49 +6,49 @@
(HsGroup
(NewValBindsLR
(NValBindsOut
- [((,)
- (NonRecursive)
- {Bag(Located (HsBind Name)):
- [({ DumpRenamedAst.hs:18:1-23 }
- (FunBind
- ({ DumpRenamedAst.hs:18:1-4 }
- {Name: DumpRenamedAst.main})
- (MG
- ({ DumpRenamedAst.hs:18:1-23 }
- [({ DumpRenamedAst.hs:18:1-23 }
- (Match
- (FunRhs
- ({ DumpRenamedAst.hs:18:1-4 }
- {Name: DumpRenamedAst.main})
- (Prefix)
- (NoSrcStrict))
- []
- (GRHSs
- [({ DumpRenamedAst.hs:18:6-23 }
- (GRHS
- []
- ({ DumpRenamedAst.hs:18:8-23 }
- (HsApp
- ({ DumpRenamedAst.hs:18:8-15 }
- (HsVar
- ({ DumpRenamedAst.hs:18:8-15 }
- {Name: System.IO.putStrLn})))
- ({ DumpRenamedAst.hs:18:17-23 }
- (HsLit
- (HsString
- (SourceText
- "\"hello\"")
- {FastString: "hello"})))))))]
- ({ <no location info> }
- (EmptyLocalBinds)))))])
- []
- (PlaceHolder)
- (FromSource))
- (WpHole)
- {NameSet:
- []}
- []))]})]
- []))
+ [((,)
+ (NonRecursive)
+ {Bag(Located (HsBind Name)):
+ [({ DumpRenamedAst.hs:18:1-23 }
+ (FunBind
+ ({ DumpRenamedAst.hs:18:1-4 }
+ {Name: DumpRenamedAst.main})
+ (MG
+ ({ DumpRenamedAst.hs:18:1-23 }
+ [({ DumpRenamedAst.hs:18:1-23 }
+ (Match
+ (FunRhs
+ ({ DumpRenamedAst.hs:18:1-4 }
+ {Name: DumpRenamedAst.main})
+ (Prefix)
+ (NoSrcStrict))
+ []
+ (GRHSs
+ [({ DumpRenamedAst.hs:18:6-23 }
+ (GRHS
+ []
+ ({ DumpRenamedAst.hs:18:8-23 }
+ (HsApp
+ ({ DumpRenamedAst.hs:18:8-15 }
+ (HsVar
+ ({ DumpRenamedAst.hs:18:8-15 }
+ {Name: System.IO.putStrLn})))
+ ({ DumpRenamedAst.hs:18:17-23 }
+ (HsLit
+ (HsString
+ (SourceText
+ "\"hello\"")
+ {FastString: "hello"})))))))]
+ ({ <no location info> }
+ (EmptyLocalBinds)))))])
+ []
+ (PlaceHolder)
+ (FromSource))
+ (WpHole)
+ {NameSet:
+ []}
+ []))]})]
+ []))
[]
[(TyClGroup
[({ DumpRenamedAst.hs:6:1-30 }
@@ -173,7 +173,6 @@
(HsExplicitListTy
(PlaceHolder)
(Promoted)
- (PlaceHolder)
[]))]
(Prefix)
({ DumpRenamedAst.hs:10:21-24 }
diff --git a/utils/haddock b/utils/haddock
-Subproject 361187700635d87b74111f3198ca9835fdc6db2
+Subproject 8a68723536c32d6bd13388f8e1a22b150769175
View Lorry Controller Status