Commit f39ca298 authored by gmainlan@microsoft.com's avatar gmainlan@microsoft.com
Browse files

Untabify

parent f05cbb11
...@@ -10,45 +10,38 @@ general, all of these functions return a renamed thing, and a set of ...@@ -10,45 +10,38 @@ general, all of these functions return a renamed thing, and a set of
free variables. free variables.
\begin{code} \begin{code}
{-# OPTIONS -fno-warn-tabs #-}
-- The above warning supression flag is a temporary kludge.
-- While working on this module you are encouraged to remove it and
-- detab the module (please do the detabbing in a separate patch). See
-- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#TabsvsSpaces
-- for details
module RnExpr ( module RnExpr (
rnLExpr, rnExpr, rnStmts rnLExpr, rnExpr, rnStmts
) where ) where
#include "HsVersions.h" #include "HsVersions.h"
#ifdef GHCI #ifdef GHCI
import {-# SOURCE #-} TcSplice( runQuasiQuoteExpr ) import {-# SOURCE #-} TcSplice( runQuasiQuoteExpr )
#endif /* GHCI */ #endif /* GHCI */
import RnSource ( rnSrcDecls, findSplice ) import RnSource ( rnSrcDecls, findSplice )
import RnBinds ( rnLocalBindsAndThen, rnLocalValBindsLHS, rnLocalValBindsRHS, import RnBinds ( rnLocalBindsAndThen, rnLocalValBindsLHS, rnLocalValBindsRHS,
rnMatchGroup, rnGRHS, makeMiniFixityEnv) rnMatchGroup, rnGRHS, makeMiniFixityEnv)
import HsSyn import HsSyn
import TcRnMonad import TcRnMonad
import TcEnv ( thRnBrack ) import TcEnv ( thRnBrack )
import RnEnv import RnEnv
import RnTypes import RnTypes
import RnPat import RnPat
import DynFlags import DynFlags
import BasicTypes ( FixityDirection(..) ) import BasicTypes ( FixityDirection(..) )
import PrelNames import PrelNames
import Module import Module
import Name import Name
import NameSet import NameSet
import RdrName import RdrName
import LoadIface ( loadInterfaceForName ) import LoadIface ( loadInterfaceForName )
import UniqSet import UniqSet
import Data.List import Data.List
import Util import Util
import ListSetOps ( removeDups ) import ListSetOps ( removeDups )
import Outputable import Outputable
import SrcLoc import SrcLoc
import FastString import FastString
...@@ -67,9 +60,9 @@ thenM_ = (>>) ...@@ -67,9 +60,9 @@ thenM_ = (>>)
\end{code} \end{code}
%************************************************************************ %************************************************************************
%* * %* *
\subsubsection{Expressions} \subsubsection{Expressions}
%* * %* *
%************************************************************************ %************************************************************************
\begin{code} \begin{code}
...@@ -78,18 +71,18 @@ rnExprs ls = rnExprs' ls emptyUniqSet ...@@ -78,18 +71,18 @@ rnExprs ls = rnExprs' ls emptyUniqSet
where where
rnExprs' [] acc = return ([], acc) rnExprs' [] acc = return ([], acc)
rnExprs' (expr:exprs) acc rnExprs' (expr:exprs) acc
= rnLExpr expr `thenM` \ (expr', fvExpr) -> = rnLExpr expr `thenM` \ (expr', fvExpr) ->
-- Now we do a "seq" on the free vars because typically it's small -- Now we do a "seq" on the free vars because typically it's small
-- or empty, especially in very long lists of constants -- or empty, especially in very long lists of constants
let let
acc' = acc `plusFV` fvExpr acc' = acc `plusFV` fvExpr
in in
acc' `seq` rnExprs' exprs acc' `thenM` \ (exprs', fvExprs) -> acc' `seq` rnExprs' exprs acc' `thenM` \ (exprs', fvExprs) ->
return (expr':exprs', fvExprs) return (expr':exprs', fvExprs)
\end{code} \end{code}
Variables. We look up the variable and return the resulting name. Variables. We look up the variable and return the resulting name.
\begin{code} \begin{code}
rnLExpr :: LHsExpr RdrName -> RnM (LHsExpr Name, FreeVars) rnLExpr :: LHsExpr RdrName -> RnM (LHsExpr Name, FreeVars)
...@@ -101,12 +94,12 @@ finishHsVar :: Name -> RnM (HsExpr Name, FreeVars) ...@@ -101,12 +94,12 @@ finishHsVar :: Name -> RnM (HsExpr Name, FreeVars)
-- Separated from rnExpr because it's also used -- Separated from rnExpr because it's also used
-- when renaming infix expressions -- when renaming infix expressions
-- See Note [Adding the implicit parameter to 'assert'] -- See Note [Adding the implicit parameter to 'assert']
finishHsVar name finishHsVar name
= do { ignore_asserts <- goptM Opt_IgnoreAsserts = do { ignore_asserts <- goptM Opt_IgnoreAsserts
; if ignore_asserts || not (name `hasKey` assertIdKey) ; if ignore_asserts || not (name `hasKey` assertIdKey)
then return (HsVar name, unitFV name) then return (HsVar name, unitFV name)
else do { e <- mkAssertErrorExpr else do { e <- mkAssertErrorExpr
; return (e, unitFV name) } } ; return (e, unitFV name) } }
rnExpr (HsVar v) rnExpr (HsVar v)
= do { mb_name <- lookupOccRn_maybe v = do { mb_name <- lookupOccRn_maybe v
...@@ -115,11 +108,11 @@ rnExpr (HsVar v) ...@@ -115,11 +108,11 @@ rnExpr (HsVar v)
; if opt_TypeHoles && startsWithUnderscore (rdrNameOcc v) ; if opt_TypeHoles && startsWithUnderscore (rdrNameOcc v)
then return (HsUnboundVar v, emptyFVs) then return (HsUnboundVar v, emptyFVs)
else do { n <- reportUnboundName v; finishHsVar n } } ; else do { n <- reportUnboundName v; finishHsVar n } } ;
Just name Just name
| name == nilDataConName -- Treat [] as an ExplicitList, so that | name == nilDataConName -- Treat [] as an ExplicitList, so that
-- OverloadedLists works correctly -- OverloadedLists works correctly
-> rnExpr (ExplicitList placeHolderType Nothing []) -> rnExpr (ExplicitList placeHolderType Nothing [])
| otherwise | otherwise
-> finishHsVar name } } -> finishHsVar name } }
rnExpr (HsIPVar v) rnExpr (HsIPVar v)
...@@ -130,48 +123,48 @@ rnExpr (HsLit lit@(HsString s)) ...@@ -130,48 +123,48 @@ rnExpr (HsLit lit@(HsString s))
opt_OverloadedStrings <- xoptM Opt_OverloadedStrings opt_OverloadedStrings <- xoptM Opt_OverloadedStrings
; if opt_OverloadedStrings then ; if opt_OverloadedStrings then
rnExpr (HsOverLit (mkHsIsString s placeHolderType)) rnExpr (HsOverLit (mkHsIsString s placeHolderType))
else -- Same as below else -- Same as below
rnLit lit `thenM_` rnLit lit `thenM_`
return (HsLit lit, emptyFVs) return (HsLit lit, emptyFVs)
} }
rnExpr (HsLit lit) rnExpr (HsLit lit)
= rnLit lit `thenM_` = rnLit lit `thenM_`
return (HsLit lit, emptyFVs) return (HsLit lit, emptyFVs)
rnExpr (HsOverLit lit) rnExpr (HsOverLit lit)
= rnOverLit lit `thenM` \ (lit', fvs) -> = rnOverLit lit `thenM` \ (lit', fvs) ->
return (HsOverLit lit', fvs) return (HsOverLit lit', fvs)
rnExpr (HsApp fun arg) rnExpr (HsApp fun arg)
= rnLExpr fun `thenM` \ (fun',fvFun) -> = rnLExpr fun `thenM` \ (fun',fvFun) ->
rnLExpr arg `thenM` \ (arg',fvArg) -> rnLExpr arg `thenM` \ (arg',fvArg) ->
return (HsApp fun' arg', fvFun `plusFV` fvArg) return (HsApp fun' arg', fvFun `plusFV` fvArg)
rnExpr (OpApp e1 (L op_loc (HsVar op_rdr)) _ e2) rnExpr (OpApp e1 (L op_loc (HsVar op_rdr)) _ e2)
= do { (e1', fv_e1) <- rnLExpr e1 = do { (e1', fv_e1) <- rnLExpr e1
; (e2', fv_e2) <- rnLExpr e2 ; (e2', fv_e2) <- rnLExpr e2
; op_name <- setSrcSpan op_loc (lookupOccRn op_rdr) ; op_name <- setSrcSpan op_loc (lookupOccRn op_rdr)
; (op', fv_op) <- finishHsVar op_name ; (op', fv_op) <- finishHsVar op_name
-- NB: op' is usually just a variable, but might be -- NB: op' is usually just a variable, but might be
-- an applicatoin (assert "Foo.hs:47") -- an applicatoin (assert "Foo.hs:47")
-- Deal with fixity -- Deal with fixity
-- When renaming code synthesised from "deriving" declarations -- When renaming code synthesised from "deriving" declarations
-- we used to avoid fixity stuff, but we can't easily tell any -- we used to avoid fixity stuff, but we can't easily tell any
-- more, so I've removed the test. Adding HsPars in TcGenDeriv -- more, so I've removed the test. Adding HsPars in TcGenDeriv
-- should prevent bad things happening. -- should prevent bad things happening.
; fixity <- lookupFixityRn op_name ; fixity <- lookupFixityRn op_name
; final_e <- mkOpAppRn e1' (L op_loc op') fixity e2' ; final_e <- mkOpAppRn e1' (L op_loc op') fixity e2'
; return (final_e, fv_e1 `plusFV` fv_op `plusFV` fv_e2) } ; return (final_e, fv_e1 `plusFV` fv_op `plusFV` fv_e2) }
rnExpr (OpApp _ other_op _ _) rnExpr (OpApp _ other_op _ _)
= failWith (vcat [ hang (ptext (sLit "Infix application with a non-variable operator:")) = failWith (vcat [ hang (ptext (sLit "Infix application with a non-variable operator:"))
2 (ppr other_op) 2 (ppr other_op)
, ptext (sLit "(Probably resulting from a Template Haskell splice)") ]) , ptext (sLit "(Probably resulting from a Template Haskell splice)") ])
rnExpr (NegApp e _) rnExpr (NegApp e _)
= rnLExpr e `thenM` \ (e', fv_e) -> = rnLExpr e `thenM` \ (e', fv_e) ->
lookupSyntaxName negateName `thenM` \ (neg_name, fv_neg) -> lookupSyntaxName negateName `thenM` \ (neg_name, fv_neg) ->
mkNegAppRn e' neg_name `thenM` \ final_e -> mkNegAppRn e' neg_name `thenM` \ final_e ->
return (final_e, fv_e `plusFV` fv_neg) return (final_e, fv_e `plusFV` fv_neg)
------------------------------------------ ------------------------------------------
...@@ -189,36 +182,36 @@ rnExpr e@(HsBracket br_body) ...@@ -189,36 +182,36 @@ rnExpr e@(HsBracket br_body)
return (HsBracket body', fvs_e) return (HsBracket body', fvs_e)
rnExpr (HsSpliceE splice) rnExpr (HsSpliceE splice)
= rnSplice splice `thenM` \ (splice', fvs) -> = rnSplice splice `thenM` \ (splice', fvs) ->
return (HsSpliceE splice', fvs) return (HsSpliceE splice', fvs)
#ifndef GHCI #ifndef GHCI
rnExpr e@(HsQuasiQuoteE _) = pprPanic "Cant do quasiquotation without GHCi" (ppr e) rnExpr e@(HsQuasiQuoteE _) = pprPanic "Cant do quasiquotation without GHCi" (ppr e)
#else #else
rnExpr (HsQuasiQuoteE qq) rnExpr (HsQuasiQuoteE qq)
= runQuasiQuoteExpr qq `thenM` \ (L _ expr') -> = runQuasiQuoteExpr qq `thenM` \ (L _ expr') ->
rnExpr expr' rnExpr expr'
#endif /* GHCI */ #endif /* GHCI */
--------------------------------------------- ---------------------------------------------
-- Sections -- Sections
-- See Note [Parsing sections] in Parser.y.pp -- See Note [Parsing sections] in Parser.y.pp
rnExpr (HsPar (L loc (section@(SectionL {})))) rnExpr (HsPar (L loc (section@(SectionL {}))))
= do { (section', fvs) <- rnSection section = do { (section', fvs) <- rnSection section
; return (HsPar (L loc section'), fvs) } ; return (HsPar (L loc section'), fvs) }
rnExpr (HsPar (L loc (section@(SectionR {})))) rnExpr (HsPar (L loc (section@(SectionR {}))))
= do { (section', fvs) <- rnSection section = do { (section', fvs) <- rnSection section
; return (HsPar (L loc section'), fvs) } ; return (HsPar (L loc section'), fvs) }
rnExpr (HsPar e) rnExpr (HsPar e)
= do { (e', fvs_e) <- rnLExpr e = do { (e', fvs_e) <- rnLExpr e
; return (HsPar e', fvs_e) } ; return (HsPar e', fvs_e) }
rnExpr expr@(SectionL {}) rnExpr expr@(SectionL {})
= do { addErr (sectionErr expr); rnSection expr } = do { addErr (sectionErr expr); rnSection expr }
rnExpr expr@(SectionR {}) rnExpr expr@(SectionR {})
= do { addErr (sectionErr expr); rnSection expr } = do { addErr (sectionErr expr); rnSection expr }
--------------------------------------------- ---------------------------------------------
rnExpr (HsCoreAnn ann expr) rnExpr (HsCoreAnn ann expr)
...@@ -226,10 +219,10 @@ rnExpr (HsCoreAnn ann expr) ...@@ -226,10 +219,10 @@ rnExpr (HsCoreAnn ann expr)
return (HsCoreAnn ann expr', fvs_expr) return (HsCoreAnn ann expr', fvs_expr)
rnExpr (HsSCC lbl expr) rnExpr (HsSCC lbl expr)
= rnLExpr expr `thenM` \ (expr', fvs_expr) -> = rnLExpr expr `thenM` \ (expr', fvs_expr) ->
return (HsSCC lbl expr', fvs_expr) return (HsSCC lbl expr', fvs_expr)
rnExpr (HsTickPragma info expr) rnExpr (HsTickPragma info expr)
= rnLExpr expr `thenM` \ (expr', fvs_expr) -> = rnLExpr expr `thenM` \ (expr', fvs_expr) ->
return (HsTickPragma info expr', fvs_expr) return (HsTickPragma info expr', fvs_expr)
rnExpr (HsLam matches) rnExpr (HsLam matches)
...@@ -237,7 +230,7 @@ rnExpr (HsLam matches) ...@@ -237,7 +230,7 @@ rnExpr (HsLam matches)
return (HsLam matches', fvMatch) return (HsLam matches', fvMatch)
rnExpr (HsLamCase arg matches) rnExpr (HsLamCase arg matches)
= rnMatchGroup CaseAlt rnLExpr matches `thenM` \ (matches', fvs_ms) -> = rnMatchGroup CaseAlt rnLExpr matches `thenM` \ (matches', fvs_ms) ->
return (HsLamCase arg matches', fvs_ms) return (HsLamCase arg matches', fvs_ms)
rnExpr (HsCase expr matches) rnExpr (HsCase expr matches)
...@@ -246,26 +239,26 @@ rnExpr (HsCase expr matches) ...@@ -246,26 +239,26 @@ rnExpr (HsCase expr matches)
return (HsCase new_expr new_matches, e_fvs `plusFV` ms_fvs) return (HsCase new_expr new_matches, e_fvs `plusFV` ms_fvs)
rnExpr (HsLet binds expr) rnExpr (HsLet binds expr)
= rnLocalBindsAndThen binds $ \ binds' -> = rnLocalBindsAndThen binds $ \ binds' ->
rnLExpr expr `thenM` \ (expr',fvExpr) -> rnLExpr expr `thenM` \ (expr',fvExpr) ->
return (HsLet binds' expr', fvExpr) return (HsLet binds' expr', fvExpr)
rnExpr (HsDo do_or_lc stmts _) rnExpr (HsDo do_or_lc stmts _)
= do { ((stmts', _), fvs) <- rnStmts do_or_lc rnLExpr stmts (\ _ -> return ((), emptyFVs)) = do { ((stmts', _), fvs) <- rnStmts do_or_lc rnLExpr stmts (\ _ -> return ((), emptyFVs))
; return ( HsDo do_or_lc stmts' placeHolderType, fvs ) } ; return ( HsDo do_or_lc stmts' placeHolderType, fvs ) }
rnExpr (ExplicitList _ _ exps) rnExpr (ExplicitList _ _ exps)
= do { opt_OverloadedLists <- xoptM Opt_OverloadedLists = do { opt_OverloadedLists <- xoptM Opt_OverloadedLists
; (exps', fvs) <- rnExprs exps ; (exps', fvs) <- rnExprs exps
; if opt_OverloadedLists ; if opt_OverloadedLists
then do { then do {
; (from_list_n_name, fvs') <- lookupSyntaxName fromListNName ; (from_list_n_name, fvs') <- lookupSyntaxName fromListNName
; return (ExplicitList placeHolderType (Just from_list_n_name) exps', fvs `plusFV` fvs') } ; return (ExplicitList placeHolderType (Just from_list_n_name) exps', fvs `plusFV` fvs') }
else else
return (ExplicitList placeHolderType Nothing exps', fvs) } return (ExplicitList placeHolderType Nothing exps', fvs) }
rnExpr (ExplicitPArr _ exps) rnExpr (ExplicitPArr _ exps)
= rnExprs exps `thenM` \ (exps', fvs) -> = rnExprs exps `thenM` \ (exps', fvs) ->
return (ExplicitPArr placeHolderType exps', fvs) return (ExplicitPArr placeHolderType exps', fvs)
rnExpr (ExplicitTuple tup_args boxity) rnExpr (ExplicitTuple tup_args boxity)
...@@ -278,22 +271,22 @@ rnExpr (ExplicitTuple tup_args boxity) ...@@ -278,22 +271,22 @@ rnExpr (ExplicitTuple tup_args boxity)
rnTupArg (Missing _) = return (Missing placeHolderType, emptyFVs) rnTupArg (Missing _) = return (Missing placeHolderType, emptyFVs)
rnExpr (RecordCon con_id _ rbinds) rnExpr (RecordCon con_id _ rbinds)
= do { conname <- lookupLocatedOccRn con_id = do { conname <- lookupLocatedOccRn con_id
; (rbinds', fvRbinds) <- rnHsRecBinds (HsRecFieldCon (unLoc conname)) rbinds ; (rbinds', fvRbinds) <- rnHsRecBinds (HsRecFieldCon (unLoc conname)) rbinds
; return (RecordCon conname noPostTcExpr rbinds', ; return (RecordCon conname noPostTcExpr rbinds',
fvRbinds `addOneFV` unLoc conname) } fvRbinds `addOneFV` unLoc conname) }
rnExpr (RecordUpd expr rbinds _ _ _) rnExpr (RecordUpd expr rbinds _ _ _)
= do { (expr', fvExpr) <- rnLExpr expr = do { (expr', fvExpr) <- rnLExpr expr
; (rbinds', fvRbinds) <- rnHsRecBinds HsRecFieldUpd rbinds ; (rbinds', fvRbinds) <- rnHsRecBinds HsRecFieldUpd rbinds
; return (RecordUpd expr' rbinds' [] [] [], ; return (RecordUpd expr' rbinds' [] [] [],
fvExpr `plusFV` fvRbinds) } fvExpr `plusFV` fvRbinds) }
rnExpr (ExprWithTySig expr pty) rnExpr (ExprWithTySig expr pty)
= do { (pty', fvTy) <- rnLHsType ExprWithTySigCtx pty = do { (pty', fvTy) <- rnLHsType ExprWithTySigCtx pty
; (expr', fvExpr) <- bindSigTyVarsFV (hsExplicitTvs pty') $ ; (expr', fvExpr) <- bindSigTyVarsFV (hsExplicitTvs pty') $
rnLExpr expr rnLExpr expr
; return (ExprWithTySig expr' pty', fvExpr `plusFV` fvTy) } ; return (ExprWithTySig expr' pty', fvExpr `plusFV` fvTy) }
rnExpr (HsIf _ p b1 b2) rnExpr (HsIf _ p b1 b2)
= do { (p', fvP) <- rnLExpr p = do { (p', fvP) <- rnLExpr p
...@@ -307,21 +300,21 @@ rnExpr (HsMultiIf ty alts) ...@@ -307,21 +300,21 @@ rnExpr (HsMultiIf ty alts)
; return (HsMultiIf ty alts', fvs) } ; return (HsMultiIf ty alts', fvs) }
rnExpr (HsType a) rnExpr (HsType a)
= rnLHsType HsTypeCtx a `thenM` \ (t, fvT) -> = rnLHsType HsTypeCtx a `thenM` \ (t, fvT) ->
return (HsType t, fvT) return (HsType t, fvT)
rnExpr (ArithSeq _ _ seq) rnExpr (ArithSeq _ _ seq)
= do { opt_OverloadedLists <- xoptM Opt_OverloadedLists = do { opt_OverloadedLists <- xoptM Opt_OverloadedLists
; (new_seq, fvs) <- rnArithSeq seq ; (new_seq, fvs) <- rnArithSeq seq
; if opt_OverloadedLists ; if opt_OverloadedLists
then do { then do {
; (from_list_name, fvs') <- lookupSyntaxName fromListName ; (from_list_name, fvs') <- lookupSyntaxName fromListName
; return (ArithSeq noPostTcExpr (Just from_list_name) new_seq, fvs `plusFV` fvs') } ; return (ArithSeq noPostTcExpr (Just from_list_name) new_seq, fvs `plusFV` fvs') }
else else
return (ArithSeq noPostTcExpr Nothing new_seq, fvs) } return (ArithSeq noPostTcExpr Nothing new_seq, fvs) }
rnExpr (PArrSeq _ seq) rnExpr (PArrSeq _ seq)
= rnArithSeq seq `thenM` \ (new_seq, fvs) -> = rnArithSeq seq `thenM` \ (new_seq, fvs) ->
return (PArrSeq noPostTcExpr new_seq, fvs) return (PArrSeq noPostTcExpr new_seq, fvs)
\end{code} \end{code}
...@@ -341,16 +334,16 @@ rnExpr e@(ELazyPat {}) = patSynErr e ...@@ -341,16 +334,16 @@ rnExpr e@(ELazyPat {}) = patSynErr e
\end{code} \end{code}
%************************************************************************ %************************************************************************
%* * %* *
Arrow notation Arrow notation
%* * %* *
%************************************************************************ %************************************************************************
\begin{code} \begin{code}
rnExpr (HsProc pat body) rnExpr (HsProc pat body)
= newArrowScope $ = newArrowScope $
rnPat ProcExpr pat $ \ pat' -> rnPat ProcExpr pat $ \ pat' ->
rnCmdTop body `thenM` \ (body',fvBody) -> rnCmdTop body `thenM` \ (body',fvBody) ->
return (HsProc pat' body', fvBody) return (HsProc pat' body', fvBody)
-- Ideally, these would be done in parsing, but to keep parsing simple, we do it here. -- Ideally, these would be done in parsing, but to keep parsing simple, we do it here.
...@@ -358,7 +351,7 @@ rnExpr e@(HsArrApp {}) = arrowFail e ...@@ -358,7 +351,7 @@ rnExpr e@(HsArrApp {}) = arrowFail e
rnExpr e@(HsArrForm {}) = arrowFail e rnExpr e@(HsArrForm {}) = arrowFail e
rnExpr other = pprPanic "rnExpr: unexpected expression" (ppr other) rnExpr other = pprPanic "rnExpr: unexpected expression" (ppr other)
-- HsWrap -- HsWrap
hsHoleExpr :: HsExpr Name hsHoleExpr :: HsExpr Name
hsHoleExpr = HsUnboundVar (mkRdrUnqual (mkVarOcc "_")) hsHoleExpr = HsUnboundVar (mkRdrUnqual (mkVarOcc "_"))
...@@ -375,24 +368,24 @@ arrowFail e ...@@ -375,24 +368,24 @@ arrowFail e
-- See Note [Parsing sections] in Parser.y.pp -- See Note [Parsing sections] in Parser.y.pp
rnSection :: HsExpr RdrName -> RnM (HsExpr Name, FreeVars) rnSection :: HsExpr RdrName -> RnM (HsExpr Name, FreeVars)
rnSection section@(SectionR op expr) rnSection section@(SectionR op expr)
= do { (op', fvs_op) <- rnLExpr op = do { (op', fvs_op) <- rnLExpr op
; (expr', fvs_expr) <- rnLExpr expr ; (expr', fvs_expr) <- rnLExpr expr
; checkSectionPrec InfixR section op' expr' ; checkSectionPrec InfixR section op' expr'
; return (SectionR op' expr', fvs_op `plusFV` fvs_expr) } ; return (SectionR op' expr', fvs_op `plusFV` fvs_expr) }
rnSection section@(SectionL expr op) rnSection section@(SectionL expr op)
= do { (expr', fvs_expr) <- rnLExpr expr = do { (expr', fvs_expr) <- rnLExpr expr
; (op', fvs_op) <- rnLExpr op ; (op', fvs_op) <- rnLExpr op
; checkSectionPrec InfixL section op' expr' ; checkSectionPrec InfixL section op' expr'
; return (SectionL expr' op', fvs_op `plusFV` fvs_expr) } ; return (SectionL expr' op', fvs_op `plusFV` fvs_expr) }
rnSection other = pprPanic "rnSection" (ppr other) rnSection other = pprPanic "rnSection" (ppr other)
\end{code} \end{code}
%************************************************************************ %************************************************************************
%* * %* *
Records Records
%* * %* *
%************************************************************************ %************************************************************************
\begin{code} \begin{code}
...@@ -401,40 +394,40 @@ rnHsRecBinds :: HsRecFieldContext -> HsRecordBinds RdrName ...@@ -401,40 +394,40 @@ rnHsRecBinds :: HsRecFieldContext -> HsRecordBinds RdrName
rnHsRecBinds ctxt rec_binds@(HsRecFields { rec_dotdot = dd }) rnHsRecBinds ctxt rec_binds@(HsRecFields { rec_dotdot = dd })
= do { (flds, fvs) <- rnHsRecFields1 ctxt HsVar rec_binds = do { (flds, fvs) <- rnHsRecFields1 ctxt HsVar rec_binds
; (flds', fvss) <- mapAndUnzipM rn_field flds ; (flds', fvss) <- mapAndUnzipM rn_field flds
; return (HsRecFields { rec_flds = flds', rec_dotdot = dd }, ; return (HsRecFields { rec_flds = flds', rec_dotdot = dd },
fvs `plusFV` plusFVs fvss) } fvs `plusFV` plusFVs fvss) }
where where
rn_field fld = do { (arg', fvs) <- rnLExpr (hsRecFieldArg fld) rn_field fld = do { (arg', fvs) <- rnLExpr (hsRecFieldArg fld)
; return (fld { hsRecFieldArg = arg' }, fvs) } ; return (fld { hsRecFieldArg = arg' }, fvs) }
\end{code} \end{code}
%************************************************************************ %************************************************************************
%* * %* *
Arrow commands Arrow commands
%* * %* *
%************************************************************************ %************************************************************************
\begin{code} \begin{code}
rnCmdArgs :: [LHsCmdTop RdrName] -> RnM ([LHsCmdTop Name], FreeVars) rnCmdArgs :: [LHsCmdTop RdrName] -> RnM ([LHsCmdTop Name], FreeVars)
rnCmdArgs [] = return ([], emptyFVs) rnCmdArgs [] = return ([], emptyFVs)
rnCmdArgs (arg:args) rnCmdArgs (arg:args)
= rnCmdTop arg `thenM` \ (arg',fvArg) -> = rnCmdTop arg `thenM` \ (arg',fvArg) ->
rnCmdArgs args `thenM` \ (args',fvArgs) -> rnCmdArgs args `thenM` \ (args',fvArgs) ->
return (arg':args', fvArg `plusFV` fvArgs) return (arg':args', fvArg `plusFV` fvArgs)
rnCmdTop :: LHsCmdTop RdrName -> RnM (LHsCmdTop Name, FreeVars) rnCmdTop :: LHsCmdTop RdrName -> RnM (LHsCmdTop Name, FreeVars)
rnCmdTop = wrapLocFstM rnCmdTop' rnCmdTop = wrapLocFstM rnCmdTop'
where where
rnCmdTop' (HsCmdTop cmd _ _ _) rnCmdTop' (HsCmdTop cmd _ _ _)
= do { (cmd', fvCmd) <- rnLCmd cmd = do { (cmd', fvCmd) <- rnLCmd cmd
; let cmd_names = [arrAName, composeAName, firstAName] ++ ; let cmd_names = [arrAName, composeAName, firstAName] ++
nameSetToList (methodNamesCmd (unLoc cmd')) nameSetToList (methodNamesCmd (unLoc cmd'))
-- Generate the rebindable syntax for the monad -- Generate the rebindable syntax for the monad
; (cmd_names', cmd_fvs) <- lookupSyntaxNames cmd_names ; (cmd_names', cmd_fvs) <- lookupSyntaxNames cmd_names
; return (HsCmdTop cmd' placeHolderType placeHolderType (cmd_names `zip` cmd_names'), ; return (HsCmdTop cmd' placeHolderType placeHolderType (cmd_names `zip` cmd_names'),
fvCmd `plusFV` cmd_fvs) } fvCmd `plusFV` cmd_fvs) }
rnLCmd :: LHsCmd RdrName -> RnM (LHsCmd Name, FreeVars) rnLCmd :: LHsCmd RdrName -> RnM (LHsCmd Name, FreeVars)
rnLCmd = wrapLocFstM rnCmd rnLCmd = wrapLocFstM rnCmd
...@@ -451,10 +444,10 @@ rnCmd (HsCmdArrApp arrow arg _ ho rtl) ...@@ -451,10 +444,10 @@ rnCmd (HsCmdArrApp arrow arg _ ho rtl)
HsHigherOrderApp -> tc HsHigherOrderApp -> tc
HsFirstOrderApp -> escapeArrowScope tc HsFirstOrderApp -> escapeArrowScope tc
-- See Note [Escaping the arrow scope] in TcRnTypes -- See Note [Escaping the arrow scope] in TcRnTypes
-- Before renaming 'arrow', use the environment of the enclosing -- Before renaming 'arrow', use the environment of the enclosing
-- proc for the (-<) case. -- proc for the (-<) case.
-- Local bindings, inside the enclosing proc, are not in scope