diff options
Diffstat (limited to 'compiler/parser')
| -rw-r--r-- | compiler/parser/Parser.y | 20 | ||||
| -rw-r--r-- | compiler/parser/RdrHsSyn.hs | 14 |
2 files changed, 18 insertions, 16 deletions
diff --git a/compiler/parser/Parser.y b/compiler/parser/Parser.y index 40481e5d20..a74d7a8b95 100644 --- a/compiler/parser/Parser.y +++ b/compiler/parser/Parser.y @@ -1323,35 +1323,35 @@ decls :: { Located ([AddAnn],OrdList (LHsDecl RdrName)) } | decl { sL1 $1 ([], unitOL $1) } | {- empty -} { noLoc ([],nilOL) } -decllist :: { Located ([AddAnn],OrdList (LHsDecl RdrName)) } +decllist :: { Located ([AddAnn],Located (OrdList (LHsDecl RdrName))) } : '{' decls '}' { sLL $1 $> (moc $1:mcc $3:(fst $ unLoc $2) - ,snd $ unLoc $2) } - | vocurly decls close { L (gl $2) (fst $ unLoc $2,snd $ unLoc $2) } + ,sL1 $2 $ snd $ unLoc $2) } + | vocurly decls close { L (gl $2) (fst $ unLoc $2,sL1 $2 $ snd $ unLoc $2) } -- Binding groups other than those of class and instance declarations -- -binds :: { Located ([AddAnn],HsLocalBinds RdrName) } +binds :: { Located ([AddAnn],Located (HsLocalBinds RdrName)) } -- May have implicit parameters -- No type declarations - : decllist {% do { val_binds <- cvBindGroup (snd $ unLoc $1) + : decllist {% do { val_binds <- cvBindGroup (unLoc $ snd $ unLoc $1) ; return (sL1 $1 (fst $ unLoc $1 - ,HsValBinds val_binds)) } } + ,sL1 $1 $ HsValBinds val_binds)) } } | '{' dbinds '}' { sLL $1 $> ([moc $1,mcc $3] - ,HsIPBinds (IPBinds (unLoc $2) + ,sL1 $2 $ HsIPBinds (IPBinds (unLoc $2) emptyTcEvBinds)) } | vocurly dbinds close { L (getLoc $2) ([] - ,HsIPBinds (IPBinds (unLoc $2) + ,sL1 $2 $ HsIPBinds (IPBinds (unLoc $2) emptyTcEvBinds)) } -wherebinds :: { Located ([AddAnn],HsLocalBinds RdrName) } +wherebinds :: { Located ([AddAnn],Located (HsLocalBinds RdrName)) } -- May have implicit parameters -- No type declarations : 'where' binds { sLL $1 $> (mj AnnWhere $1 : (fst $ unLoc $2) ,snd $ unLoc $2) } - | {- empty -} { noLoc ([],emptyLocalBinds) } + | {- empty -} { noLoc ([],noLoc emptyLocalBinds) } ----------------------------------------------------------------------------- diff --git a/compiler/parser/RdrHsSyn.hs b/compiler/parser/RdrHsSyn.hs index f804e44f17..384913a1a0 100644 --- a/compiler/parser/RdrHsSyn.hs +++ b/compiler/parser/RdrHsSyn.hs @@ -388,13 +388,15 @@ getMonoBind :: LHsBind RdrName -> [LHsDecl RdrName] -- No AndMonoBinds or EmptyMonoBinds here; just single equations getMonoBind (L loc1 (FunBind { fun_id = fun_id1@(L _ f1), - fun_matches = MG { mg_alts = mtchs1 } })) binds + fun_matches + = MG { mg_alts = L _ mtchs1 } })) binds | has_args mtchs1 = go mtchs1 loc1 binds [] where go mtchs loc (L loc2 (ValD (FunBind { fun_id = L _ f2, - fun_matches = MG { mg_alts = mtchs2 } })) : binds) _ + fun_matches + = MG { mg_alts = L _ mtchs2 } })) : binds) _ | f1 == f2 = go (mtchs2 ++ mtchs) (combineSrcSpans loc loc2) binds [] go mtchs loc (doc_decl@(L loc2 (DocD _)) : binds) doc_decls @@ -1115,8 +1117,8 @@ checkCmd _ (HsIf cf ep et ee) = do return $ HsCmdIf cf ep pt pe checkCmd _ (HsLet lb e) = checkCommand e >>= (\c -> return $ HsCmdLet lb c) -checkCmd _ (HsDo DoExpr stmts ty) = - mapM checkCmdLStmt stmts >>= (\ss -> return $ HsCmdDo ss ty) +checkCmd _ (HsDo DoExpr (L l stmts) ty) = + mapM checkCmdLStmt stmts >>= (\ss -> return $ HsCmdDo (L l ss) ty) checkCmd _ (OpApp eLeft op _fixity eRight) = do -- OpApp becomes a HsCmdArrForm with a (Just fixity) in it @@ -1145,9 +1147,9 @@ checkCmdStmt _ stmt@(RecStmt { recS_stmts = stmts }) = do checkCmdStmt l stmt = cmdStmtFail l stmt checkCmdMatchGroup :: MatchGroup RdrName (LHsExpr RdrName) -> P (MatchGroup RdrName (LHsCmd RdrName)) -checkCmdMatchGroup mg@(MG { mg_alts = ms }) = do +checkCmdMatchGroup mg@(MG { mg_alts = L l ms }) = do ms' <- mapM (locMap $ const convert) ms - return $ mg { mg_alts = ms' } + return $ mg { mg_alts = L l ms' } where convert (Match mf pat mty grhss) = do grhss' <- checkCmdGRHSs grhss return $ Match mf pat mty grhss' |