summaryrefslogtreecommitdiff
path: root/compiler/parser
diff options
context:
space:
mode:
Diffstat (limited to 'compiler/parser')
-rw-r--r--compiler/parser/Parser.y255
-rw-r--r--compiler/parser/RdrHsSyn.hs275
2 files changed, 266 insertions, 264 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
diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs
index dc35c124cb..68d152e62e 100644
--- a/compiler/parser/RdrHsSyn.hs
+++ b/compiler/parser/RdrHsSyn.hs
@@ -189,7 +189,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
@@ -289,10 +289,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
@@ -352,7 +352,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 $ ValBindsIn mbs sigs }
+ return $ ValBinds noExt mbs sigs }
cvBindsAndSigs :: OrdList (LHsDecl GhcPs)
-> P (LHsBinds GhcPs, [LSig GhcPs], [LFamilyDecl GhcPs]
@@ -483,28 +483,28 @@ splitCon ty
= split apps' []
where
-- This is used somewhere where HsAppsTy is not used
- unrollApps (L _ (HsAppTy t u)) = u : unrollApps t
+ unrollApps (L _ (HsAppTy _ t u)) = u : unrollApps t
unrollApps t = [t]
apps = unrollApps ty
- oneDoc = [ () | L _ (HsDocTy _ _) <- apps ] `lengthIs` 1
+ oneDoc = [ () | L _ (HsDocTy{}) <- apps ] `lengthIs` 1
-- the trailing doc, if any, can be extracted first
(apps', trailing_doc)
= case apps of
- L _ (HsDocTy t ds) : ts | oneDoc -> (t : ts, Just ds)
+ L _ (HsDocTy _ t ds) : ts | oneDoc -> (t : ts, Just ds)
ts -> (ts, Nothing)
-- A comment on the constructor is handled a bit differently - it doesn't
-- remain an 'HsDocTy', but gets lifted out and returned as the third
-- element of the tuple.
- split [ L _ (HsDocTy con con_doc) ] ts = do
+ split [ L _ (HsDocTy _ con con_doc) ] ts = do
(data_con, con_details, con_doc') <- split [con] ts
return (data_con, con_details, con_doc' `mplus` Just con_doc)
- split [ L l (HsTyVar _ (L _ tc)) ] ts = do
+ split [ L l (HsTyVar _ _ (L _ tc)) ] ts = do
data_con <- tyConToDataCon l tc
return (data_con, mk_rest ts, trailing_doc)
- split [ L l (HsTupleTy HsBoxedOrConstraintTuple ts) ] []
+ split [ L l (HsTupleTy _ HsBoxedOrConstraintTuple ts) ] []
= return ( L l (getRdrName (tupleDataCon Boxed (length ts)))
, PrefixCon ts
, trailing_doc
@@ -514,9 +514,9 @@ splitCon ty
split (u : us) ts = split us (u : ts)
split _ _ = panic "RdrHsSyn:splitCon"
- mk_rest [L _ (HsDocTy t@(L _ HsRecTy{}) _)] = mk_rest [t]
- mk_rest [L l (HsRecTy flds)] = RecCon (L l flds)
- mk_rest ts = PrefixCon ts
+ mk_rest [L _ (HsDocTy _ t@(L _ HsRecTy{}) _)] = mk_rest [t]
+ 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]
@@ -539,9 +539,9 @@ tyConToDataCon loc tc
-- | Split a type to extract the trailing doc string (if there is one) from a
-- type produced by the 'btype_no_ops' production.
splitDocTy :: LHsType GhcPs -> (LHsType GhcPs, Maybe LHsDocString)
-splitDocTy (L l (HsAppTy t1 t2)) = (L l (HsAppTy t1 t2'), ds)
+splitDocTy (L l (HsAppTy x t1 t2)) = (L l (HsAppTy x t1 t2'), ds)
where ~(t2', ds) = splitDocTy t2
-splitDocTy (L _ (HsDocTy ty ds)) = (ty, Just ds)
+splitDocTy (L _ (HsDocTy _ ty ds)) = (ty, Just ds)
splitDocTy ty = (ty, Nothing)
-- | Given a type that is a field to an infix data constructor, try to split
@@ -627,17 +627,17 @@ mkGadtDecl names ty
(mcxt, tau) = split_rho rho
split_rho (L _ (HsQualTy { hst_ctxt = cxt, hst_body = tau }))
- = (Just cxt, tau)
- split_rho (L _ (HsParTy ty)) = split_rho ty
- split_rho tau = (Nothing, tau)
+ = (Just cxt, tau)
+ split_rho (L _ (HsParTy _ ty)) = split_rho ty
+ split_rho tau = (Nothing, tau)
(args, res_ty) = split_tau tau
-- See Note [GADT abstract syntax] in HsDecls
- split_tau (L _ (HsFunTy (L loc (HsRecTy rf)) res_ty))
- = (RecCon (L loc rf), res_ty)
- split_tau (L _ (HsParTy ty)) = split_tau ty
- split_tau tau = (PrefixCon [], tau)
+ split_tau (L _ (HsFunTy _ (L loc (HsRecTy _ rf)) res_ty))
+ = (RecCon (L loc rf), res_ty)
+ split_tau (L _ (HsParTy _ ty)) = split_tau ty
+ split_tau tau = (PrefixCon [], tau)
setRdrNameSpace :: RdrName -> NameSpace -> RdrName
-- ^ This rather gruesome function is used mainly by the parser.
@@ -745,13 +745,13 @@ checkTyVars pp_what equals_or_where tc tparms
= do { tvs <- mapM chk tparms
; return (mkHsQTvs tvs) }
where
- chk (L _ (HsParTy ty)) = chk ty
+ chk (L _ (HsParTy _ ty)) = chk ty
-- Check that the name space is correct!
- chk (L l (HsKindSig (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 (L l (HsKindSig _ (L lv (HsTyVar _ _ (L _ tv))) k))
+ | isRdrTyVar tv = return (L l (KindedTyVar PlaceHolder (L lv tv) k))
+ chk (L l (HsTyVar _ _ (L ltv tv)))
+ | isRdrTyVar tv = return (L l (UserTyVar PlaceHolder (L ltv tv)))
chk t@(L loc _)
= Left (loc,
vcat [ text "Unexpected type" <+> quotes (ppr t)
@@ -815,23 +815,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
@@ -846,8 +846,8 @@ checkTyClHdr is_cls ty
-- etc. and BlockArguments is not enabled.
checkBlockArguments :: LHsExpr GhcPs -> P ()
checkBlockArguments expr = case unLoc expr of
- HsDo DoExpr _ _ -> check "do block"
- HsDo MDoExpr _ _ -> check "mdo block"
+ HsDo _ DoExpr _ -> check "do block"
+ HsDo _ MDoExpr _ -> check "mdo block"
HsLam {} -> check "lambda expression"
HsCase {} -> check "case expression"
HsLamCase {} -> check "lambda-case expression"
@@ -878,16 +878,17 @@ checkContext :: LHsType GhcPs -> P ([AddAnn],LHsContext GhcPs)
checkContext (L l orig_t)
= check [] (L l orig_t)
where
- check anns (L lp (HsTupleTy HsBoxedOrConstraintTuple ts))
+ check anns (L lp (HsTupleTy _ HsBoxedOrConstraintTuple ts))
-- (Eq a, Ord b) shows up as a tuple type. Only boxed tuples can
-- be used as context constraints.
= 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)
@@ -902,10 +903,10 @@ checkContext (L l orig_t)
checkNoDocs :: SDoc -> LHsType GhcPs -> P ()
checkNoDocs msg ty = go ty
where
- go (L _ (HsAppTy t1 t2)) = go t1 *> go t2
- go (L l (HsDocTy t ds)) = parseErrorSDoc l $ hsep
- [ text "Unexpected haddock", quotes (ppr ds)
- , text "on", msg, quotes (ppr t) ]
+ go (L _ (HsAppTy _ t1 t2)) = go t1 *> go t2
+ go (L l (HsDocTy _ t ds)) = parseErrorSDoc l $ hsep
+ [ text "Unexpected haddock", quotes (ppr ds)
+ , text "on", msg, quotes (ppr t) ]
go _ = pure ()
-- -------------------------------------------------------------------------
@@ -925,7 +926,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
@@ -935,7 +936,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) []
@@ -949,76 +950,76 @@ checkAPat msg loc e0 = do
pState <- getPState
let opts = options pState
case e0 of
- EWildPat -> return (WildPat placeHolderType)
- HsVar x -> return (VarPat x)
- HsLit (HsStringPrim _ _) -- (#13260)
+ EWildPat _ -> return (WildPat noExt)
+ HsVar _ x -> return (VarPat noExt x)
+ HsLit _ (HsStringPrim _ _) -- (#13260)
-> parseErrorSDoc loc (text "Illegal unboxed string literal in pattern:" $$ ppr e0)
- HsLit l -> return (LitPat l)
+ HsLit _ l -> return (LitPat noExt 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 { hintBangPat loc e0
; e' <- checkLPat msg e
; addAnnotation loc AnnBang lb
- ; return (BangPat e') }
+ ; return (BangPat noExt e') }
- ELazyPat e -> checkLPat msg e >>= (return . LazyPat)
- EAsPat n e -> checkLPat msg e >>= (return . AsPat n)
+ ELazyPat _ e -> checkLPat msg e >>= (return . (LazyPat noExt))
+ EAsPat _ n e -> checkLPat msg e >>= (return . (AsPat noExt) n)
-- view pattern is well-formed if the pattern is
- EViewPat expr patE -> checkLPat msg patE >>=
- (return . (\p -> ViewPat expr p placeHolderType))
- ExprWithTySig e t -> do e <- checkLPat msg e
- return (SigPatIn e t)
+ EViewPat _ expr patE -> checkLPat msg patE >>=
+ (return . (\p -> ViewPat noExt expr p))
+ ExprWithTySig t e -> do e <- checkLPat msg e
+ return (SigPat t e)
-- 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 (L cl (HsVar (L _ c))) _fix r
+ OpApp _ l (L cl (HsVar _ (L _ c))) r
| isDataOcc (rdrNameOcc c) -> do
l <- checkLPat msg l
r <- checkLPat msg r
return (ConPatIn (L cl c) (InfixCon l r))
- OpApp _l _op _fix _r -> patFail msg loc e0
+ OpApp {} -> patFail msg loc e0
- HsPar e -> checkLPat msg e >>= (return . ParPat)
- ExplicitList _ _ es -> do ps <- mapM (checkLPat msg) es
- return (ListPat ps placeHolderType Nothing)
+ HsPar _ e -> checkLPat msg e >>= (return . (ParPat noExt))
+ ExplicitList _ _ es -> do ps <- mapM (checkLPat msg) es
+ return (ListPat noExt ps placeHolderType Nothing)
ExplicitPArr _ es -> do ps <- mapM (checkLPat msg) es
- return (PArrPat ps placeHolderType)
+ return (PArrPat noExt ps)
- ExplicitTuple es b
+ ExplicitTuple _ es b
| all tupArgPresent es -> do ps <- mapM (checkLPat msg)
- [e | L _ (Present e) <- es]
- return (TuplePat ps b [])
+ [e | L _ (Present _ e) <- es]
+ return (TuplePat noExt 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 p alt arity placeHolderType)
+ return (SumPat noExt p alt arity)
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 s)
+ HsSpliceE _ s | not (isTypedSplice s)
+ -> return (SplicePat noExt 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 (noLoc pun_RDR))
+placeHolderPunRhs = noLoc (HsVar noExt (noLoc pun_RDR))
plus_RDR, bang_RDR, pun_RDR :: RdrName
plus_RDR = mkUnqual varName (fsLit "+") -- Hack
@@ -1052,7 +1053,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 lhs (mkLHsSigWcType sig))) grhss
+ (ExprWithTySig (mkLHsSigWcType sig) lhs)) grhss
checkValDef msg strictness lhs Nothing g@(L l (_,grhss))
= do { mb_fun <- isFunLhs lhs
@@ -1105,7 +1106,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
@@ -1127,9 +1128,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")
@@ -1162,13 +1163,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 bang arg1) : argns)
+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)
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
@@ -1187,14 +1188,15 @@ 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))
@@ -1211,7 +1213,7 @@ isFunLhs e = go e [] []
-- ToDo: what about this?
-- x + 1 `op` y = ...
- go e@(L loc (OpApp l (L loc' (HsVar (L _ op))) fix r)) es ann
+ go e@(L loc (OpApp _ l (L loc' (HsVar _ (L _ op))) r)) es ann
| Just (e',es') <- splitBang e
= do { bang_on <- extension bangPatEnabled
; if bang_on then go e' (es' ++ es) ann
@@ -1225,7 +1227,8 @@ 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 k (L loc' (HsVar (L loc' op))) fix r)
+ op_app = L loc (OpApp noExt k
+ (L loc' (HsVar noExt (L loc' op))) r)
_ -> return Nothing }
go _ _ _ = return Nothing
@@ -1234,23 +1237,24 @@ 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 t1' t2'))
+ return (L loc (HsEqTy noExt 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 tl (L lr (HsAppTy tr t2))))
+ return (L loc (HsEqTy noExt tl
+ (L lr (HsAppTy noExt tr t2))))
t -> do
- return (L loc (HsAppTy t t2))
+ return (L loc (HsAppTy noExt t t2))
go t = return t
@@ -1262,14 +1266,14 @@ splitTildeApps [] = return []
splitTildeApps (t : rest) = do
rest' <- concatMapM go rest
return (t : rest')
- where go (L l (HsAppPrefix
- (L loc (HsBangTy
+ where go (L l (HsAppPrefix _
+ (L loc (HsBangTy noExt
(HsSrcBang NoSourceText NoSrcUnpack SrcLazy)
ty))))
= addAnnotation l AnnTilde tilde_loc >>
return
- [L tilde_loc (HsAppInfix (L tilde_loc eqTyCon_RDR)),
- L l (HsAppPrefix ty)]
+ [L tilde_loc (HsAppInfix noExt (L tilde_loc eqTyCon_RDR)),
+ L l (HsAppPrefix noExt ty)]
-- NOTE: no annotation is attached to an HsAppPrefix, so the
-- surrounding SrcSpan is not critical
where
@@ -1305,34 +1309,35 @@ 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 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
+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
pt <- checkCommand et
pe <- checkCommand ee
- 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
+ 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
-- OpApp becomes a HsCmdArrForm with a (Just fixity) in it
c1 <- checkCommand eLeft
c2 <- checkCommand eRight
- let arg1 = L (getLoc c1) $ HsCmdTop c1 placeHolderType placeHolderType []
- arg2 = L (getLoc c2) $ HsCmdTop c2 placeHolderType placeHolderType []
- return $ HsCmdArrForm op Infix Nothing [arg1, arg2]
+ let arg1 = L (getLoc c1) $ HsCmdTop noExt c1
+ arg2 = L (getLoc c2) $ HsCmdTop noExt c2
+ return $ HsCmdArrForm noExt op Infix Nothing [arg1, arg2]
checkCmd l e = cmdFail l e
@@ -1396,7 +1401,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)
@@ -1405,23 +1410,23 @@ mkRecConstrOrUpdate exp@(L l _) _ (fs,dd)
mkRdrRecordUpd :: LHsExpr GhcPs -> [LHsRecUpdField GhcPs] -> HsExpr GhcPs
mkRdrRecordUpd exp flds
- = RecordUpd { rupd_expr = exp
- , rupd_flds = flds
- , rupd_cons = PlaceHolder, rupd_in_tys = PlaceHolder
- , rupd_out_tys = PlaceHolder, rupd_wrap = PlaceHolder }
+ = RecordUpd { rupd_ext = noExt
+ , rupd_expr = exp
+ , rupd_flds = flds }
mkRdrRecordCon :: Located RdrName -> HsRecordBinds GhcPs -> HsExpr GhcPs
mkRdrRecordCon con flds
- = RecordCon { rcon_con_name = con, rcon_flds = flds
- , rcon_con_expr = noPostTcExpr, rcon_con_like = PlaceHolder }
+ = RecordCon { rcon_ext = noExt, rcon_con_name = con, rcon_flds = flds }
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 rdr PlaceHolder)) arg pun
+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"
mkInlinePragma :: SourceText -> (InlineSpec, RuleMatchInfo) -> Maybe Activation
-> InlinePragma
@@ -1681,11 +1686,11 @@ data SumOrTuple
mkSumOrTuple :: Boxity -> SrcSpan -> SumOrTuple -> P (HsExpr GhcPs)
-- Tuple
-mkSumOrTuple boxity _ (Tuple es) = return (ExplicitTuple es boxity)
+mkSumOrTuple boxity _ (Tuple es) = return (ExplicitTuple noExt es boxity)
-- Sum
mkSumOrTuple Unboxed _ (Sum alt arity e) =
- return (ExplicitSum alt arity e PlaceHolder)
+ return (ExplicitSum noExt alt arity e)
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