diff options
Diffstat (limited to 'compiler/parser')
| -rw-r--r-- | compiler/parser/Parser.y | 147 | ||||
| -rw-r--r-- | compiler/parser/RdrHsSyn.hs | 133 |
2 files changed, 139 insertions, 141 deletions
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index 6c278045b9..2fa94340e8 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -1899,7 +1899,7 @@ atype :: { LHsType GhcPs } | 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 @@ -2202,7 +2202,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) -- Turn it all into an expression so that -- checkPattern can check that bangs are enabled ; l = comb2 $1 $> }; @@ -2355,47 +2355,47 @@ 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 } : '\\' 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 @@ -2406,15 +2406,14 @@ 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 - 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)) } - | '-' fexp {% ams (sLL $1 $> $ NegApp $2 noSyntaxExpr) + | '-' fexp {% ams (sLL $1 $> $ NegApp noExt $2 noSyntaxExpr) [mj AnnMinus $1] } | 'do' stmtlist {% ams (L (comb2 $1 $2) @@ -2424,19 +2423,19 @@ exp10_top :: { LHsExpr GhcPs } (mkHsDo MDoExpr (snd $ unLoc $2))) (mj AnnMdo $1:(fst $ unLoc $2)) } - | hpc_annot exp {% ams (sLL $1 $> $ HsTickPragma (snd $ fst $ fst $ unLoc $1) - (snd $ fst $ unLoc $1) (snd $ unLoc $1) $2) + | 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) } | 'proc' aexp '->' exp {% checkPattern empty $2 >>= \ p -> checkCommand $4 >>= \ cmd -> - ams (sLL $1 $> $ HsProc p (sLL $1 $> $ HsCmdTop cmd placeHolderType + ams (sLL $1 $> $ HsProc noExt 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 (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 @@ -2444,7 +2443,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) } @@ -2487,19 +2486,19 @@ hpc_annot :: { Located ( (([AddAnn],SourceText),(StringLiteral,(Int,Int),(Int,In } fexp :: { LHsExpr GhcPs } - : fexp aexp { sLL $1 $> $ HsApp $1 $2 } - | fexp TYPEAPP atype {% ams (sLL $1 $> $ HsAppType $1 (mkHsWildCardBndrs $3)) + : fexp aexp { sLL $1 $> $ HsApp noExt $1 $2 } + | fexp TYPEAPP atype {% 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] } | aexp1 { $1 } aexp1 :: { LHsExpr GhcPs } @@ -2510,27 +2509,27 @@ 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) ) } - | RATIONAL { sL (getLoc $1) (HsOverLit $! mkHsFractional (getRATIONAL $1) ) } + | 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) + | '(#' texp '#)' {% ams (sLL $1 $> (ExplicitTuple noExt [L (gl $2) (Present $2)] Unboxed)) [mo $1,mc $3] } | '(#' tup_exprs '#)' {% do { e <- mkSumOrTuple Unboxed (comb2 $1 $3) (snd $2) @@ -2538,42 +2537,42 @@ aexp2 :: { LHsExpr GhcPs } | '[' 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 True (unLoc $2))) [mj AnnSimpleQuote $1,mj AnnName $2] } + | SIMPLEQUOTE qcon {% ams (sLL $1 $> $ HsBracket noExt (VarBr True (unLoc $2))) [mj AnnSimpleQuote $1,mj AnnName $2] } + | TH_TY_QUOTE tyvar {% ams (sLL $1 $> $ HsBracket noExt (VarBr False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] } + | TH_TY_QUOTE gtycon {% ams (sLL $1 $> $ HsBracket noExt (VarBr False (unLoc $2))) [mj AnnThTyQuote $1,mj AnnName $2] } + | '[|' exp '|]' {% ams (sLL $1 $> $ HsBracket noExt (ExpBr $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 $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 $2)) [mo $1,mu AnnCloseQ $3] } | '[p|' infixexp '|]' {% checkPattern empty $2 >>= \p -> - ams (sLL $1 $> $ HsBracket (PatBr p)) + ams (sLL $1 $> $ HsBracket noExt (PatBr p)) [mo $1,mu AnnCloseQ $3] } - | '[d|' cvtopbody '|]' {% ams (sLL $1 $> $ HsBracket (DecBrL (snd $2))) + | '[d|' cvtopbody '|]' {% ams (sLL $1 $> $ HsBracket noExt (DecBrL (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) @@ -2617,11 +2616,11 @@ 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) } @@ -2660,19 +2659,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 -> @@ -2752,15 +2750,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) } @@ -2846,8 +2843,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 } @@ -2855,14 +2852,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] } @@ -3174,15 +3171,15 @@ varop :: { Located RdrName } ,mj AnnBackquote $3] } qop :: { LHsExpr GhcPs } -- used in sections - : qvarop { sL1 $1 $ HsVar $1 } - | qconop { sL1 $1 $ HsVar $1 } - | '`' '_' '`' {% ams (sLL $1 $> EWildPat) + : qvarop { sL1 $1 $ HsVar noExt $1 } + | qconop { sL1 $1 $ HsVar noExt $1 } + | '`' '_' '`' {% ams (sLL $1 $> (EWildPat noExt)) [mj AnnBackquote $1,mj AnnVal $2 ,mj AnnBackquote $3] } 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 } qvarop :: { Located RdrName } : qvarsym { $1 } diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs index a74a46abcd..d44be79f64 100644 --- a/compiler/parser/RdrHsSyn.hs +++ b/compiler/parser/RdrHsSyn.hs @@ -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 @@ -817,7 +817,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 +827,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,21 +841,21 @@ checkAPat msg loc e0 = do pState <- getPState let opts = options pState case e0 of - EWildPat -> return (WildPat placeHolderType) - HsVar x -> return (VarPat noExt x) - HsLit (HsStringPrim _ _) -- (#13260) + EWildPat _ -> return (WildPat placeHolderType) + HsVar _ x -> return (VarPat noExt 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 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 { bang_on <- extension bangPatEnabled ; if bang_on then do { e' <- checkLPat msg e @@ -863,54 +863,54 @@ checkAPat msg loc e0 = do ; return (BangPat noExt 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 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 >>= + EViewPat _ expr patE -> checkLPat msg patE >>= (return . (\p -> ViewPat noExt expr p)) - ExprWithTySig e t -> do e <- checkLPat msg e - return (SigPat t e) + 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 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 + 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 - HsPar e -> checkLPat msg e >>= (return . (ParPat noExt)) + 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 noExt ps) - ExplicitTuple es b + ExplicitTuple _ es b | all tupArgPresent es -> do ps <- mapM (checkLPat msg) [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 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) + 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 @@ -944,7 +944,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 @@ -997,7 +997,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 +1019,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 +1054,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 @@ -1079,14 +1079,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)) @@ -1103,7 +1104,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 @@ -1117,7 +1118,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 @@ -1198,28 +1200,29 @@ 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) = +checkCmd _ (HsArrApp _ e1 e2 haat b) = + return $ HsCmdArrApp e1 e2 noExt haat b +checkCmd _ (HsArrForm _ e mf args) = return $ HsCmdArrForm e Prefix mf args -checkCmd _ (HsApp e1 e2) = +checkCmd _ (HsApp _ e1 e2) = checkCommand e1 >>= (\c -> return $ HsCmdApp c e2) -checkCmd _ (HsLam mg) = +checkCmd _ (HsLam _ mg) = checkCmdMatchGroup mg >>= (\mg' -> return $ HsCmdLam mg') -checkCmd _ (HsPar e) = +checkCmd _ (HsPar _ e) = checkCommand e >>= (\c -> return $ HsCmdPar c) -checkCmd _ (HsCase e mg) = +checkCmd _ (HsCase _ e mg) = checkCmdMatchGroup mg >>= (\mg' -> return $ HsCmdCase e mg') -checkCmd _ (HsIf cf ep et ee) = do +checkCmd _ (HsIf _ cf ep et ee) = do pt <- checkCommand et pe <- checkCommand ee return $ HsCmdIf cf ep pt pe -checkCmd _ (HsLet lb e) = +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 _ (HsDo _ DoExpr (L l stmts)) = + mapM checkCmdLStmt stmts >>= + (\ss -> return $ HsCmdDo (L l ss) placeHolderType) -checkCmd _ (OpApp eLeft op _fixity eRight) = do +checkCmd _ (OpApp _ eLeft op eRight) = do -- OpApp becomes a HsCmdArrForm with a (Just fixity) in it c1 <- checkCommand eLeft c2 <- checkCommand eRight @@ -1289,7 +1292,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) @@ -1298,15 +1301,13 @@ 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 } @@ -1568,11 +1569,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 |