summaryrefslogtreecommitdiff
path: root/compiler/parser
diff options
context:
space:
mode:
authorBen Gamari <ben@smart-cactus.org>2017-11-21 14:28:58 -0500
committerBen Gamari <ben@smart-cactus.org>2017-11-21 16:36:43 -0500
commit314bc31489f1f4cd69e913c3b1e33236b2bdf553 (patch)
treeb960f9b02ec06f9d61df019f53655b4e53847bd7 /compiler/parser
parent0b20d9c51d627febab34b826fccf522ca8bac323 (diff)
downloadhaskell-314bc31489f1f4cd69e913c3b1e33236b2bdf553.tar.gz
Revert "trees that grow" work
As documented in #14490, the Data instances currently blow up compilation time by too much to stomach. Alan will continue working on this in a branch and we will perhaps merge to 8.2 before 8.2.1 to avoid having to perform painful cherry-picks in 8.2 minor releases. Reverts haddock submodule. This reverts commit 47ad6578ea460999b53eb4293c3a3b3017a56d65. This reverts commit e3ec2e7ae94524ebd111963faf34b84d942265b4. This reverts commit 438dd1cbba13d35f3452b4dcef3f94ce9a216905. This reverts commit 0ff152c9e633accca48815e26e59d1af1fe44ceb.
Diffstat (limited to 'compiler/parser')
-rw-r--r--compiler/parser/Parser.y256
-rw-r--r--compiler/parser/RdrHsSyn.hs250
2 files changed, 252 insertions, 254 deletions
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index 51ce8637a4..d4a26895d6 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -1739,15 +1739,13 @@ ctype :: { LHsType GhcPs }
: 'forall' tv_bndrs '.' ctype {% hintExplicitForall (getLoc $1) >>
ams (sLL $1 $> $
HsForAllTy { hst_bndrs = $2
- , hst_xforall = noExt
, hst_body = $4 })
[mu AnnForall $1, mj AnnDot $3] }
| context '=>' ctype {% addAnnotation (gl $1) (toUnicodeAnn AnnDarrow $2) (gl $2)
>> return (sLL $1 $> $
HsQualTy { hst_ctxt = $1
- , hst_xqual = noExt
, hst_body = $3 }) }
- | ipvar '::' type {% ams (sLL $1 $> (HsIParamTy noExt $1 $3))
+ | ipvar '::' type {% ams (sLL $1 $> (HsIParamTy $1 $3))
[mu AnnDcolon $2] }
| type { $1 }
@@ -1766,15 +1764,13 @@ ctypedoc :: { LHsType GhcPs }
: 'forall' tv_bndrs '.' ctypedoc {% hintExplicitForall (getLoc $1) >>
ams (sLL $1 $> $
HsForAllTy { hst_bndrs = $2
- , hst_xforall = noExt
, hst_body = $4 })
[mu AnnForall $1,mj AnnDot $3] }
| context '=>' ctypedoc {% addAnnotation (gl $1) (toUnicodeAnn AnnDarrow $2) (gl $2)
>> return (sLL $1 $> $
HsQualTy { hst_ctxt = $1
- , hst_xqual = noExt
, hst_body = $3 }) }
- | ipvar '::' type {% ams (sLL $1 $> (HsIParamTy noExt $1 $3))
+ | ipvar '::' type {% ams (sLL $1 $> (HsIParamTy $1 $3))
[mu AnnDcolon $2] }
| typedoc { $1 }
@@ -1826,32 +1822,31 @@ is connected to the first type too.
type :: { LHsType GhcPs }
: btype { $1 }
| btype '->' ctype {% ams $1 [mu AnnRarrow $2] -- See note [GADT decl discards annotations]
- >> ams (sLL $1 $> $ HsFunTy noExt $1 $3)
+ >> ams (sLL $1 $> $ HsFunTy $1 $3)
[mu AnnRarrow $2] }
typedoc :: { LHsType GhcPs }
: btype { $1 }
- | btype docprev { sLL $1 $> $ HsDocTy noExt $1 $2 }
- | btype '->' ctypedoc {% ams (sLL $1 $> $ HsFunTy noExt $1 $3)
+ | btype docprev { sLL $1 $> $ HsDocTy $1 $2 }
+ | btype '->' ctypedoc {% ams (sLL $1 $> $ HsFunTy $1 $3)
[mu AnnRarrow $2] }
| btype docprev '->' ctypedoc {% ams (sLL $1 $> $
- HsFunTy noExt (L (comb2 $1 $2)
- (HsDocTy noExt $1 $2))
+ HsFunTy (L (comb2 $1 $2) (HsDocTy $1 $2))
$4)
[mu AnnRarrow $3] }
-- See Note [Parsing ~]
btype :: { LHsType GhcPs }
: tyapps {% splitTildeApps (reverse (unLoc $1)) >>=
- \ts -> return $ sL1 $1 $ HsAppsTy noExt ts }
+ \ts -> return $ sL1 $1 $ HsAppsTy ts }
-- Used for parsing Haskell98-style data constructors,
-- in order to forbid the blasphemous
-- > data Foo = Int :+ Char :* Bool
-- See also Note [Parsing data constructors is hard] in RdrHsSyn
btype_no_ops :: { LHsType GhcPs }
- : btype_no_ops atype { sLL $1 $> $ HsAppTy noExt $1 $2 }
+ : btype_no_ops atype { sLL $1 $> $ HsAppTy $1 $2 }
| atype { $1 }
tyapps :: { Located [LHsAppType GhcPs] } -- NB: This list is reversed
@@ -1860,57 +1855,58 @@ tyapps :: { Located [LHsAppType GhcPs] } -- NB: This list is reversed
-- See Note [HsAppsTy] in HsTypes
tyapp :: { LHsAppType GhcPs }
- : atype { sL1 $1 $ HsAppPrefix noExt $1 }
- | qtyconop { sL1 $1 $ HsAppInfix noExt $1 }
- | tyvarop { sL1 $1 $ HsAppInfix noExt $1 }
- | SIMPLEQUOTE qconop {% ams (sLL $1 $> $ HsAppInfix noExt $2)
+ : atype { sL1 $1 $ HsAppPrefix $1 }
+ | qtyconop { sL1 $1 $ HsAppInfix $1 }
+ | tyvarop { sL1 $1 $ HsAppInfix $1 }
+ | SIMPLEQUOTE qconop {% ams (sLL $1 $> $ HsAppInfix $2)
[mj AnnSimpleQuote $1] }
- | SIMPLEQUOTE varop {% ams (sLL $1 $> $ HsAppInfix noExt $2)
+ | SIMPLEQUOTE varop {% ams (sLL $1 $> $ HsAppInfix $2)
[mj AnnSimpleQuote $1] }
atype :: { LHsType GhcPs }
- : ntgtycon { sL1 $1 (HsTyVar noExt NotPromoted $1) } -- Not including unit tuples
- | tyvar { sL1 $1 (HsTyVar noExt NotPromoted $1) } -- (See Note [Unit tuples])
- | strict_mark atype {% ams (sLL $1 $> (HsBangTy noExt (snd $ unLoc $1) $2))
+ : ntgtycon { sL1 $1 (HsTyVar NotPromoted $1) } -- Not including unit tuples
+ | tyvar { sL1 $1 (HsTyVar NotPromoted $1) } -- (See Note [Unit tuples])
+ | strict_mark atype {% ams (sLL $1 $> (HsBangTy (snd $ unLoc $1) $2))
(fst $ unLoc $1) } -- Constructor sigs only
| '{' fielddecls '}' {% amms (checkRecordSyntax
- (sLL $1 $> $ HsRecTy noExt $2))
+ (sLL $1 $> $ HsRecTy $2))
-- Constructor sigs only
[moc $1,mcc $3] }
- | '(' ')' {% ams (sLL $1 $> $ HsTupleTy noExt
+ | '(' ')' {% ams (sLL $1 $> $ HsTupleTy
HsBoxedOrConstraintTuple [])
[mop $1,mcp $2] }
| '(' ctype ',' comma_types1 ')' {% addAnnotation (gl $2) AnnComma
(gl $3) >>
- ams (sLL $1 $> $ HsTupleTy noExt
+ ams (sLL $1 $> $ HsTupleTy
HsBoxedOrConstraintTuple ($2 : $4))
[mop $1,mcp $5] }
- | '(#' '#)' {% ams (sLL $1 $> $ HsTupleTy noExt HsUnboxedTuple [])
+ | '(#' '#)' {% ams (sLL $1 $> $ HsTupleTy HsUnboxedTuple [])
[mo $1,mc $2] }
- | '(#' comma_types1 '#)' {% ams (sLL $1 $> $ HsTupleTy noExt HsUnboxedTuple $2)
+ | '(#' comma_types1 '#)' {% ams (sLL $1 $> $ HsTupleTy HsUnboxedTuple $2)
[mo $1,mc $3] }
- | '(#' bar_types2 '#)' {% ams (sLL $1 $> $ HsSumTy noExt $2)
+ | '(#' bar_types2 '#)' {% ams (sLL $1 $> $ HsSumTy $2)
[mo $1,mc $3] }
- | '[' ctype ']' {% ams (sLL $1 $> $ HsListTy noExt $2) [mos $1,mcs $3] }
- | '[:' ctype ':]' {% ams (sLL $1 $> $ HsPArrTy noExt $2) [mo $1,mc $3] }
- | '(' ctype ')' {% ams (sLL $1 $> $ HsParTy noExt $2) [mop $1,mcp $3] }
- | '(' ctype '::' kind ')' {% ams (sLL $1 $> $ HsKindSig noExt $2 $4)
+ | '[' ctype ']' {% ams (sLL $1 $> $ HsListTy $2) [mos $1,mcs $3] }
+ | '[:' ctype ':]' {% ams (sLL $1 $> $ HsPArrTy $2) [mo $1,mc $3] }
+ | '(' ctype ')' {% ams (sLL $1 $> $ HsParTy $2) [mop $1,mcp $3] }
+ | '(' ctype '::' kind ')' {% ams (sLL $1 $> $ HsKindSig $2 $4)
[mop $1,mu AnnDcolon $3,mcp $5] }
- | quasiquote { sL1 $1 (HsSpliceTy noExt (unLoc $1)) }
+ | quasiquote { sL1 $1 (HsSpliceTy (unLoc $1) placeHolderKind) }
| '$(' exp ')' {% ams (sLL $1 $> $ mkHsSpliceTy HasParens $2)
[mj AnnOpenPE $1,mj AnnCloseP $3] }
- | TH_ID_SPLICE {%ams (sLL $1 $> $ mkHsSpliceTy HasDollar $ sL1 $1 $ HsVar noExt $
+ | TH_ID_SPLICE {%ams (sLL $1 $> $ mkHsSpliceTy HasDollar $ sL1 $1 $ HsVar $
(sL1 $1 (mkUnqual varName (getTH_ID_SPLICE $1))))
[mj AnnThIdSplice $1] }
-- see Note [Promotion] for the followings
- | SIMPLEQUOTE qcon_nowiredlist {% ams (sLL $1 $> $ HsTyVar noExt Promoted $2) [mj AnnSimpleQuote $1,mj AnnName $2] }
+ | SIMPLEQUOTE qcon_nowiredlist {% ams (sLL $1 $> $ HsTyVar Promoted $2) [mj AnnSimpleQuote $1,mj AnnName $2] }
| SIMPLEQUOTE '(' ctype ',' comma_types1 ')'
{% addAnnotation (gl $3) AnnComma (gl $4) >>
- ams (sLL $1 $> $ HsExplicitTupleTy noExt ($3 : $5))
+ ams (sLL $1 $> $ HsExplicitTupleTy [] ($3 : $5))
[mj AnnSimpleQuote $1,mop $2,mcp $6] }
- | SIMPLEQUOTE '[' comma_types0 ']' {% ams (sLL $1 $> $ HsExplicitListTy noExt Promoted $3)
+ | SIMPLEQUOTE '[' comma_types0 ']' {% ams (sLL $1 $> $ HsExplicitListTy Promoted
+ placeHolderKind $3)
[mj AnnSimpleQuote $1,mos $2,mcs $4] }
- | SIMPLEQUOTE var {% ams (sLL $1 $> $ HsTyVar noExt Promoted $2)
+ | SIMPLEQUOTE var {% ams (sLL $1 $> $ HsTyVar Promoted $2)
[mj AnnSimpleQuote $1,mj AnnName $2] }
-- Two or more [ty, ty, ty] must be a promoted list type, just as
@@ -1919,12 +1915,13 @@ atype :: { LHsType GhcPs }
-- so you have to quote those.)
| '[' ctype ',' comma_types1 ']' {% addAnnotation (gl $2) AnnComma
(gl $3) >>
- ams (sLL $1 $> $ HsExplicitListTy noExt NotPromoted ($2 : $4))
+ ams (sLL $1 $> $ HsExplicitListTy NotPromoted
+ placeHolderKind ($2 : $4))
[mos $1,mcs $5] }
- | INTEGER { sLL $1 $> $ HsTyLit noExt $ HsNumTy (getINTEGERs $1)
- (il_value (getINTEGER $1)) }
- | STRING { sLL $1 $> $ HsTyLit noExt $ HsStrTy (getSTRINGs $1)
- (getSTRING $1) }
+ | INTEGER { sLL $1 $> $ HsTyLit $ HsNumTy (getINTEGERs $1)
+ (il_value (getINTEGER $1)) }
+ | STRING { sLL $1 $> $ HsTyLit $ HsStrTy (getSTRINGs $1)
+ (getSTRING $1) }
| '_' { sL1 $1 $ mkAnonWildCardTy }
-- An inst_type is what occurs in the head of an instance decl
@@ -1959,8 +1956,8 @@ tv_bndrs :: { [LHsTyVarBndr GhcPs] }
| {- empty -} { [] }
tv_bndr :: { LHsTyVarBndr GhcPs }
- : tyvar { sL1 $1 (UserTyVar noExt $1) }
- | '(' tyvar '::' kind ')' {% ams (sLL $1 $> (KindedTyVar noExt $2 $4))
+ : tyvar { sL1 $1 (UserTyVar $1) }
+ | '(' tyvar '::' kind ')' {% ams (sLL $1 $> (KindedTyVar $2 $4))
[mop $1,mu AnnDcolon $3
,mcp $5] }
@@ -2131,7 +2128,7 @@ fielddecl :: { LConDeclField GhcPs }
-- A list because of f,g :: Int
: maybe_docnext sig_vars '::' ctype maybe_docprev
{% ams (L (comb2 $2 $4)
- (ConDeclField (reverse (map (\ln@(L l n) -> L l $ FieldOcc noExt ln) (unLoc $2))) $4 ($1 `mplus` $5)))
+ (ConDeclField (reverse (map (\ln@(L l n) -> L l $ FieldOcc ln PlaceHolder) (unLoc $2))) $4 ($1 `mplus` $5)))
[mu AnnDcolon $3] }
-- Reversed!
@@ -2202,7 +2199,7 @@ docdecld :: { LDocDecl }
decl_no_th :: { LHsDecl GhcPs }
: sigdecl { $1 }
- | '!' aexp rhs {% do { let { e = sLL $1 $2 (SectionR noExt (sL1 $1 (HsVar noExt (sL1 $1 bang_RDR))) $2)
+ | '!' aexp rhs {% do { let { e = sLL $1 $2 (SectionR (sL1 $1 (HsVar (sL1 $1 bang_RDR))) $2)
-- Turn it all into an expression so that
-- checkPattern can check that bangs are enabled
; l = comb2 $1 $> };
@@ -2355,47 +2352,47 @@ quasiquote :: { Located (HsSplice GhcPs) }
in sL (getLoc $1) (mkHsQuasiQuote quoterId (RealSrcSpan quoteSpan) quote) }
exp :: { LHsExpr GhcPs }
- : infixexp '::' sigtype {% ams (sLL $1 $> $ ExprWithTySig (mkLHsSigWcType $3) $1)
+ : infixexp '::' sigtype {% ams (sLL $1 $> $ ExprWithTySig $1 (mkLHsSigWcType $3))
[mu AnnDcolon $2] }
- | infixexp '-<' exp {% ams (sLL $1 $> $ HsArrApp noExt $1 $3
+ | infixexp '-<' exp {% ams (sLL $1 $> $ HsArrApp $1 $3 placeHolderType
HsFirstOrderApp True)
[mu Annlarrowtail $2] }
- | infixexp '>-' exp {% ams (sLL $1 $> $ HsArrApp noExt $3 $1
+ | infixexp '>-' exp {% ams (sLL $1 $> $ HsArrApp $3 $1 placeHolderType
HsFirstOrderApp False)
[mu Annrarrowtail $2] }
- | infixexp '-<<' exp {% ams (sLL $1 $> $ HsArrApp noExt $1 $3
+ | infixexp '-<<' exp {% ams (sLL $1 $> $ HsArrApp $1 $3 placeHolderType
HsHigherOrderApp True)
[mu AnnLarrowtail $2] }
- | infixexp '>>-' exp {% ams (sLL $1 $> $ HsArrApp noExt $3 $1
+ | infixexp '>>-' exp {% ams (sLL $1 $> $ HsArrApp $3 $1 placeHolderType
HsHigherOrderApp False)
[mu AnnRarrowtail $2] }
| infixexp { $1 }
infixexp :: { LHsExpr GhcPs }
: exp10 { $1 }
- | infixexp qop exp10 {% ams (sLL $1 $> (OpApp noExt $1 $2 $3))
+ | infixexp qop exp10 {% ams (sLL $1 $> (OpApp $1 $2 placeHolderFixity $3))
[mj AnnVal $2] }
-- AnnVal annotation for NPlusKPat, which discards the operator
infixexp_top :: { LHsExpr GhcPs }
: exp10_top { $1 }
| infixexp_top qop exp10_top
- {% ams (sLL $1 $> (OpApp noExt $1 $2 $3))
+ {% ams (sLL $1 $> (OpApp $1 $2 placeHolderFixity $3))
[mj AnnVal $2] }
exp10_top :: { LHsExpr GhcPs }
: '\\' apat apats '->' exp
- {% ams (sLL $1 $> $ HsLam noExt (mkMatchGroup FromSource
+ {% ams (sLL $1 $> $ HsLam (mkMatchGroup FromSource
[sLL $1 $> $ Match { m_ctxt = LambdaExpr
, m_pats = $2:$3
, m_grhss = unguardedGRHSs $5 }]))
[mj AnnLam $1, mu AnnRarrow $4] }
- | 'let' binds 'in' exp {% ams (sLL $1 $> $ HsLet noExt (snd $ unLoc $2) $4)
+ | 'let' binds 'in' exp {% ams (sLL $1 $> $ HsLet (snd $ unLoc $2) $4)
(mj AnnLet $1:mj AnnIn $3
:(fst $ unLoc $2)) }
| '\\' 'lcase' altslist
- {% ams (sLL $1 $> $ HsLamCase noExt
+ {% ams (sLL $1 $> $ HsLamCase
(mkMatchGroup FromSource (snd $ unLoc $3)))
(mj AnnLam $1:mj AnnCase $2:(fst $ unLoc $3)) }
| 'if' exp optSemi 'then' exp optSemi 'else' exp
@@ -2406,14 +2403,15 @@ exp10_top :: { LHsExpr GhcPs }
:(map (\l -> mj AnnSemi l) (fst $3))
++(map (\l -> mj AnnSemi l) (fst $6))) }
| 'if' ifgdpats {% hintMultiWayIf (getLoc $1) >>
- ams (sLL $1 $> $ HsMultiIf noExt
+ ams (sLL $1 $> $ HsMultiIf
+ placeHolderType
(reverse $ snd $ unLoc $2))
(mj AnnIf $1:(fst $ unLoc $2)) }
- | 'case' exp 'of' altslist {% ams (sLL $1 $> $ HsCase noExt $2 (mkMatchGroup
+ | 'case' exp 'of' altslist {% ams (sLL $1 $> $ HsCase $2 (mkMatchGroup
FromSource (snd $ unLoc $4)))
(mj AnnCase $1:mj AnnOf $3
:(fst $ unLoc $4)) }
- | '-' fexp {% ams (sLL $1 $> $ NegApp noExt $2 noSyntaxExpr)
+ | '-' fexp {% ams (sLL $1 $> $ NegApp $2 noSyntaxExpr)
[mj AnnMinus $1] }
| 'do' stmtlist {% ams (L (comb2 $1 $2)
@@ -2423,18 +2421,19 @@ exp10_top :: { LHsExpr GhcPs }
(mkHsDo MDoExpr (snd $ unLoc $2)))
(mj AnnMdo $1:(fst $ unLoc $2)) }
- | hpc_annot exp {% ams (sLL $1 $> $ HsTickPragma noExt (snd $ fst $ fst $ unLoc $1)
- (snd $ fst $ unLoc $1) (snd $ unLoc $1) $2)
+ | hpc_annot exp {% ams (sLL $1 $> $ HsTickPragma (snd $ fst $ fst $ unLoc $1)
+ (snd $ fst $ unLoc $1) (snd $ unLoc $1) $2)
(fst $ fst $ fst $ unLoc $1) }
| 'proc' aexp '->' exp
{% checkPattern empty $2 >>= \ p ->
checkCommand $4 >>= \ cmd ->
- ams (sLL $1 $> $ HsProc noExt p (sLL $1 $> $ HsCmdTop noExt cmd))
+ ams (sLL $1 $> $ HsProc p (sLL $1 $> $ HsCmdTop cmd placeHolderType
+ placeHolderType []))
-- TODO: is LL right here?
[mj AnnProc $1,mu AnnRarrow $3] }
- | '{-# CORE' STRING '#-}' exp {% ams (sLL $1 $> $ HsCoreAnn noExt (getCORE_PRAGs $1) (getStringLiteral $2) $4)
+ | '{-# CORE' STRING '#-}' exp {% ams (sLL $1 $> $ HsCoreAnn (getCORE_PRAGs $1) (getStringLiteral $2) $4)
[mo $1,mj AnnVal $2
,mc $3] }
-- hdaume: core annotation
@@ -2442,7 +2441,7 @@ exp10_top :: { LHsExpr GhcPs }
exp10 :: { LHsExpr GhcPs }
: exp10_top { $1 }
- | scc_annot exp {% ams (sLL $1 $> $ HsSCC noExt (snd $ fst $ unLoc $1) (snd $ unLoc $1) $2)
+ | scc_annot exp {% ams (sLL $1 $> $ HsSCC (snd $ fst $ unLoc $1) (snd $ unLoc $1) $2)
(fst $ fst $ unLoc $1) }
optSemi :: { ([Located a],Bool) }
@@ -2485,19 +2484,19 @@ hpc_annot :: { Located ( (([AddAnn],SourceText),(StringLiteral,(Int,Int),(Int,In
}
fexp :: { LHsExpr GhcPs }
- : fexp aexp { sLL $1 $> $ HsApp noExt $1 $2 }
- | fexp TYPEAPP atype {% ams (sLL $1 $> $ HsAppType (mkHsWildCardBndrs $3) $1)
+ : fexp aexp { sLL $1 $> $ HsApp $1 $2 }
+ | fexp TYPEAPP atype {% ams (sLL $1 $> $ HsAppType $1 (mkHsWildCardBndrs $3))
[mj AnnAt $2] }
- | 'static' aexp {% ams (sLL $1 $> $ HsStatic noExt $2)
+ | 'static' aexp {% ams (sLL $1 $> $ HsStatic placeHolderNames $2)
[mj AnnStatic $1] }
| aexp { $1 }
aexp :: { LHsExpr GhcPs }
- : qvar '@' aexp {% ams (sLL $1 $> $ EAsPat noExt $1 $3) [mj AnnAt $2] }
+ : qvar '@' aexp {% ams (sLL $1 $> $ EAsPat $1 $3) [mj AnnAt $2] }
-- If you change the parsing, make sure to understand
-- Note [Lexing type applications] in Lexer.x
- | '~' aexp {% ams (sLL $1 $> $ ELazyPat noExt $2) [mj AnnTilde $1] }
+ | '~' aexp {% ams (sLL $1 $> $ ELazyPat $2) [mj AnnTilde $1] }
| aexp1 { $1 }
aexp1 :: { LHsExpr GhcPs }
@@ -2508,70 +2507,72 @@ aexp1 :: { LHsExpr GhcPs }
| aexp2 { $1 }
aexp2 :: { LHsExpr GhcPs }
- : qvar { sL1 $1 (HsVar noExt $! $1) }
- | qcon { sL1 $1 (HsVar noExt $! $1) }
- | ipvar { sL1 $1 (HsIPVar noExt $! unLoc $1) }
- | overloaded_label { sL1 $1 (HsOverLabel noExt Nothing $! unLoc $1) }
- | literal { sL1 $1 (HsLit noExt $! unLoc $1) }
+ : qvar { sL1 $1 (HsVar $! $1) }
+ | qcon { sL1 $1 (HsVar $! $1) }
+ | ipvar { sL1 $1 (HsIPVar $! unLoc $1) }
+ | overloaded_label { sL1 $1 (HsOverLabel Nothing $! unLoc $1) }
+ | literal { sL1 $1 (HsLit $! unLoc $1) }
-- This will enable overloaded strings permanently. Normally the renamer turns HsString
-- into HsOverLit when -foverloaded-strings is on.
-- | STRING { sL (getLoc $1) (HsOverLit $! mkHsIsString (getSTRINGs $1)
-- (getSTRING $1) placeHolderType) }
- | INTEGER { sL (getLoc $1) (HsOverLit noExt $! mkHsIntegral (getINTEGER $1) ) }
- | RATIONAL { sL (getLoc $1) (HsOverLit noExt $! mkHsFractional (getRATIONAL $1) ) }
+ | INTEGER { sL (getLoc $1) (HsOverLit $! mkHsIntegral
+ (getINTEGER $1) placeHolderType) }
+ | RATIONAL { sL (getLoc $1) (HsOverLit $! mkHsFractional
+ (getRATIONAL $1) placeHolderType) }
-- N.B.: sections get parsed by these next two productions.
-- This allows you to write, e.g., '(+ 3, 4 -)', which isn't
-- correct Haskell (you'd have to write '((+ 3), (4 -))')
-- but the less cluttered version fell out of having texps.
- | '(' texp ')' {% ams (sLL $1 $> (HsPar noExt $2)) [mop $1,mcp $3] }
+ | '(' texp ')' {% ams (sLL $1 $> (HsPar $2)) [mop $1,mcp $3] }
| '(' tup_exprs ')' {% do { e <- mkSumOrTuple Boxed (comb2 $1 $3) (snd $2)
; ams (sLL $1 $> e) ((mop $1:fst $2) ++ [mcp $3]) } }
- | '(#' texp '#)' {% ams (sLL $1 $> (ExplicitTuple noExt [L (gl $2)
- (Present noExt $2)] Unboxed))
+ | '(#' texp '#)' {% ams (sLL $1 $> (ExplicitTuple [L (gl $2)
+ (Present $2)] Unboxed))
[mo $1,mc $3] }
| '(#' tup_exprs '#)' {% do { e <- mkSumOrTuple Unboxed (comb2 $1 $3) (snd $2)
; ams (sLL $1 $> e) ((mo $1:fst $2) ++ [mc $3]) } }
| '[' list ']' {% ams (sLL $1 $> (snd $2)) (mos $1:mcs $3:(fst $2)) }
| '[:' parr ':]' {% ams (sLL $1 $> (snd $2)) (mo $1:mc $3:(fst $2)) }
- | '_' { sL1 $1 $ EWildPat noExt }
+ | '_' { sL1 $1 EWildPat }
-- Template Haskell Extension
| splice_exp { $1 }
- | SIMPLEQUOTE qvar {% ams (sLL $1 $> $ HsBracket noExt (VarBr noExt True (unLoc $2))) [mj AnnSimpleQuote $1,mj AnnName $2] }
- | SIMPLEQUOTE qcon {% ams (sLL $1 $> $ HsBracket noExt (VarBr noExt True (unLoc $2))) [mj AnnSimpleQuote $1,mj AnnName $2] }
- | TH_TY_QUOTE tyvar {% ams (sLL $1 $> $ HsBracket noExt (VarBr noExt False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] }
- | TH_TY_QUOTE gtycon {% ams (sLL $1 $> $ HsBracket noExt (VarBr noExt False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] }
- | '[|' exp '|]' {% ams (sLL $1 $> $ HsBracket noExt (ExpBr noExt $2))
+ | SIMPLEQUOTE qvar {% ams (sLL $1 $> $ HsBracket (VarBr True (unLoc $2))) [mj AnnSimpleQuote $1,mj AnnName $2] }
+ | SIMPLEQUOTE qcon {% ams (sLL $1 $> $ HsBracket (VarBr True (unLoc $2))) [mj AnnSimpleQuote $1,mj AnnName $2] }
+ | TH_TY_QUOTE tyvar {% ams (sLL $1 $> $ HsBracket (VarBr False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] }
+ | TH_TY_QUOTE gtycon {% ams (sLL $1 $> $ HsBracket (VarBr False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] }
+ | '[|' exp '|]' {% ams (sLL $1 $> $ HsBracket (ExpBr $2))
(if (hasE $1) then [mj AnnOpenE $1, mu AnnCloseQ $3]
else [mu AnnOpenEQ $1,mu AnnCloseQ $3]) }
- | '[||' exp '||]' {% ams (sLL $1 $> $ HsBracket noExt (TExpBr noExt $2))
+ | '[||' exp '||]' {% ams (sLL $1 $> $ HsBracket (TExpBr $2))
(if (hasE $1) then [mj AnnOpenE $1,mc $3] else [mo $1,mc $3]) }
- | '[t|' ctype '|]' {% ams (sLL $1 $> $ HsBracket noExt (TypBr noExt $2)) [mo $1,mu AnnCloseQ $3] }
+ | '[t|' ctype '|]' {% ams (sLL $1 $> $ HsBracket (TypBr $2)) [mo $1,mu AnnCloseQ $3] }
| '[p|' infixexp '|]' {% checkPattern empty $2 >>= \p ->
- ams (sLL $1 $> $ HsBracket noExt (PatBr noExt p))
+ ams (sLL $1 $> $ HsBracket (PatBr p))
[mo $1,mu AnnCloseQ $3] }
- | '[d|' cvtopbody '|]' {% ams (sLL $1 $> $ HsBracket noExt (DecBrL noExt (snd $2)))
+ | '[d|' cvtopbody '|]' {% ams (sLL $1 $> $ HsBracket (DecBrL (snd $2)))
(mo $1:mu AnnCloseQ $3:fst $2) }
- | quasiquote { sL1 $1 (HsSpliceE noExt (unLoc $1)) }
+ | quasiquote { sL1 $1 (HsSpliceE (unLoc $1)) }
-- arrow notation extension
- | '(|' aexp2 cmdargs '|)' {% ams (sLL $1 $> $ HsArrForm noExt $2
+ | '(|' aexp2 cmdargs '|)' {% ams (sLL $1 $> $ HsArrForm $2
Nothing (reverse $3))
[mu AnnOpenB $1,mu AnnCloseB $4] }
splice_exp :: { LHsExpr GhcPs }
: TH_ID_SPLICE {% ams (sL1 $1 $ mkHsSpliceE HasDollar
- (sL1 $1 $ HsVar noExt (sL1 $1 (mkUnqual varName
+ (sL1 $1 $ HsVar (sL1 $1 (mkUnqual varName
(getTH_ID_SPLICE $1)))))
[mj AnnThIdSplice $1] }
| '$(' exp ')' {% ams (sLL $1 $> $ mkHsSpliceE HasParens $2)
[mj AnnOpenPE $1,mj AnnCloseP $3] }
| TH_ID_TY_SPLICE {% ams (sL1 $1 $ mkHsSpliceTE HasDollar
- (sL1 $1 $ HsVar noExt (sL1 $1 (mkUnqual varName
+ (sL1 $1 $ HsVar (sL1 $1 (mkUnqual varName
(getTH_ID_TY_SPLICE $1)))))
[mj AnnThIdTySplice $1] }
| '$$(' exp ')' {% ams (sLL $1 $> $ mkHsSpliceTE HasParens $2)
@@ -2583,7 +2584,8 @@ cmdargs :: { [LHsCmdTop GhcPs] }
acmd :: { LHsCmdTop GhcPs }
: aexp2 {% checkCommand $1 >>= \ cmd ->
- return (sL1 $1 $ HsCmdTop noExt cmd) }
+ return (sL1 $1 $ HsCmdTop cmd
+ placeHolderType placeHolderType []) }
cvtopbody :: { ([AddAnn],[LHsDecl GhcPs]) }
: '{' cvtopdecls0 '}' { ([mj AnnOpenC $1
@@ -2614,17 +2616,17 @@ texp :: { LHsExpr GhcPs }
-- Then when converting expr to pattern we unravel it again
-- Meanwhile, the renamer checks that real sections appear
-- inside parens.
- | infixexp qop { sLL $1 $> $ SectionL noExt $1 $2 }
- | qopm infixexp { sLL $1 $> $ SectionR noExt $1 $2 }
+ | infixexp qop { sLL $1 $> $ SectionL $1 $2 }
+ | qopm infixexp { sLL $1 $> $ SectionR $1 $2 }
-- View patterns get parenthesized above
- | exp '->' texp {% ams (sLL $1 $> $ EViewPat noExt $1 $3) [mu AnnRarrow $2] }
+ | exp '->' texp {% ams (sLL $1 $> $ EViewPat $1 $3) [mu AnnRarrow $2] }
-- Always at least one comma or bar.
tup_exprs :: { ([AddAnn],SumOrTuple) }
: texp commas_tup_tail
{% do { addAnnotation (gl $1) AnnComma (fst $2)
- ; return ([],Tuple ((sL1 $1 (Present noExt $1)) : snd $2)) } }
+ ; return ([],Tuple ((sL1 $1 (Present $1)) : snd $2)) } }
| texp bars { (mvbars (fst $2), Sum 1 (snd $2 + 1) $1) }
@@ -2647,8 +2649,8 @@ commas_tup_tail : commas tup_tail
-- Always follows a comma
tup_tail :: { [LHsTupArg GhcPs] }
: texp commas_tup_tail {% addAnnotation (gl $1) AnnComma (fst $2) >>
- return ((L (gl $1) (Present noExt $1)) : snd $2) }
- | texp { [L (gl $1) (Present noExt $1)] }
+ return ((L (gl $1) (Present $1)) : snd $2) }
+ | texp { [L (gl $1) (Present $1)] }
| {- empty -} { [noLoc missingTupArg] }
-----------------------------------------------------------------------------
@@ -2657,18 +2659,19 @@ tup_tail :: { [LHsTupArg GhcPs] }
-- The rules below are little bit contorted to keep lexps left-recursive while
-- avoiding another shift/reduce-conflict.
list :: { ([AddAnn],HsExpr GhcPs) }
- : texp { ([],ExplicitList noExt Nothing [$1]) }
- | lexps { ([],ExplicitList noExt Nothing (reverse (unLoc $1))) }
+ : texp { ([],ExplicitList placeHolderType Nothing [$1]) }
+ | lexps { ([],ExplicitList placeHolderType Nothing
+ (reverse (unLoc $1))) }
| texp '..' { ([mj AnnDotdot $2],
- ArithSeq noExt Nothing (From $1)) }
+ ArithSeq noPostTcExpr Nothing (From $1)) }
| texp ',' exp '..' { ([mj AnnComma $2,mj AnnDotdot $4],
- ArithSeq noExt Nothing
+ ArithSeq noPostTcExpr Nothing
(FromThen $1 $3)) }
| texp '..' exp { ([mj AnnDotdot $2],
- ArithSeq noExt Nothing
+ ArithSeq noPostTcExpr Nothing
(FromTo $1 $3)) }
| texp ',' exp '..' exp { ([mj AnnComma $2,mj AnnDotdot $4],
- ArithSeq noExt Nothing
+ ArithSeq noPostTcExpr Nothing
(FromThenTo $1 $3 $5)) }
| texp '|' flattenedpquals
{% checkMonadComp >>= \ ctxt ->
@@ -2691,7 +2694,7 @@ flattenedpquals :: { Located [LStmt GhcPs (LHsExpr GhcPs)] }
-- We just had one thing in our "parallel" list so
-- we simply return that thing directly
- qss -> sL1 $1 [sL1 $1 $ ParStmt [ParStmtBlock noExt qs [] noSyntaxExpr |
+ qss -> sL1 $1 [sL1 $1 $ ParStmt [ParStmtBlock qs [] noSyntaxExpr |
qs <- qss]
noExpr noSyntaxExpr placeHolderType]
-- We actually found some actual parallel lists so
@@ -2748,14 +2751,15 @@ transformqual :: { Located ([AddAnn],[LStmt GhcPs (LHsExpr GhcPs)] -> Stmt GhcPs
-- constructor in the list case).
parr :: { ([AddAnn],HsExpr GhcPs) }
- : { ([],ExplicitPArr noExt []) }
- | texp { ([],ExplicitPArr noExt [$1]) }
- | lexps { ([],ExplicitPArr noExt (reverse (unLoc $1))) }
+ : { ([],ExplicitPArr placeHolderType []) }
+ | texp { ([],ExplicitPArr placeHolderType [$1]) }
+ | lexps { ([],ExplicitPArr placeHolderType
+ (reverse (unLoc $1))) }
| texp '..' exp { ([mj AnnDotdot $2]
- ,PArrSeq noExt (FromTo $1 $3)) }
+ ,PArrSeq noPostTcExpr (FromTo $1 $3)) }
| texp ',' exp '..' exp
{ ([mj AnnComma $2,mj AnnDotdot $4]
- ,PArrSeq noExt (FromThenTo $1 $3 $5)) }
+ ,PArrSeq noPostTcExpr (FromThenTo $1 $3 $5)) }
| texp '|' flattenedpquals
{ ([mj AnnVbar $2],mkHsComp PArrComp (unLoc $3) $1) }
@@ -2841,8 +2845,8 @@ gdpat :: { LGRHS GhcPs (LHsExpr GhcPs) }
-- we parse them right when bang-patterns are off
pat :: { LPat GhcPs }
pat : exp {% checkPattern empty $1 }
- | '!' aexp {% amms (checkPattern empty (sLL $1 $> (SectionR noExt
- (sL1 $1 (HsVar noExt (sL1 $1 bang_RDR))) $2)))
+ | '!' aexp {% amms (checkPattern empty (sLL $1 $> (SectionR
+ (sL1 $1 (HsVar (sL1 $1 bang_RDR))) $2)))
[mj AnnBang $1] }
bindpat :: { LPat GhcPs }
@@ -2850,14 +2854,14 @@ bindpat : exp {% checkPattern
(text "Possibly caused by a missing 'do'?") $1 }
| '!' aexp {% amms (checkPattern
(text "Possibly caused by a missing 'do'?")
- (sLL $1 $> (SectionR noExt (sL1 $1 (HsVar noExt (sL1 $1 bang_RDR))) $2)))
+ (sLL $1 $> (SectionR (sL1 $1 (HsVar (sL1 $1 bang_RDR))) $2)))
[mj AnnBang $1] }
apat :: { LPat GhcPs }
apat : aexp {% checkPattern empty $1 }
| '!' aexp {% amms (checkPattern empty
- (sLL $1 $> (SectionR noExt
- (sL1 $1 (HsVar noExt (sL1 $1 bang_RDR))) $2)))
+ (sLL $1 $> (SectionR
+ (sL1 $1 (HsVar (sL1 $1 bang_RDR))) $2)))
[mj AnnBang $1] }
apats :: { [LPat GhcPs] }
@@ -3135,8 +3139,8 @@ qtycon :: { Located RdrName } -- Qualified or unqualified
| tycon { $1 }
qtycondoc :: { LHsType GhcPs } -- Qualified or unqualified
- : qtycon { sL1 $1 (HsTyVar noExt NotPromoted $1) }
- | qtycon docprev { sLL $1 $> (HsDocTy noExt (sL1 $1 (HsTyVar noExt NotPromoted $1)) $2) }
+ : qtycon { sL1 $1 (HsTyVar NotPromoted $1) }
+ | qtycon docprev { sLL $1 $> (HsDocTy (sL1 $1 (HsTyVar NotPromoted $1)) $2) }
tycon :: { Located RdrName } -- Unqualified
: CONID { sL1 $1 $! mkUnqual tcClsName (getCONID $1) }
@@ -3169,15 +3173,15 @@ varop :: { Located RdrName }
,mj AnnBackquote $3] }
qop :: { LHsExpr GhcPs } -- used in sections
- : qvarop { sL1 $1 $ HsVar noExt $1 }
- | qconop { sL1 $1 $ HsVar noExt $1 }
- | '`' '_' '`' {% ams (sLL $1 $> (EWildPat noExt))
+ : qvarop { sL1 $1 $ HsVar $1 }
+ | qconop { sL1 $1 $ HsVar $1 }
+ | '`' '_' '`' {% ams (sLL $1 $> EWildPat)
[mj AnnBackquote $1,mj AnnVal $2
,mj AnnBackquote $3] }
qopm :: { LHsExpr GhcPs } -- used in sections
- : qvaropm { sL1 $1 $ HsVar noExt $1 }
- | qconop { sL1 $1 $ HsVar noExt $1 }
+ : qvaropm { sL1 $1 $ HsVar $1 }
+ | qconop { sL1 $1 $ HsVar $1 }
qvarop :: { Located RdrName }
: qvarsym { $1 }
@@ -3334,8 +3338,8 @@ literal :: { Located (HsLit GhcPs) }
$ getPRIMCHAR $1 }
| PRIMSTRING { sL1 $1 $ HsStringPrim (sst $ getPRIMSTRINGs $1)
$ getPRIMSTRING $1 }
- | PRIMFLOAT { sL1 $1 $ HsFloatPrim noExt $ getPRIMFLOAT $1 }
- | PRIMDOUBLE { sL1 $1 $ HsDoublePrim noExt $ getPRIMDOUBLE $1 }
+ | PRIMFLOAT { sL1 $1 $ HsFloatPrim def $ getPRIMFLOAT $1 }
+ | PRIMDOUBLE { sL1 $1 $ HsDoublePrim def $ getPRIMDOUBLE $1 }
-----------------------------------------------------------------------------
-- Layout
diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs
index 7285f5fef9..126e92e7ad 100644
--- a/compiler/parser/RdrHsSyn.hs
+++ b/compiler/parser/RdrHsSyn.hs
@@ -186,7 +186,7 @@ mkTyData loc new_or_data cType (L _ (mcxt, tycl_hdr)) ksig data_cons maybe_deriv
; return (L loc (DataDecl { tcdLName = tc, tcdTyVars = tyvars,
tcdFixity = fixity,
tcdDataDefn = defn,
- tcdDataCusk = placeHolder,
+ tcdDataCusk = PlaceHolder,
tcdFVs = placeHolderNames })) }
mkDataDefn :: NewOrData
@@ -286,10 +286,10 @@ mkSpliceDecl :: LHsExpr GhcPs -> HsDecl GhcPs
-- Typed splices are not allowed at the top level, thus we do not represent them
-- as spliced declaration. See #10945
mkSpliceDecl lexpr@(L loc expr)
- | HsSpliceE _ splice@(HsUntypedSplice {}) <- expr
+ | HsSpliceE splice@(HsUntypedSplice {}) <- expr
= SpliceD (SpliceDecl (L loc splice) ExplicitSplice)
- | HsSpliceE _ splice@(HsQuasiQuote {}) <- expr
+ | HsSpliceE splice@(HsQuasiQuote {}) <- expr
= SpliceD (SpliceDecl (L loc splice) ExplicitSplice)
| otherwise
@@ -349,7 +349,7 @@ cvBindGroup :: OrdList (LHsDecl GhcPs) -> P (HsValBinds GhcPs)
cvBindGroup binding
= do { (mbs, sigs, fam_ds, tfam_insts, dfam_insts, _) <- cvBindsAndSigs binding
; ASSERT( null fam_ds && null tfam_insts && null dfam_insts)
- return $ ValBinds noExt mbs sigs }
+ return $ ValBindsIn mbs sigs }
cvBindsAndSigs :: OrdList (LHsDecl GhcPs)
-> P (LHsBinds GhcPs, [LSig GhcPs], [LFamilyDecl GhcPs]
@@ -476,15 +476,15 @@ splitCon ty
= split ty []
where
-- This is used somewhere where HsAppsTy is not used
- split (L _ (HsAppTy _ t u)) ts = split t (u : ts)
- split (L l (HsTyVar _ _ (L _ tc))) ts = do data_con <- tyConToDataCon l tc
- return (data_con, mk_rest ts)
- split (L l (HsTupleTy _ HsBoxedOrConstraintTuple ts)) []
+ split (L _ (HsAppTy t u)) ts = split t (u : ts)
+ split (L l (HsTyVar _ (L _ tc))) ts = do data_con <- tyConToDataCon l tc
+ return (data_con, mk_rest ts)
+ split (L l (HsTupleTy HsBoxedOrConstraintTuple ts)) []
= return (L l (getRdrName (tupleDataCon Boxed (length ts))), PrefixCon ts)
split (L l _) _ = parseErrorSDoc l (text "Cannot parse data constructor in a data/newtype declaration:" <+> ppr ty)
- mk_rest [L l (HsRecTy _ flds)] = RecCon (L l flds)
- mk_rest ts = PrefixCon ts
+ mk_rest [L l (HsRecTy flds)] = RecCon (L l flds)
+ mk_rest ts = PrefixCon ts
tyConToDataCon :: SrcSpan -> RdrName -> P (Located RdrName)
-- See Note [Parsing data constructors is hard]
@@ -695,16 +695,15 @@ checkTyVars pp_what equals_or_where tc tparms
; return (mkHsQTvs tvs) }
where
- chk (L _ (HsParTy _ ty)) = chk ty
- chk (L _ (HsAppsTy _ [L _ (HsAppPrefix _ ty)])) = chk ty
+ chk (L _ (HsParTy ty)) = chk ty
+ chk (L _ (HsAppsTy [L _ (HsAppPrefix ty)])) = chk ty
-- Check that the name space is correct!
- chk (L l (HsKindSig _
- (L _ (HsAppsTy _ [L _ (HsAppPrefix _ (L lv (HsTyVar _ _ (L _ tv))))]))
- k))
- | isRdrTyVar tv = return (L l (KindedTyVar noExt (L lv tv) k))
- chk (L l (HsTyVar _ _ (L ltv tv)))
- | isRdrTyVar tv = return (L l (UserTyVar noExt (L ltv tv)))
+ chk (L l (HsKindSig
+ (L _ (HsAppsTy [L _ (HsAppPrefix (L lv (HsTyVar _ (L _ tv))))])) k))
+ | isRdrTyVar tv = return (L l (KindedTyVar (L lv tv) k))
+ chk (L l (HsTyVar _ (L ltv tv)))
+ | isRdrTyVar tv = return (L l (UserTyVar (L ltv tv)))
chk t@(L loc _)
= Left (loc,
vcat [ text "Unexpected type" <+> quotes (ppr t)
@@ -753,23 +752,23 @@ checkTyClHdr is_cls ty
where
goL (L l ty) acc ann fix = go l ty acc ann fix
- go l (HsTyVar _ _ (L _ tc)) acc ann fix
+ go l (HsTyVar _ (L _ tc)) acc ann fix
| isRdrTc tc = return (L l tc, acc, fix, ann)
- go _ (HsOpTy _ t1 ltc@(L _ tc) t2) acc ann _fix
+ go _ (HsOpTy t1 ltc@(L _ tc) t2) acc ann _fix
| isRdrTc tc = return (ltc, t1:t2:acc, Infix, ann)
- go l (HsParTy _ ty) acc ann fix = goL ty acc (ann ++mkParensApiAnn l) fix
- go _ (HsAppTy _ t1 t2) acc ann fix = goL t1 (t2:acc) ann fix
- go _ (HsAppsTy _ ts) acc ann _fix
+ go l (HsParTy ty) acc ann fix = goL ty acc (ann ++ mkParensApiAnn l) fix
+ go _ (HsAppTy t1 t2) acc ann fix = goL t1 (t2:acc) ann fix
+ go _ (HsAppsTy ts) acc ann _fix
| Just (head, args, fixity) <- getAppsTyHead_maybe ts
= goL head (args ++ acc) ann fixity
- go _ (HsAppsTy _ [L _ (HsAppInfix _ (L loc star))]) [] ann fix
+ go _ (HsAppsTy [L _ (HsAppInfix (L loc star))]) [] ann fix
| isStar star
= return (L loc (nameRdrName starKindTyConName), [], fix, ann)
| isUniStar star
= return (L loc (nameRdrName unicodeStarKindTyConName), [], fix, ann)
- go l (HsTupleTy _ HsBoxedOrConstraintTuple ts) [] ann fix
+ go l (HsTupleTy HsBoxedOrConstraintTuple ts) [] ann fix
= return (L l (nameRdrName tup_name), ts, fix, ann)
where
arity = length ts
@@ -784,15 +783,14 @@ checkContext :: LHsType GhcPs -> P ([AddAnn],LHsContext GhcPs)
checkContext (L l orig_t)
= check [] (L l orig_t)
where
- check anns (L lp (HsTupleTy _ _ ts)) -- (Eq a, Ord b) shows up as a tuple type
+ check anns (L lp (HsTupleTy _ ts)) -- (Eq a, Ord b) shows up as a tuple type
= return (anns ++ mkParensApiAnn lp,L l ts) -- Ditto ()
-- don't let HsAppsTy get in the way
- check anns (L _ (HsAppsTy _ [L _ (HsAppPrefix _ ty)]))
+ check anns (L _ (HsAppsTy [L _ (HsAppPrefix ty)]))
= check anns ty
- check anns (L lp1 (HsParTy _ ty))
- -- to be sure HsParTy doesn't get into the way
+ check anns (L lp1 (HsParTy ty))-- to be sure HsParTy doesn't get into the way
= check anns' ty
where anns' = if l == lp1 then anns
else (anns ++ mkParensApiAnn lp1)
@@ -817,7 +815,7 @@ checkLPat msg e@(L l _) = checkPat msg l e []
checkPat :: SDoc -> SrcSpan -> LHsExpr GhcPs -> [LPat GhcPs]
-> P (LPat GhcPs)
-checkPat _ loc (L l e@(HsVar _ (L _ c))) args
+checkPat _ loc (L l e@(HsVar (L _ c))) args
| isRdrDataCon c = return (L loc (ConPatIn (L l c) (PrefixCon args)))
| not (null args) && patIsRec c =
patFail (text "Perhaps you intended to use RecursiveDo") l e
@@ -827,7 +825,7 @@ checkPat msg loc e args -- OK to let this happen even if bang-patterns
| Just (e', args') <- splitBang e
= do { args'' <- checkPatterns msg args'
; checkPat msg loc e' (args'' ++ args) }
-checkPat msg loc (L _ (HsApp _ f e)) args
+checkPat msg loc (L _ (HsApp f e)) args
= do p <- checkLPat msg e
checkPat msg loc f (p : args)
checkPat msg loc (L _ e) []
@@ -841,76 +839,76 @@ checkAPat msg loc e0 = do
pState <- getPState
let opts = options pState
case e0 of
- EWildPat _ -> return (WildPat noExt)
- HsVar _ x -> return (VarPat noExt x)
- HsLit _ (HsStringPrim _ _) -- (#13260)
+ EWildPat -> return (WildPat placeHolderType)
+ HsVar x -> return (VarPat x)
+ HsLit (HsStringPrim _ _) -- (#13260)
-> parseErrorSDoc loc (text "Illegal unboxed string literal in pattern:" $$ ppr e0)
- HsLit _ l -> return (LitPat noExt l)
+ HsLit l -> return (LitPat l)
-- Overloaded numeric patterns (e.g. f 0 x = x)
-- Negation is recorded separately, so that the literal is zero or +ve
-- NB. Negative *primitive* literals are already handled by the lexer
- HsOverLit _ pos_lit -> return (mkNPat (L loc pos_lit) Nothing)
- NegApp _ (L l (HsOverLit _ pos_lit)) _
+ HsOverLit pos_lit -> return (mkNPat (L loc pos_lit) Nothing)
+ NegApp (L l (HsOverLit pos_lit)) _
-> return (mkNPat (L l pos_lit) (Just noSyntaxExpr))
- SectionR _ (L lb (HsVar _ (L _ bang))) e -- (! x)
+ SectionR (L lb (HsVar (L _ bang))) e -- (! x)
| bang == bang_RDR
-> do { bang_on <- extension bangPatEnabled
; if bang_on then do { e' <- checkLPat msg e
; addAnnotation loc AnnBang lb
- ; return (BangPat noExt e') }
+ ; return (BangPat e') }
else parseErrorSDoc loc (text "Illegal bang-pattern (use BangPatterns):" $$ ppr e0) }
- ELazyPat _ e -> checkLPat msg e >>= (return . (LazyPat noExt))
- EAsPat _ n e -> checkLPat msg e >>= (return . (AsPat noExt) n)
+ ELazyPat e -> checkLPat msg e >>= (return . LazyPat)
+ EAsPat n e -> checkLPat msg e >>= (return . AsPat n)
-- view pattern is well-formed if the pattern is
- EViewPat _ expr patE -> checkLPat msg patE >>=
- (return . (\p -> ViewPat noExt expr p))
- ExprWithTySig t e -> do e <- checkLPat msg e
- return (SigPat t e)
+ EViewPat expr patE -> checkLPat msg patE >>=
+ (return . (\p -> ViewPat expr p placeHolderType))
+ ExprWithTySig e t -> do e <- checkLPat msg e
+ return (SigPatIn e t)
-- n+k patterns
- OpApp _ (L nloc (HsVar _ (L _ n))) (L _ (HsVar _ (L _ plus)))
- (L lloc (HsOverLit _ lit@(OverLit {ol_val = HsIntegral {}})))
+ OpApp (L nloc (HsVar (L _ n))) (L _ (HsVar (L _ plus))) _
+ (L lloc (HsOverLit lit@(OverLit {ol_val = HsIntegral {}})))
| extopt LangExt.NPlusKPatterns opts && (plus == plus_RDR)
-> return (mkNPlusKPat (L nloc n) (L lloc lit))
- OpApp _ l op r -> do l <- checkLPat msg l
- r <- checkLPat msg r
- case op of
- L cl (HsVar _ (L _ c)) | isDataOcc (rdrNameOcc c)
- -> return (ConPatIn (L cl c) (InfixCon l r))
- _ -> patFail msg loc e0
+ OpApp l op _fix r -> do l <- checkLPat msg l
+ r <- checkLPat msg r
+ case op of
+ L cl (HsVar (L _ c)) | isDataOcc (rdrNameOcc c)
+ -> return (ConPatIn (L cl c) (InfixCon l r))
+ _ -> patFail msg loc e0
- HsPar _ e -> checkLPat msg e >>= (return . (ParPat noExt))
+ HsPar e -> checkLPat msg e >>= (return . ParPat)
ExplicitList _ _ es -> do ps <- mapM (checkLPat msg) es
- return (ListPat noExt ps placeHolderType Nothing)
+ return (ListPat ps placeHolderType Nothing)
ExplicitPArr _ es -> do ps <- mapM (checkLPat msg) es
- return (PArrPat noExt ps)
+ return (PArrPat ps placeHolderType)
- ExplicitTuple _ es b
+ ExplicitTuple es b
| all tupArgPresent es -> do ps <- mapM (checkLPat msg)
- [e | L _ (Present _ e) <- es]
- return (TuplePat noExt ps b)
+ [e | L _ (Present e) <- es]
+ return (TuplePat ps b [])
| otherwise -> parseErrorSDoc loc (text "Illegal tuple section in pattern:" $$ ppr e0)
- ExplicitSum _ alt arity expr -> do
+ ExplicitSum alt arity expr _ -> do
p <- checkLPat msg expr
- return (SumPat noExt p alt arity)
+ return (SumPat p alt arity placeHolderType)
RecordCon { rcon_con_name = c, rcon_flds = HsRecFields fs dd }
-> do fs <- mapM (checkPatField msg) fs
return (ConPatIn c (RecCon (HsRecFields fs dd)))
- HsSpliceE _ s | not (isTypedSplice s)
- -> return (SplicePat noExt s)
+ HsSpliceE s | not (isTypedSplice s)
+ -> return (SplicePat s)
_ -> patFail msg loc e0
placeHolderPunRhs :: LHsExpr GhcPs
-- The RHS of a punned record field will be filled in by the renamer
-- It's better not to make it an error, in case we want to print it when debugging
-placeHolderPunRhs = noLoc (HsVar noExt (noLoc pun_RDR))
+placeHolderPunRhs = noLoc (HsVar (noLoc pun_RDR))
plus_RDR, bang_RDR, pun_RDR :: RdrName
plus_RDR = mkUnqual varName (fsLit "+") -- Hack
@@ -944,7 +942,7 @@ checkValDef :: SDoc
checkValDef msg _strictness lhs (Just sig) grhss
-- x :: ty = rhs parses as a *pattern* binding
= checkPatBind msg (L (combineLocs lhs sig)
- (ExprWithTySig (mkLHsSigWcType sig) lhs)) grhss
+ (ExprWithTySig lhs (mkLHsSigWcType sig))) grhss
checkValDef msg strictness lhs Nothing g@(L l (_,grhss))
= do { mb_fun <- isFunLhs lhs
@@ -997,7 +995,7 @@ checkPatBind msg lhs (L _ (_,grhss))
([],[])) }
checkValSigLhs :: LHsExpr GhcPs -> P (Located RdrName)
-checkValSigLhs (L _ (HsVar _ lrdr@(L _ v)))
+checkValSigLhs (L _ (HsVar lrdr@(L _ v)))
| isUnqual v
, not (isDataOcc (rdrNameOcc v))
= return lrdr
@@ -1019,9 +1017,9 @@ checkValSigLhs lhs@(L l _)
-- A common error is to forget the ForeignFunctionInterface flag
-- so check for that, and suggest. cf Trac #3805
-- Sadly 'foreign import' still barfs 'parse error' because 'import' is a keyword
- looks_like s (L _ (HsVar _ (L _ v))) = v == s
- looks_like s (L _ (HsApp _ lhs _)) = looks_like s lhs
- looks_like _ _ = False
+ looks_like s (L _ (HsVar (L _ v))) = v == s
+ looks_like s (L _ (HsApp lhs _)) = looks_like s lhs
+ looks_like _ _ = False
foreign_RDR = mkUnqual varName (fsLit "foreign")
default_RDR = mkUnqual varName (fsLit "default")
@@ -1054,13 +1052,13 @@ checkDoAndIfThenElse guardExpr semiThen thenExpr semiElse elseExpr
-- not be any OpApps inside the e's
splitBang :: LHsExpr GhcPs -> Maybe (LHsExpr GhcPs, [LHsExpr GhcPs])
-- Splits (f ! g a b) into (f, [(! g), a, b])
-splitBang (L _ (OpApp _ l_arg bang@(L _ (HsVar _ (L _ op))) r_arg))
- | op == bang_RDR = Just (l_arg, L l' (SectionR noExt bang arg1) : argns)
+splitBang (L _ (OpApp l_arg bang@(L _ (HsVar (L _ op))) _ r_arg))
+ | op == bang_RDR = Just (l_arg, L l' (SectionR bang arg1) : argns)
where
l' = combineLocs bang arg1
(arg1,argns) = split_bang r_arg []
- split_bang (L _ (HsApp _ f e)) es = split_bang f (e:es)
- split_bang e es = (e,es)
+ split_bang (L _ (HsApp f e)) es = split_bang f (e:es)
+ split_bang e es = (e,es)
splitBang _ = Nothing
isFunLhs :: LHsExpr GhcPs
@@ -1079,15 +1077,14 @@ isFunLhs :: LHsExpr GhcPs
isFunLhs e = go e [] []
where
- go (L loc (HsVar _ (L _ f))) es ann
- | not (isRdrDataCon f) = return (Just (L loc f, Prefix, es, ann))
- go (L _ (HsApp _ f e)) es ann = go f (e:es) ann
- go (L l (HsPar _ e)) es@(_:_) ann = go e es (ann ++ mkParensApiAnn l)
+ go (L loc (HsVar (L _ f))) es ann
+ | not (isRdrDataCon f) = return (Just (L loc f, Prefix, es, ann))
+ go (L _ (HsApp f e)) es ann = go f (e:es) ann
+ go (L l (HsPar e)) es@(_:_) ann = go e es (ann ++ mkParensApiAnn l)
-- Things of the form `!x` are also FunBinds
-- See Note [FunBind vs PatBind]
- go (L _ (SectionR _ (L _ (HsVar _ (L _ bang))) (L l (HsVar _ (L _ var)))))
- [] ann
+ go (L _ (SectionR (L _ (HsVar (L _ bang))) (L l (HsVar (L _ var))))) [] ann
| bang == bang_RDR
, not (isRdrDataCon var) = return (Just (L l var, Prefix, [], ann))
@@ -1104,7 +1101,7 @@ isFunLhs e = go e [] []
-- ToDo: what about this?
-- x + 1 `op` y = ...
- go e@(L loc (OpApp _ l (L loc' (HsVar _ (L _ op))) r)) es ann
+ go e@(L loc (OpApp l (L loc' (HsVar (L _ op))) fix r)) es ann
| Just (e',es') <- splitBang e
= do { bang_on <- extension bangPatEnabled
; if bang_on then go e' (es' ++ es) ann
@@ -1118,8 +1115,7 @@ isFunLhs e = go e [] []
Just (op', Infix, j : k : es', ann')
-> return (Just (op', Infix, j : op_app : es', ann'))
where
- op_app = L loc (OpApp noExt k
- (L loc' (HsVar noExt (L loc' op))) r)
+ op_app = L loc (OpApp k (L loc' (HsVar (L loc' op))) fix r)
_ -> return Nothing }
go _ _ _ = return Nothing
@@ -1128,24 +1124,23 @@ isFunLhs e = go e [] []
-- (((~a) ~b) c) ~d ==> ((~a) ~ (b c)) ~ d
splitTilde :: LHsType GhcPs -> P (LHsType GhcPs)
splitTilde t = go t
- where go (L loc (HsAppTy _ t1 t2))
- | L lo (HsBangTy _ (HsSrcBang NoSourceText NoSrcUnpack SrcLazy) t2')
+ where go (L loc (HsAppTy t1 t2))
+ | L lo (HsBangTy (HsSrcBang NoSourceText NoSrcUnpack SrcLazy) t2')
<- t2
= do
moveAnnotations lo loc
t1' <- go t1
- return (L loc (HsEqTy noExt t1' t2'))
+ return (L loc (HsEqTy t1' t2'))
| otherwise
= do
t1' <- go t1
case t1' of
- (L lo (HsEqTy _ tl tr)) -> do
+ (L lo (HsEqTy tl tr)) -> do
let lr = combineLocs tr t2
moveAnnotations lo loc
- return (L loc (HsEqTy noExt tl
- (L lr (HsAppTy noExt tr t2))))
+ return (L loc (HsEqTy tl (L lr (HsAppTy tr t2))))
t -> do
- return (L loc (HsAppTy noExt t t2))
+ return (L loc (HsAppTy t t2))
go t = return t
@@ -1157,14 +1152,14 @@ splitTildeApps [] = return []
splitTildeApps (t : rest) = do
rest' <- concatMapM go rest
return (t : rest')
- where go (L l (HsAppPrefix _
- (L loc (HsBangTy noExt
+ where go (L l (HsAppPrefix
+ (L loc (HsBangTy
(HsSrcBang NoSourceText NoSrcUnpack SrcLazy)
ty))))
= addAnnotation l AnnTilde tilde_loc >>
return
- [L tilde_loc (HsAppInfix noExt (L tilde_loc eqTyCon_RDR)),
- L l (HsAppPrefix noExt ty)]
+ [L tilde_loc (HsAppInfix (L tilde_loc eqTyCon_RDR)),
+ L l (HsAppPrefix ty)]
-- NOTE: no annotation is attached to an HsAppPrefix, so the
-- surrounding SrcSpan is not critical
where
@@ -1200,35 +1195,34 @@ locMap :: (SrcSpan -> a -> P b) -> Located a -> P (Located b)
locMap f (L l a) = f l a >>= (\b -> return $ L l b)
checkCmd :: SrcSpan -> HsExpr GhcPs -> P (HsCmd GhcPs)
-checkCmd _ (HsArrApp _ e1 e2 haat b) =
- return $ HsCmdArrApp noExt e1 e2 haat b
-checkCmd _ (HsArrForm _ e mf args) =
- return $ HsCmdArrForm noExt e Prefix mf args
-checkCmd _ (HsApp _ e1 e2) =
- checkCommand e1 >>= (\c -> return $ HsCmdApp noExt c e2)
-checkCmd _ (HsLam _ mg) =
- checkCmdMatchGroup mg >>= (\mg' -> return $ HsCmdLam noExt mg')
-checkCmd _ (HsPar _ e) =
- checkCommand e >>= (\c -> return $ HsCmdPar noExt c)
-checkCmd _ (HsCase _ e mg) =
- checkCmdMatchGroup mg >>= (\mg' -> return $ HsCmdCase noExt e mg')
-checkCmd _ (HsIf _ cf ep et ee) = do
+checkCmd _ (HsArrApp e1 e2 ptt haat b) =
+ return $ HsCmdArrApp e1 e2 ptt haat b
+checkCmd _ (HsArrForm e mf args) =
+ return $ HsCmdArrForm e Prefix mf args
+checkCmd _ (HsApp e1 e2) =
+ checkCommand e1 >>= (\c -> return $ HsCmdApp c e2)
+checkCmd _ (HsLam mg) =
+ checkCmdMatchGroup mg >>= (\mg' -> return $ HsCmdLam mg')
+checkCmd _ (HsPar e) =
+ checkCommand e >>= (\c -> return $ HsCmdPar c)
+checkCmd _ (HsCase e mg) =
+ checkCmdMatchGroup mg >>= (\mg' -> return $ HsCmdCase e mg')
+checkCmd _ (HsIf cf ep et ee) = do
pt <- checkCommand et
pe <- checkCommand ee
- return $ HsCmdIf noExt cf ep pt pe
-checkCmd _ (HsLet _ lb e) =
- checkCommand e >>= (\c -> return $ HsCmdLet noExt lb c)
-checkCmd _ (HsDo _ DoExpr (L l stmts)) =
- mapM checkCmdLStmt stmts >>=
- (\ss -> return $ HsCmdDo noExt (L l ss) )
-
-checkCmd _ (OpApp _ eLeft op eRight) = do
+ return $ HsCmdIf cf ep pt pe
+checkCmd _ (HsLet lb e) =
+ checkCommand e >>= (\c -> return $ HsCmdLet lb c)
+checkCmd _ (HsDo DoExpr (L l stmts) ty) =
+ mapM checkCmdLStmt stmts >>= (\ss -> return $ HsCmdDo (L l ss) ty)
+
+checkCmd _ (OpApp eLeft op _fixity eRight) = do
-- OpApp becomes a HsCmdArrForm with a (Just fixity) in it
c1 <- checkCommand eLeft
c2 <- checkCommand eRight
- let arg1 = L (getLoc c1) $ HsCmdTop noExt c1
- arg2 = L (getLoc c2) $ HsCmdTop noExt c2
- return $ HsCmdArrForm noExt op Infix Nothing [arg1, arg2]
+ let arg1 = L (getLoc c1) $ HsCmdTop c1 placeHolderType placeHolderType []
+ arg2 = L (getLoc c2) $ HsCmdTop c2 placeHolderType placeHolderType []
+ return $ HsCmdArrForm op Infix Nothing [arg1, arg2]
checkCmd l e = cmdFail l e
@@ -1292,7 +1286,7 @@ mkRecConstrOrUpdate
-> ([LHsRecField GhcPs (LHsExpr GhcPs)], Bool)
-> P (HsExpr GhcPs)
-mkRecConstrOrUpdate (L l (HsVar _ (L _ c))) _ (fs,dd)
+mkRecConstrOrUpdate (L l (HsVar (L _ c))) _ (fs,dd)
| isRdrDataCon c
= return (mkRdrRecordCon (L l c) (mk_rec_fields fs dd))
mkRecConstrOrUpdate exp@(L l _) _ (fs,dd)
@@ -1301,23 +1295,23 @@ mkRecConstrOrUpdate exp@(L l _) _ (fs,dd)
mkRdrRecordUpd :: LHsExpr GhcPs -> [LHsRecUpdField GhcPs] -> HsExpr GhcPs
mkRdrRecordUpd exp flds
- = RecordUpd { rupd_ext = noExt
- , rupd_expr = exp
- , rupd_flds = flds }
+ = RecordUpd { rupd_expr = exp
+ , rupd_flds = flds
+ , rupd_cons = PlaceHolder, rupd_in_tys = PlaceHolder
+ , rupd_out_tys = PlaceHolder, rupd_wrap = PlaceHolder }
mkRdrRecordCon :: Located RdrName -> HsRecordBinds GhcPs -> HsExpr GhcPs
mkRdrRecordCon con flds
- = RecordCon { rcon_ext = noExt, rcon_con_name = con, rcon_flds = flds }
+ = RecordCon { rcon_con_name = con, rcon_flds = flds
+ , rcon_con_expr = noPostTcExpr, rcon_con_like = PlaceHolder }
mk_rec_fields :: [LHsRecField id arg] -> Bool -> HsRecFields id arg
mk_rec_fields fs False = HsRecFields { rec_flds = fs, rec_dotdot = Nothing }
mk_rec_fields fs True = HsRecFields { rec_flds = fs, rec_dotdot = Just (length fs) }
mk_rec_upd_field :: HsRecField GhcPs (LHsExpr GhcPs) -> HsRecUpdField GhcPs
-mk_rec_upd_field (HsRecField (L loc (FieldOcc _ rdr)) arg pun)
- = HsRecField (L loc (Unambiguous noExt rdr)) arg pun
-mk_rec_upd_field (HsRecField (L _ (XFieldOcc _)) _ _)
- = panic "mk_rec_upd_field"
+mk_rec_upd_field (HsRecField (L loc (FieldOcc rdr _)) arg pun)
+ = HsRecField (L loc (Unambiguous rdr PlaceHolder)) arg pun
mkInlinePragma :: SourceText -> (InlineSpec, RuleMatchInfo) -> Maybe Activation
-> InlinePragma
@@ -1569,11 +1563,11 @@ data SumOrTuple
mkSumOrTuple :: Boxity -> SrcSpan -> SumOrTuple -> P (HsExpr GhcPs)
-- Tuple
-mkSumOrTuple boxity _ (Tuple es) = return (ExplicitTuple noExt es boxity)
+mkSumOrTuple boxity _ (Tuple es) = return (ExplicitTuple es boxity)
-- Sum
mkSumOrTuple Unboxed _ (Sum alt arity e) =
- return (ExplicitSum noExt alt arity e)
+ return (ExplicitSum alt arity e PlaceHolder)
mkSumOrTuple Boxed l (Sum alt arity (L _ e)) =
parseErrorSDoc l (hang (text "Boxed sums not supported:") 2 (ppr_boxed_sum alt arity e))
where
View Lorry Controller Status