summaryrefslogtreecommitdiff
path: root/compiler/parser/Parser.y
diff options
context:
space:
mode:
authorAlan Zimmerman <alan.zimm@gmail.com>2018-04-01 21:33:53 +0200
committerAlan Zimmerman <alan.zimm@gmail.com>2018-04-09 21:29:05 +0200
commit1aa1d405d8212a99ac24dcfd48024a17c3ffd296 (patch)
treedfb9cc90fce7e4a42fd4ca9024477b3d58b60ac5 /compiler/parser/Parser.y
parent48f55e764bb41848cff759fbea3211d8a0bbfd5b (diff)
downloadhaskell-1aa1d405d8212a99ac24dcfd48024a17c3ffd296.tar.gz
Restore Trees That Grow reverted commits
The following commits were reverted prior to the release of GHC 8.4.1, because the time to derive Data instances was too long [1]. 438dd1cbba13d35f3452b4dcef3f94ce9a216905 Phab:D4147 e3ec2e7ae94524ebd111963faf34b84d942265b4 Phab:D4177 47ad6578ea460999b53eb4293c3a3b3017a56d65 Phab:D4186 The work is continuing, as the minimum bootstrap compiler is now GHC 8.2.1, and this allows Plan B[2] for instances to be used. This will land in a following commit. Updates Haddock submodule [1] https://ghc.haskell.org/trac/ghc/wiki/ImplementingTreesThatGrow/Instances [2] https://ghc.haskell.org/trac/ghc/wiki/ImplementingTreesThatGrow/Instances#PLANB
Diffstat (limited to 'compiler/parser/Parser.y')
-rw-r--r--compiler/parser/Parser.y255
1 files changed, 126 insertions, 129 deletions
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y
index 8079c7ee7f..bbb75176bc 100644
--- a/compiler/parser/Parser.y
+++ b/compiler/parser/Parser.y
@@ -1791,13 +1791,15 @@ 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 $1 $3))
+ | ipvar '::' type {% ams (sLL $1 $> (HsIParamTy noExt $1 $3))
[mu AnnDcolon $2] }
| type { $1 }
@@ -1816,13 +1818,15 @@ 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 $1 $3))
+ | ipvar '::' type {% ams (sLL $1 $> (HsIParamTy noExt $1 $3))
[mu AnnDcolon $2] }
| typedoc { $1 }
@@ -1874,19 +1878,20 @@ is connected to the first type too.
type :: { LHsType GhcPs }
: btype { $1 }
- | btype '->' ctype {% ams (sLL $1 $> $ HsFunTy $1 $3)
+ | btype '->' ctype {% ams (sLL $1 $> $ HsFunTy noExt $1 $3)
[mu AnnRarrow $2] }
typedoc :: { LHsType GhcPs }
: btype { $1 }
- | btype docprev { sLL $1 $> $ HsDocTy $1 $2 }
+ | btype docprev { sLL $1 $> $ HsDocTy noExt $1 $2 }
| btype '->' ctypedoc {% ams $1 [mu AnnRarrow $2] -- See note [GADT decl discards annotations]
- >> ams (sLL $1 $> $ HsFunTy $1 $3)
+ >> ams (sLL $1 $> $ HsFunTy noExt $1 $3)
[mu AnnRarrow $2] }
| btype docprev '->' ctypedoc {% ams $1 [mu AnnRarrow $3] -- See note [GADT decl discards annotations]
>> ams (sLL $1 $> $
- HsFunTy (L (comb2 $1 $2) (HsDocTy $1 $2))
+ HsFunTy noExt (L (comb2 $1 $2)
+ (HsDocTy noExt $1 $2))
$4)
[mu AnnRarrow $3] }
@@ -1900,7 +1905,7 @@ btype :: { LHsType GhcPs }
-- > data Foo = Int :+ Char :* Bool
-- See also Note [Parsing data constructors is hard] in RdrHsSyn
btype_no_ops :: { LHsType GhcPs }
- : btype_no_ops atype_docs { sLL $1 $> $ HsAppTy $1 $2 }
+ : btype_no_ops atype_docs { sLL $1 $> $ HsAppTy noExt $1 $2 }
| atype_docs { $1 }
tyapps :: { Located [LHsAppType GhcPs] } -- NB: This list is reversed
@@ -1909,62 +1914,62 @@ tyapps :: { Located [LHsAppType GhcPs] } -- NB: This list is reversed
-- See Note [HsAppsTy] in HsTypes
tyapp :: { LHsAppType GhcPs }
- : atype { sL1 $1 $ HsAppPrefix $1 }
- | qtyconop { sL1 $1 $ HsAppInfix $1 }
- | tyvarop { sL1 $1 $ HsAppInfix $1 }
- | SIMPLEQUOTE qconop {% ams (sLL $1 $> $ HsAppInfix $2)
+ : 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)
[mj AnnSimpleQuote $1] }
- | SIMPLEQUOTE varop {% ams (sLL $1 $> $ HsAppInfix $2)
+ | SIMPLEQUOTE varop {% ams (sLL $1 $> $ HsAppInfix noExt $2)
[mj AnnSimpleQuote $1] }
atype_docs :: { LHsType GhcPs }
- : atype docprev { sLL $1 $> $ HsDocTy $1 $2 }
+ : atype docprev { sLL $1 $> $ HsDocTy noExt $1 $2 }
| atype { $1 }
atype :: { LHsType GhcPs }
- : 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))
+ : 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))
(fst $ unLoc $1) } -- Constructor sigs only
| '{' fielddecls '}' {% amms (checkRecordSyntax
- (sLL $1 $> $ HsRecTy $2))
+ (sLL $1 $> $ HsRecTy noExt $2))
-- Constructor sigs only
[moc $1,mcc $3] }
- | '(' ')' {% ams (sLL $1 $> $ HsTupleTy
+ | '(' ')' {% ams (sLL $1 $> $ HsTupleTy noExt
HsBoxedOrConstraintTuple [])
[mop $1,mcp $2] }
| '(' ctype ',' comma_types1 ')' {% addAnnotation (gl $2) AnnComma
(gl $3) >>
- ams (sLL $1 $> $ HsTupleTy
+ ams (sLL $1 $> $ HsTupleTy noExt
+
HsBoxedOrConstraintTuple ($2 : $4))
[mop $1,mcp $5] }
- | '(#' '#)' {% ams (sLL $1 $> $ HsTupleTy HsUnboxedTuple [])
+ | '(#' '#)' {% ams (sLL $1 $> $ HsTupleTy noExt HsUnboxedTuple [])
[mo $1,mc $2] }
- | '(#' comma_types1 '#)' {% ams (sLL $1 $> $ HsTupleTy HsUnboxedTuple $2)
+ | '(#' comma_types1 '#)' {% ams (sLL $1 $> $ HsTupleTy noExt HsUnboxedTuple $2)
[mo $1,mc $3] }
- | '(#' bar_types2 '#)' {% ams (sLL $1 $> $ HsSumTy $2)
+ | '(#' bar_types2 '#)' {% ams (sLL $1 $> $ HsSumTy noExt $2)
[mo $1,mc $3] }
- | '[' 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)
+ | '[' 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)
[mop $1,mu AnnDcolon $3,mcp $5] }
- | quasiquote { sL1 $1 (HsSpliceTy (unLoc $1) placeHolderKind) }
+ | quasiquote { sL1 $1 (HsSpliceTy noExt (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 $
+ | TH_ID_SPLICE {%ams (sLL $1 $> $ mkHsSpliceTy HasDollar $ sL1 $1 $ HsVar noExt $
(sL1 $1 (mkUnqual varName (getTH_ID_SPLICE $1))))
[mj AnnThIdSplice $1] }
-- see Note [Promotion] for the followings
- | SIMPLEQUOTE qcon_nowiredlist {% ams (sLL $1 $> $ HsTyVar Promoted $2) [mj AnnSimpleQuote $1,mj AnnName $2] }
+ | SIMPLEQUOTE qcon_nowiredlist {% ams (sLL $1 $> $ HsTyVar noExt Promoted $2) [mj AnnSimpleQuote $1,mj AnnName $2] }
| SIMPLEQUOTE '(' ctype ',' comma_types1 ')'
{% addAnnotation (gl $3) AnnComma (gl $4) >>
- ams (sLL $1 $> $ HsExplicitTupleTy [] ($3 : $5))
+ ams (sLL $1 $> $ HsExplicitTupleTy noExt ($3 : $5))
[mj AnnSimpleQuote $1,mop $2,mcp $6] }
- | SIMPLEQUOTE '[' comma_types0 ']' {% ams (sLL $1 $> $ HsExplicitListTy Promoted
- placeHolderKind $3)
+ | SIMPLEQUOTE '[' comma_types0 ']' {% ams (sLL $1 $> $ HsExplicitListTy noExt Promoted $3)
[mj AnnSimpleQuote $1,mos $2,mcs $4] }
- | SIMPLEQUOTE var {% ams (sLL $1 $> $ HsTyVar Promoted $2)
+ | SIMPLEQUOTE var {% ams (sLL $1 $> $ HsTyVar noExt Promoted $2)
[mj AnnSimpleQuote $1,mj AnnName $2] }
-- Two or more [ty, ty, ty] must be a promoted list type, just as
@@ -1973,13 +1978,12 @@ atype :: { LHsType GhcPs }
-- so you have to quote those.)
| '[' ctype ',' comma_types1 ']' {% addAnnotation (gl $2) AnnComma
(gl $3) >>
- ams (sLL $1 $> $ HsExplicitListTy NotPromoted
- placeHolderKind ($2 : $4))
+ ams (sLL $1 $> $ HsExplicitListTy noExt NotPromoted ($2 : $4))
[mos $1,mcs $5] }
- | INTEGER { sLL $1 $> $ HsTyLit $ HsNumTy (getINTEGERs $1)
- (il_value (getINTEGER $1)) }
- | STRING { sLL $1 $> $ HsTyLit $ HsStrTy (getSTRINGs $1)
- (getSTRING $1) }
+ | INTEGER { sLL $1 $> $ HsTyLit noExt $ HsNumTy (getINTEGERs $1)
+ (il_value (getINTEGER $1)) }
+ | STRING { sLL $1 $> $ HsTyLit noExt $ HsStrTy (getSTRINGs $1)
+ (getSTRING $1) }
| '_' { sL1 $1 $ mkAnonWildCardTy }
-- An inst_type is what occurs in the head of an instance decl
@@ -2014,8 +2018,8 @@ tv_bndrs :: { [LHsTyVarBndr GhcPs] }
| {- empty -} { [] }
tv_bndr :: { LHsTyVarBndr GhcPs }
- : tyvar { sL1 $1 (UserTyVar $1) }
- | '(' tyvar '::' kind ')' {% ams (sLL $1 $> (KindedTyVar $2 $4))
+ : tyvar { sL1 $1 (UserTyVar noExt $1) }
+ | '(' tyvar '::' kind ')' {% ams (sLL $1 $> (KindedTyVar noExt $2 $4))
[mop $1,mu AnnDcolon $3
,mcp $5] }
@@ -2198,7 +2202,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 ln PlaceHolder) (unLoc $2))) $4 ($1 `mplus` $5)))
+ (ConDeclField (reverse (map (\ln@(L l n) -> L l $ FieldOcc noExt ln) (unLoc $2))) $4 ($1 `mplus` $5)))
[mu AnnDcolon $3] }
-- Reversed!
@@ -2269,7 +2273,7 @@ docdecld :: { LDocDecl }
decl_no_th :: { LHsDecl GhcPs }
: sigdecl { $1 }
- | '!' aexp rhs {% do { let { e = sLL $1 $2 (SectionR (sL1 $1 (HsVar (sL1 $1 bang_RDR))) $2)
+ | '!' aexp rhs {% do { let { e = sLL $1 $2 (SectionR noExt (sL1 $1 (HsVar noExt (sL1 $1 bang_RDR))) $2)
; l = comb2 $1 $> };
(ann, r) <- checkValDef empty SrcStrict e Nothing $3 ;
hintBangPat (comb2 $1 $2) (unLoc e) ;
@@ -2421,45 +2425,45 @@ quasiquote :: { Located (HsSplice GhcPs) }
in sL (getLoc $1) (mkHsQuasiQuote quoterId (RealSrcSpan quoteSpan) quote) }
exp :: { LHsExpr GhcPs }
- : infixexp '::' sigtype {% ams (sLL $1 $> $ ExprWithTySig $1 (mkLHsSigWcType $3))
+ : infixexp '::' sigtype {% ams (sLL $1 $> $ ExprWithTySig (mkLHsSigWcType $3) $1)
[mu AnnDcolon $2] }
- | infixexp '-<' exp {% ams (sLL $1 $> $ HsArrApp $1 $3 placeHolderType
+ | infixexp '-<' exp {% ams (sLL $1 $> $ HsArrApp noExt $1 $3
HsFirstOrderApp True)
[mu Annlarrowtail $2] }
- | infixexp '>-' exp {% ams (sLL $1 $> $ HsArrApp $3 $1 placeHolderType
+ | infixexp '>-' exp {% ams (sLL $1 $> $ HsArrApp noExt $3 $1
HsFirstOrderApp False)
[mu Annrarrowtail $2] }
- | infixexp '-<<' exp {% ams (sLL $1 $> $ HsArrApp $1 $3 placeHolderType
+ | infixexp '-<<' exp {% ams (sLL $1 $> $ HsArrApp noExt $1 $3
HsHigherOrderApp True)
[mu AnnLarrowtail $2] }
- | infixexp '>>-' exp {% ams (sLL $1 $> $ HsArrApp $3 $1 placeHolderType
+ | infixexp '>>-' exp {% ams (sLL $1 $> $ HsArrApp noExt $3 $1
HsHigherOrderApp False)
[mu AnnRarrowtail $2] }
| infixexp { $1 }
infixexp :: { LHsExpr GhcPs }
: exp10 { $1 }
- | infixexp qop exp10 {% ams (sLL $1 $> (OpApp $1 $2 placeHolderFixity $3))
+ | infixexp qop exp10 {% ams (sLL $1 $> (OpApp noExt $1 $2 $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 $1 $2 placeHolderFixity $3))
+ {% ams (sLL $1 $> (OpApp noExt $1 $2 $3))
[mj AnnVal $2] }
exp10_top :: { LHsExpr GhcPs }
- : '-' fexp {% ams (sLL $1 $> $ NegApp $2 noSyntaxExpr)
+ : '-' fexp {% ams (sLL $1 $> $ NegApp noExt $2 noSyntaxExpr)
[mj AnnMinus $1] }
- | hpc_annot exp {% ams (sLL $1 $> $ HsTickPragma (snd $ fst $ fst $ unLoc $1)
+ | hpc_annot exp {% ams (sLL $1 $> $ HsTickPragma noExt (snd $ fst $ fst $ unLoc $1)
(snd $ fst $ unLoc $1) (snd $ unLoc $1) $2)
(fst $ fst $ fst $ unLoc $1) }
- | '{-# CORE' STRING '#-}' exp {% ams (sLL $1 $> $ HsCoreAnn (getCORE_PRAGs $1) (getStringLiteral $2) $4)
+ | '{-# CORE' STRING '#-}' exp {% ams (sLL $1 $> $ HsCoreAnn noExt (getCORE_PRAGs $1) (getStringLiteral $2) $4)
[mo $1,mj AnnVal $2
,mc $3] }
-- hdaume: core annotation
@@ -2467,7 +2471,7 @@ exp10_top :: { LHsExpr GhcPs }
exp10 :: { LHsExpr GhcPs }
: exp10_top { $1 }
- | scc_annot exp {% ams (sLL $1 $> $ HsSCC (snd $ fst $ unLoc $1) (snd $ unLoc $1) $2)
+ | scc_annot exp {% ams (sLL $1 $> $ HsSCC noExt (snd $ fst $ unLoc $1) (snd $ unLoc $1) $2)
(fst $ fst $ unLoc $1) }
optSemi :: { ([Located a],Bool) }
@@ -2511,32 +2515,32 @@ hpc_annot :: { Located ( (([AddAnn],SourceText),(StringLiteral,(Int,Int),(Int,In
fexp :: { LHsExpr GhcPs }
: fexp aexp {% checkBlockArguments $1 >> checkBlockArguments $2 >>
- return (sLL $1 $> $ (HsApp $1 $2)) }
+ return (sLL $1 $> $ (HsApp noExt $1 $2)) }
| fexp TYPEAPP atype {% checkBlockArguments $1 >>
- ams (sLL $1 $> $ HsAppType $1 (mkHsWildCardBndrs $3))
+ ams (sLL $1 $> $ HsAppType (mkHsWildCardBndrs $3) $1)
[mj AnnAt $2] }
- | 'static' aexp {% ams (sLL $1 $> $ HsStatic placeHolderNames $2)
+ | 'static' aexp {% ams (sLL $1 $> $ HsStatic noExt $2)
[mj AnnStatic $1] }
| aexp { $1 }
aexp :: { LHsExpr GhcPs }
- : qvar '@' aexp {% ams (sLL $1 $> $ EAsPat $1 $3) [mj AnnAt $2] }
+ : qvar '@' aexp {% ams (sLL $1 $> $ EAsPat noExt $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 $2) [mj AnnTilde $1] }
+ | '~' aexp {% ams (sLL $1 $> $ ELazyPat noExt $2) [mj AnnTilde $1] }
| '\\' apat apats '->' exp
- {% ams (sLL $1 $> $ HsLam (mkMatchGroup FromSource
+ {% ams (sLL $1 $> $ HsLam noExt (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 (snd $ unLoc $2) $4)
+ | 'let' binds 'in' exp {% ams (sLL $1 $> $ HsLet noExt (snd $ unLoc $2) $4)
(mj AnnLet $1:mj AnnIn $3
:(fst $ unLoc $2)) }
| '\\' 'lcase' altslist
- {% ams (sLL $1 $> $ HsLamCase
+ {% ams (sLL $1 $> $ HsLamCase noExt
(mkMatchGroup FromSource (snd $ unLoc $3)))
(mj AnnLam $1:mj AnnCase $2:(fst $ unLoc $3)) }
| 'if' exp optSemi 'then' exp optSemi 'else' exp
@@ -2547,11 +2551,10 @@ aexp :: { 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
- placeHolderType
+ ams (sLL $1 $> $ HsMultiIf noExt
(reverse $ snd $ unLoc $2))
(mj AnnIf $1:(fst $ unLoc $2)) }
- | 'case' exp 'of' altslist {% ams (sLL $1 $> $ HsCase $2 (mkMatchGroup
+ | 'case' exp 'of' altslist {% ams (sLL $1 $> $ HsCase noExt $2 (mkMatchGroup
FromSource (snd $ unLoc $4)))
(mj AnnCase $1:mj AnnOf $3
:(fst $ unLoc $4)) }
@@ -2564,8 +2567,7 @@ aexp :: { LHsExpr GhcPs }
| 'proc' aexp '->' exp
{% checkPattern empty $2 >>= \ p ->
checkCommand $4 >>= \ cmd ->
- ams (sLL $1 $> $ HsProc p (sLL $1 $> $ HsCmdTop cmd placeHolderType
- placeHolderType []))
+ ams (sLL $1 $> $ HsProc noExt p (sLL $1 $> $ HsCmdTop noExt cmd))
-- TODO: is LL right here?
[mj AnnProc $1,mu AnnRarrow $3] }
@@ -2579,72 +2581,70 @@ aexp1 :: { LHsExpr GhcPs }
| aexp2 { $1 }
aexp2 :: { LHsExpr GhcPs }
- : 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) }
+ : 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) }
-- 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 $! mkHsIntegral
- (getINTEGER $1) placeHolderType) }
- | RATIONAL { sL (getLoc $1) (HsOverLit $! mkHsFractional
- (getRATIONAL $1) placeHolderType) }
+ | INTEGER { sL (getLoc $1) (HsOverLit noExt $! mkHsIntegral (getINTEGER $1) ) }
+ | RATIONAL { sL (getLoc $1) (HsOverLit noExt $! mkHsFractional (getRATIONAL $1) ) }
-- 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 $2)) [mop $1,mcp $3] }
+ | '(' texp ')' {% ams (sLL $1 $> (HsPar noExt $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 [L (gl $2)
- (Present $2)] Unboxed))
+ | '(#' texp '#)' {% ams (sLL $1 $> (ExplicitTuple noExt [L (gl $2)
+ (Present noExt $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 }
+ | '_' { sL1 $1 $ EWildPat noExt }
-- Template Haskell Extension
| splice_exp { $1 }
- | 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))
+ | 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))
(if (hasE $1) then [mj AnnOpenE $1, mu AnnCloseQ $3]
else [mu AnnOpenEQ $1,mu AnnCloseQ $3]) }
- | '[||' exp '||]' {% ams (sLL $1 $> $ HsBracket (TExpBr $2))
+ | '[||' exp '||]' {% ams (sLL $1 $> $ HsBracket noExt (TExpBr noExt $2))
(if (hasE $1) then [mj AnnOpenE $1,mc $3] else [mo $1,mc $3]) }
- | '[t|' ctype '|]' {% ams (sLL $1 $> $ HsBracket (TypBr $2)) [mo $1,mu AnnCloseQ $3] }
+ | '[t|' ctype '|]' {% ams (sLL $1 $> $ HsBracket noExt (TypBr noExt $2)) [mo $1,mu AnnCloseQ $3] }
| '[p|' infixexp '|]' {% checkPattern empty $2 >>= \p ->
- ams (sLL $1 $> $ HsBracket (PatBr p))
+ ams (sLL $1 $> $ HsBracket noExt (PatBr noExt p))
[mo $1,mu AnnCloseQ $3] }
- | '[d|' cvtopbody '|]' {% ams (sLL $1 $> $ HsBracket (DecBrL (snd $2)))
+ | '[d|' cvtopbody '|]' {% ams (sLL $1 $> $ HsBracket noExt (DecBrL noExt (snd $2)))
(mo $1:mu AnnCloseQ $3:fst $2) }
- | quasiquote { sL1 $1 (HsSpliceE (unLoc $1)) }
+ | quasiquote { sL1 $1 (HsSpliceE noExt (unLoc $1)) }
-- arrow notation extension
- | '(|' aexp2 cmdargs '|)' {% ams (sLL $1 $> $ HsArrForm $2
+ | '(|' aexp2 cmdargs '|)' {% ams (sLL $1 $> $ HsArrForm noExt $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 (sL1 $1 (mkUnqual varName
+ (sL1 $1 $ HsVar noExt (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 (sL1 $1 (mkUnqual varName
+ (sL1 $1 $ HsVar noExt (sL1 $1 (mkUnqual varName
(getTH_ID_TY_SPLICE $1)))))
[mj AnnThIdTySplice $1] }
| '$$(' exp ')' {% ams (sLL $1 $> $ mkHsSpliceTE HasParens $2)
@@ -2656,8 +2656,7 @@ cmdargs :: { [LHsCmdTop GhcPs] }
acmd :: { LHsCmdTop GhcPs }
: aexp2 {% checkCommand $1 >>= \ cmd ->
- return (sL1 $1 $ HsCmdTop cmd
- placeHolderType placeHolderType []) }
+ return (sL1 $1 $ HsCmdTop noExt cmd) }
cvtopbody :: { ([AddAnn],[LHsDecl GhcPs]) }
: '{' cvtopdecls0 '}' { ([mj AnnOpenC $1
@@ -2688,17 +2687,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 $1 $2 }
- | qopm infixexp { sLL $1 $> $ SectionR $1 $2 }
+ | infixexp qop { sLL $1 $> $ SectionL noExt $1 $2 }
+ | qopm infixexp { sLL $1 $> $ SectionR noExt $1 $2 }
-- View patterns get parenthesized above
- | exp '->' texp {% ams (sLL $1 $> $ EViewPat $1 $3) [mu AnnRarrow $2] }
+ | exp '->' texp {% ams (sLL $1 $> $ EViewPat noExt $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 $1)) : snd $2)) } }
+ ; return ([],Tuple ((sL1 $1 (Present noExt $1)) : snd $2)) } }
| texp bars { (mvbars (fst $2), Sum 1 (snd $2 + 1) $1) }
@@ -2721,8 +2720,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 $1)) : snd $2) }
- | texp { [L (gl $1) (Present $1)] }
+ return ((L (gl $1) (Present noExt $1)) : snd $2) }
+ | texp { [L (gl $1) (Present noExt $1)] }
| {- empty -} { [noLoc missingTupArg] }
-----------------------------------------------------------------------------
@@ -2731,19 +2730,18 @@ 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 placeHolderType Nothing [$1]) }
- | lexps { ([],ExplicitList placeHolderType Nothing
- (reverse (unLoc $1))) }
+ : texp { ([],ExplicitList noExt Nothing [$1]) }
+ | lexps { ([],ExplicitList noExt Nothing (reverse (unLoc $1))) }
| texp '..' { ([mj AnnDotdot $2],
- ArithSeq noPostTcExpr Nothing (From $1)) }
+ ArithSeq noExt Nothing (From $1)) }
| texp ',' exp '..' { ([mj AnnComma $2,mj AnnDotdot $4],
- ArithSeq noPostTcExpr Nothing
+ ArithSeq noExt Nothing
(FromThen $1 $3)) }
| texp '..' exp { ([mj AnnDotdot $2],
- ArithSeq noPostTcExpr Nothing
+ ArithSeq noExt Nothing
(FromTo $1 $3)) }
| texp ',' exp '..' exp { ([mj AnnComma $2,mj AnnDotdot $4],
- ArithSeq noPostTcExpr Nothing
+ ArithSeq noExt Nothing
(FromThenTo $1 $3 $5)) }
| texp '|' flattenedpquals
{% checkMonadComp >>= \ ctxt ->
@@ -2766,7 +2764,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 qs [] noSyntaxExpr |
+ qss -> sL1 $1 [sL1 $1 $ ParStmt [ParStmtBlock noExt qs [] noSyntaxExpr |
qs <- qss]
noExpr noSyntaxExpr placeHolderType]
-- We actually found some actual parallel lists so
@@ -2823,15 +2821,14 @@ transformqual :: { Located ([AddAnn],[LStmt GhcPs (LHsExpr GhcPs)] -> Stmt GhcPs
-- constructor in the list case).
parr :: { ([AddAnn],HsExpr GhcPs) }
- : { ([],ExplicitPArr placeHolderType []) }
- | texp { ([],ExplicitPArr placeHolderType [$1]) }
- | lexps { ([],ExplicitPArr placeHolderType
- (reverse (unLoc $1))) }
+ : { ([],ExplicitPArr noExt []) }
+ | texp { ([],ExplicitPArr noExt [$1]) }
+ | lexps { ([],ExplicitPArr noExt (reverse (unLoc $1))) }
| texp '..' exp { ([mj AnnDotdot $2]
- ,PArrSeq noPostTcExpr (FromTo $1 $3)) }
+ ,PArrSeq noExt (FromTo $1 $3)) }
| texp ',' exp '..' exp
{ ([mj AnnComma $2,mj AnnDotdot $4]
- ,PArrSeq noPostTcExpr (FromThenTo $1 $3 $5)) }
+ ,PArrSeq noExt (FromThenTo $1 $3 $5)) }
| texp '|' flattenedpquals
{ ([mj AnnVbar $2],mkHsComp PArrComp (unLoc $3) $1) }
@@ -2917,8 +2914,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
- (sL1 $1 (HsVar (sL1 $1 bang_RDR))) $2)))
+ | '!' aexp {% amms (checkPattern empty (sLL $1 $> (SectionR noExt
+ (sL1 $1 (HsVar noExt (sL1 $1 bang_RDR))) $2)))
[mj AnnBang $1] }
bindpat :: { LPat GhcPs }
@@ -2926,14 +2923,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 (sL1 $1 (HsVar (sL1 $1 bang_RDR))) $2)))
+ (sLL $1 $> (SectionR noExt (sL1 $1 (HsVar noExt (sL1 $1 bang_RDR))) $2)))
[mj AnnBang $1] }
apat :: { LPat GhcPs }
apat : aexp {% checkPattern empty $1 }
| '!' aexp {% amms (checkPattern empty
- (sLL $1 $> (SectionR
- (sL1 $1 (HsVar (sL1 $1 bang_RDR))) $2)))
+ (sLL $1 $> (SectionR noExt
+ (sL1 $1 (HsVar noExt (sL1 $1 bang_RDR))) $2)))
[mj AnnBang $1] }
apats :: { [LPat GhcPs] }
@@ -3211,8 +3208,8 @@ qtycon :: { Located RdrName } -- Qualified or unqualified
| tycon { $1 }
qtycondoc :: { LHsType GhcPs } -- Qualified or unqualified
- : qtycon { sL1 $1 (HsTyVar NotPromoted $1) }
- | qtycon docprev { sLL $1 $> (HsDocTy (sL1 $1 (HsTyVar NotPromoted $1)) $2) }
+ : qtycon { sL1 $1 (HsTyVar noExt NotPromoted $1) }
+ | qtycon docprev { sLL $1 $> (HsDocTy noExt (sL1 $1 (HsTyVar noExt NotPromoted $1)) $2) }
tycon :: { Located RdrName } -- Unqualified
: CONID { sL1 $1 $! mkUnqual tcClsName (getCONID $1) }
@@ -3245,17 +3242,17 @@ varop :: { Located RdrName }
,mj AnnBackquote $3] }
qop :: { LHsExpr GhcPs } -- used in sections
- : qvarop { sL1 $1 $ HsVar $1 }
- | qconop { sL1 $1 $ HsVar $1 }
+ : qvarop { sL1 $1 $ HsVar noExt $1 }
+ | qconop { sL1 $1 $ HsVar noExt $1 }
| hole_op { $1 }
qopm :: { LHsExpr GhcPs } -- used in sections
- : qvaropm { sL1 $1 $ HsVar $1 }
- | qconop { sL1 $1 $ HsVar $1 }
+ : qvaropm { sL1 $1 $ HsVar noExt $1 }
+ | qconop { sL1 $1 $ HsVar noExt $1 }
| hole_op { $1 }
hole_op :: { LHsExpr GhcPs } -- used in sections
-hole_op : '`' '_' '`' {% ams (sLL $1 $> EWildPat)
+hole_op : '`' '_' '`' {% ams (sLL $1 $> $ EWildPat noExt)
[mj AnnBackquote $1,mj AnnVal $2
,mj AnnBackquote $3] }
@@ -3414,8 +3411,8 @@ literal :: { Located (HsLit GhcPs) }
$ getPRIMCHAR $1 }
| PRIMSTRING { sL1 $1 $ HsStringPrim (getPRIMSTRINGs $1)
$ getPRIMSTRING $1 }
- | PRIMFLOAT { sL1 $1 $ HsFloatPrim def $ getPRIMFLOAT $1 }
- | PRIMDOUBLE { sL1 $1 $ HsDoublePrim def $ getPRIMDOUBLE $1 }
+ | PRIMFLOAT { sL1 $1 $ HsFloatPrim noExt $ getPRIMFLOAT $1 }
+ | PRIMDOUBLE { sL1 $1 $ HsDoublePrim noExt $ getPRIMDOUBLE $1 }
-----------------------------------------------------------------------------
-- Layout
View Lorry Controller Status