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
free variables.
\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 (
rnLExpr, rnExpr, rnStmts
rnLExpr, rnExpr, rnStmts
) where
#include "HsVersions.h"
#ifdef GHCI
import {-# SOURCE #-} TcSplice( runQuasiQuoteExpr )
#endif /* GHCI */
#endif /* GHCI */
import RnSource ( rnSrcDecls, findSplice )
import RnBinds ( rnLocalBindsAndThen, rnLocalValBindsLHS, rnLocalValBindsRHS,
rnMatchGroup, rnGRHS, makeMiniFixityEnv)
rnMatchGroup, rnGRHS, makeMiniFixityEnv)
import HsSyn
import TcRnMonad
import TcEnv ( thRnBrack )
import TcEnv ( thRnBrack )
import RnEnv
import RnTypes
import RnPat
import DynFlags
import BasicTypes ( FixityDirection(..) )
import BasicTypes ( FixityDirection(..) )
import PrelNames
import Module
import Name
import NameSet
import RdrName
import LoadIface ( loadInterfaceForName )
import LoadIface ( loadInterfaceForName )
import UniqSet
import Data.List
import Util
import ListSetOps ( removeDups )
import ListSetOps ( removeDups )
import Outputable
import SrcLoc
import FastString
......@@ -67,9 +60,9 @@ thenM_ = (>>)
\end{code}
%************************************************************************
%* *
%* *
\subsubsection{Expressions}
%* *
%* *
%************************************************************************
\begin{code}
......@@ -78,18 +71,18 @@ rnExprs ls = rnExprs' ls emptyUniqSet
where
rnExprs' [] acc = return ([], 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
-- or empty, especially in very long lists of constants
-- Now we do a "seq" on the free vars because typically it's small
-- or empty, especially in very long lists of constants
let
acc' = acc `plusFV` fvExpr
acc' = acc `plusFV` fvExpr
in
acc' `seq` rnExprs' exprs acc' `thenM` \ (exprs', fvExprs) ->
return (expr':exprs', fvExprs)
\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}
rnLExpr :: LHsExpr RdrName -> RnM (LHsExpr Name, FreeVars)
......@@ -101,12 +94,12 @@ finishHsVar :: Name -> RnM (HsExpr Name, FreeVars)
-- Separated from rnExpr because it's also used
-- when renaming infix expressions
-- See Note [Adding the implicit parameter to 'assert']
finishHsVar name
finishHsVar name
= do { ignore_asserts <- goptM Opt_IgnoreAsserts
; if ignore_asserts || not (name `hasKey` assertIdKey)
then return (HsVar name, unitFV name)
else do { e <- mkAssertErrorExpr
; return (e, unitFV name) } }
then return (HsVar name, unitFV name)
else do { e <- mkAssertErrorExpr
; return (e, unitFV name) } }
rnExpr (HsVar v)
= do { mb_name <- lookupOccRn_maybe v
......@@ -115,11 +108,11 @@ rnExpr (HsVar v)
; if opt_TypeHoles && startsWithUnderscore (rdrNameOcc v)
then return (HsUnboundVar v, emptyFVs)
else do { n <- reportUnboundName v; finishHsVar n } } ;
Just name
Just name
| name == nilDataConName -- Treat [] as an ExplicitList, so that
-- OverloadedLists works correctly
-> rnExpr (ExplicitList placeHolderType Nothing [])
| otherwise
| otherwise
-> finishHsVar name } }
rnExpr (HsIPVar v)
......@@ -130,48 +123,48 @@ rnExpr (HsLit lit@(HsString s))
opt_OverloadedStrings <- xoptM Opt_OverloadedStrings
; if opt_OverloadedStrings then
rnExpr (HsOverLit (mkHsIsString s placeHolderType))
else -- Same as below
rnLit lit `thenM_`
else -- Same as below
rnLit lit `thenM_`
return (HsLit lit, emptyFVs)
}
rnExpr (HsLit lit)
= rnLit lit `thenM_`
rnExpr (HsLit lit)
= rnLit lit `thenM_`
return (HsLit lit, emptyFVs)
rnExpr (HsOverLit lit)
= rnOverLit lit `thenM` \ (lit', fvs) ->
rnExpr (HsOverLit lit)
= rnOverLit lit `thenM` \ (lit', fvs) ->
return (HsOverLit lit', fvs)
rnExpr (HsApp fun arg)
= rnLExpr fun `thenM` \ (fun',fvFun) ->
rnLExpr arg `thenM` \ (arg',fvArg) ->
= rnLExpr fun `thenM` \ (fun',fvFun) ->
rnLExpr arg `thenM` \ (arg',fvArg) ->
return (HsApp fun' arg', fvFun `plusFV` fvArg)
rnExpr (OpApp e1 (L op_loc (HsVar op_rdr)) _ e2)
= do { (e1', fv_e1) <- rnLExpr e1
; (e2', fv_e2) <- rnLExpr e2
; op_name <- setSrcSpan op_loc (lookupOccRn op_rdr)
; (op', fv_op) <- finishHsVar op_name
-- NB: op' is usually just a variable, but might be
-- an applicatoin (assert "Foo.hs:47")
-- Deal with fixity
-- When renaming code synthesised from "deriving" declarations
-- we used to avoid fixity stuff, but we can't easily tell any
-- more, so I've removed the test. Adding HsPars in TcGenDeriv
-- should prevent bad things happening.
; fixity <- lookupFixityRn op_name
; final_e <- mkOpAppRn e1' (L op_loc op') fixity e2'
; return (final_e, fv_e1 `plusFV` fv_op `plusFV` fv_e2) }
; (e2', fv_e2) <- rnLExpr e2
; op_name <- setSrcSpan op_loc (lookupOccRn op_rdr)
; (op', fv_op) <- finishHsVar op_name
-- NB: op' is usually just a variable, but might be
-- an applicatoin (assert "Foo.hs:47")
-- Deal with fixity
-- When renaming code synthesised from "deriving" declarations
-- we used to avoid fixity stuff, but we can't easily tell any
-- more, so I've removed the test. Adding HsPars in TcGenDeriv
-- should prevent bad things happening.
; fixity <- lookupFixityRn op_name
; final_e <- mkOpAppRn e1' (L op_loc op') fixity e2'
; return (final_e, fv_e1 `plusFV` fv_op `plusFV` fv_e2) }
rnExpr (OpApp _ other_op _ _)
= failWith (vcat [ hang (ptext (sLit "Infix application with a non-variable operator:"))
2 (ppr other_op)
, ptext (sLit "(Probably resulting from a Template Haskell splice)") ])
rnExpr (NegApp e _)
= rnLExpr e `thenM` \ (e', fv_e) ->
lookupSyntaxName negateName `thenM` \ (neg_name, fv_neg) ->
mkNegAppRn e' neg_name `thenM` \ final_e ->
= rnLExpr e `thenM` \ (e', fv_e) ->
lookupSyntaxName negateName `thenM` \ (neg_name, fv_neg) ->
mkNegAppRn e' neg_name `thenM` \ final_e ->
return (final_e, fv_e `plusFV` fv_neg)
------------------------------------------
......@@ -189,36 +182,36 @@ rnExpr e@(HsBracket br_body)
return (HsBracket body', fvs_e)
rnExpr (HsSpliceE splice)
= rnSplice splice `thenM` \ (splice', fvs) ->
= rnSplice splice `thenM` \ (splice', fvs) ->
return (HsSpliceE splice', fvs)
#ifndef GHCI
rnExpr e@(HsQuasiQuoteE _) = pprPanic "Cant do quasiquotation without GHCi" (ppr e)
#else
rnExpr (HsQuasiQuoteE qq)
= runQuasiQuoteExpr qq `thenM` \ (L _ expr') ->
= runQuasiQuoteExpr qq `thenM` \ (L _ expr') ->
rnExpr expr'
#endif /* GHCI */
#endif /* GHCI */
---------------------------------------------
-- Sections
-- Sections
-- See Note [Parsing sections] in Parser.y.pp
rnExpr (HsPar (L loc (section@(SectionL {}))))
= do { (section', fvs) <- rnSection section
; return (HsPar (L loc section'), fvs) }
= do { (section', fvs) <- rnSection section
; return (HsPar (L loc section'), fvs) }
rnExpr (HsPar (L loc (section@(SectionR {}))))
= do { (section', fvs) <- rnSection section
; return (HsPar (L loc section'), fvs) }
= do { (section', fvs) <- rnSection section
; return (HsPar (L loc section'), fvs) }
rnExpr (HsPar e)
= do { (e', fvs_e) <- rnLExpr e
; return (HsPar e', fvs_e) }
= do { (e', fvs_e) <- rnLExpr e
; return (HsPar e', fvs_e) }
rnExpr expr@(SectionL {})
= do { addErr (sectionErr expr); rnSection expr }
= do { addErr (sectionErr expr); rnSection expr }
rnExpr expr@(SectionR {})
= do { addErr (sectionErr expr); rnSection expr }
= do { addErr (sectionErr expr); rnSection expr }
---------------------------------------------
rnExpr (HsCoreAnn ann expr)
......@@ -226,10 +219,10 @@ rnExpr (HsCoreAnn ann expr)
return (HsCoreAnn ann expr', fvs_expr)
rnExpr (HsSCC lbl expr)
= rnLExpr expr `thenM` \ (expr', fvs_expr) ->
= rnLExpr expr `thenM` \ (expr', fvs_expr) ->
return (HsSCC lbl expr', fvs_expr)
rnExpr (HsTickPragma info expr)
= rnLExpr expr `thenM` \ (expr', fvs_expr) ->
= rnLExpr expr `thenM` \ (expr', fvs_expr) ->
return (HsTickPragma info expr', fvs_expr)
rnExpr (HsLam matches)
......@@ -237,7 +230,7 @@ rnExpr (HsLam matches)
return (HsLam matches', fvMatch)
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)
rnExpr (HsCase expr matches)
......@@ -246,26 +239,26 @@ rnExpr (HsCase expr matches)
return (HsCase new_expr new_matches, e_fvs `plusFV` ms_fvs)
rnExpr (HsLet binds expr)
= rnLocalBindsAndThen binds $ \ binds' ->
rnLExpr expr `thenM` \ (expr',fvExpr) ->
= rnLocalBindsAndThen binds $ \ binds' ->
rnLExpr expr `thenM` \ (expr',fvExpr) ->
return (HsLet binds' expr', fvExpr)
rnExpr (HsDo do_or_lc stmts _)
= do { ((stmts', _), fvs) <- rnStmts do_or_lc rnLExpr stmts (\ _ -> return ((), emptyFVs))
; return ( HsDo do_or_lc stmts' placeHolderType, fvs ) }
= do { ((stmts', _), fvs) <- rnStmts do_or_lc rnLExpr stmts (\ _ -> return ((), emptyFVs))
; return ( HsDo do_or_lc stmts' placeHolderType, fvs ) }
rnExpr (ExplicitList _ _ exps)
= do { opt_OverloadedLists <- xoptM Opt_OverloadedLists
; (exps', fvs) <- rnExprs exps
; if opt_OverloadedLists
; if opt_OverloadedLists
then do {
; (from_list_n_name, fvs') <- lookupSyntaxName fromListNName
; return (ExplicitList placeHolderType (Just from_list_n_name) exps', fvs `plusFV` fvs') }
; (from_list_n_name, fvs') <- lookupSyntaxName fromListNName
; return (ExplicitList placeHolderType (Just from_list_n_name) exps', fvs `plusFV` fvs') }
else
return (ExplicitList placeHolderType Nothing exps', fvs) }
rnExpr (ExplicitPArr _ exps)
= rnExprs exps `thenM` \ (exps', fvs) ->
= rnExprs exps `thenM` \ (exps', fvs) ->
return (ExplicitPArr placeHolderType exps', fvs)
rnExpr (ExplicitTuple tup_args boxity)
......@@ -278,22 +271,22 @@ rnExpr (ExplicitTuple tup_args boxity)
rnTupArg (Missing _) = return (Missing placeHolderType, emptyFVs)
rnExpr (RecordCon con_id _ rbinds)
= do { conname <- lookupLocatedOccRn con_id
; (rbinds', fvRbinds) <- rnHsRecBinds (HsRecFieldCon (unLoc conname)) rbinds
; return (RecordCon conname noPostTcExpr rbinds',
fvRbinds `addOneFV` unLoc conname) }
= do { conname <- lookupLocatedOccRn con_id
; (rbinds', fvRbinds) <- rnHsRecBinds (HsRecFieldCon (unLoc conname)) rbinds
; return (RecordCon conname noPostTcExpr rbinds',
fvRbinds `addOneFV` unLoc conname) }
rnExpr (RecordUpd expr rbinds _ _ _)
= do { (expr', fvExpr) <- rnLExpr expr
; (rbinds', fvRbinds) <- rnHsRecBinds HsRecFieldUpd rbinds
; return (RecordUpd expr' rbinds' [] [] [],
fvExpr `plusFV` fvRbinds) }
= do { (expr', fvExpr) <- rnLExpr expr
; (rbinds', fvRbinds) <- rnHsRecBinds HsRecFieldUpd rbinds
; return (RecordUpd expr' rbinds' [] [] [],
fvExpr `plusFV` fvRbinds) }
rnExpr (ExprWithTySig expr pty)
= do { (pty', fvTy) <- rnLHsType ExprWithTySigCtx pty
; (expr', fvExpr) <- bindSigTyVarsFV (hsExplicitTvs pty') $
rnLExpr expr
; return (ExprWithTySig expr' pty', fvExpr `plusFV` fvTy) }
= do { (pty', fvTy) <- rnLHsType ExprWithTySigCtx pty
; (expr', fvExpr) <- bindSigTyVarsFV (hsExplicitTvs pty') $
rnLExpr expr
; return (ExprWithTySig expr' pty', fvExpr `plusFV` fvTy) }
rnExpr (HsIf _ p b1 b2)
= do { (p', fvP) <- rnLExpr p
......@@ -307,21 +300,21 @@ rnExpr (HsMultiIf ty alts)
; return (HsMultiIf ty alts', fvs) }
rnExpr (HsType a)
= rnLHsType HsTypeCtx a `thenM` \ (t, fvT) ->
= rnLHsType HsTypeCtx a `thenM` \ (t, fvT) ->
return (HsType t, fvT)
rnExpr (ArithSeq _ _ seq)
= do { opt_OverloadedLists <- xoptM Opt_OverloadedLists
; (new_seq, fvs) <- rnArithSeq seq
; if opt_OverloadedLists
; if opt_OverloadedLists
then do {
; (from_list_name, fvs') <- lookupSyntaxName fromListName
; return (ArithSeq noPostTcExpr (Just from_list_name) new_seq, fvs `plusFV` fvs') }
; (from_list_name, fvs') <- lookupSyntaxName fromListName
; return (ArithSeq noPostTcExpr (Just from_list_name) new_seq, fvs `plusFV` fvs') }
else
return (ArithSeq noPostTcExpr Nothing new_seq, fvs) }
rnExpr (PArrSeq _ seq)
= rnArithSeq seq `thenM` \ (new_seq, fvs) ->
= rnArithSeq seq `thenM` \ (new_seq, fvs) ->
return (PArrSeq noPostTcExpr new_seq, fvs)
\end{code}
......@@ -341,16 +334,16 @@ rnExpr e@(ELazyPat {}) = patSynErr e
\end{code}
%************************************************************************
%* *
Arrow notation
%* *
%* *
Arrow notation
%* *
%************************************************************************
\begin{code}
rnExpr (HsProc pat body)
= newArrowScope $
rnPat ProcExpr pat $ \ pat' ->
rnCmdTop body `thenM` \ (body',fvBody) ->
rnCmdTop body `thenM` \ (body',fvBody) ->
return (HsProc pat' body', fvBody)
-- 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
rnExpr e@(HsArrForm {}) = arrowFail e
rnExpr other = pprPanic "rnExpr: unexpected expression" (ppr other)
-- HsWrap
-- HsWrap
hsHoleExpr :: HsExpr Name
hsHoleExpr = HsUnboundVar (mkRdrUnqual (mkVarOcc "_"))
......@@ -375,24 +368,24 @@ arrowFail e
-- See Note [Parsing sections] in Parser.y.pp
rnSection :: HsExpr RdrName -> RnM (HsExpr Name, FreeVars)
rnSection section@(SectionR op expr)
= do { (op', fvs_op) <- rnLExpr op
; (expr', fvs_expr) <- rnLExpr expr
; checkSectionPrec InfixR section op' expr'
; return (SectionR op' expr', fvs_op `plusFV` fvs_expr) }
= do { (op', fvs_op) <- rnLExpr op
; (expr', fvs_expr) <- rnLExpr expr
; checkSectionPrec InfixR section op' expr'
; return (SectionR op' expr', fvs_op `plusFV` fvs_expr) }
rnSection section@(SectionL expr op)
= do { (expr', fvs_expr) <- rnLExpr expr
; (op', fvs_op) <- rnLExpr op
; checkSectionPrec InfixL section op' expr'
; return (SectionL expr' op', fvs_op `plusFV` fvs_expr) }
= do { (expr', fvs_expr) <- rnLExpr expr
; (op', fvs_op) <- rnLExpr op
; checkSectionPrec InfixL section op' expr'
; return (SectionL expr' op', fvs_op `plusFV` fvs_expr) }
rnSection other = pprPanic "rnSection" (ppr other)
\end{code}
%************************************************************************
%* *
Records
%* *
%* *
Records
%* *
%************************************************************************
\begin{code}
......@@ -401,40 +394,40 @@ rnHsRecBinds :: HsRecFieldContext -> HsRecordBinds RdrName
rnHsRecBinds ctxt rec_binds@(HsRecFields { rec_dotdot = dd })
= do { (flds, fvs) <- rnHsRecFields1 ctxt HsVar rec_binds
; (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) }
where
where
rn_field fld = do { (arg', fvs) <- rnLExpr (hsRecFieldArg fld)
; return (fld { hsRecFieldArg = arg' }, fvs) }
\end{code}
%************************************************************************
%* *
Arrow commands
%* *
%* *
Arrow commands
%* *
%************************************************************************
\begin{code}
rnCmdArgs :: [LHsCmdTop RdrName] -> RnM ([LHsCmdTop Name], FreeVars)
rnCmdArgs [] = return ([], emptyFVs)
rnCmdArgs (arg:args)
= rnCmdTop arg `thenM` \ (arg',fvArg) ->
rnCmdArgs args `thenM` \ (args',fvArgs) ->
= rnCmdTop arg `thenM` \ (arg',fvArg) ->
rnCmdArgs args `thenM` \ (args',fvArgs) ->
return (arg':args', fvArg `plusFV` fvArgs)
rnCmdTop :: LHsCmdTop RdrName -> RnM (LHsCmdTop Name, FreeVars)
rnCmdTop = wrapLocFstM rnCmdTop'
where
rnCmdTop' (HsCmdTop cmd _ _ _)
rnCmdTop' (HsCmdTop cmd _ _ _)
= do { (cmd', fvCmd) <- rnLCmd cmd
; let cmd_names = [arrAName, composeAName, firstAName] ++
nameSetToList (methodNamesCmd (unLoc cmd'))
-- Generate the rebindable syntax for the monad
nameSetToList (methodNamesCmd (unLoc cmd'))
-- Generate the rebindable syntax for the monad
; (cmd_names', cmd_fvs) <- lookupSyntaxNames cmd_names
; return (HsCmdTop cmd' placeHolderType placeHolderType (cmd_names `zip` cmd_names'),
fvCmd `plusFV` cmd_fvs) }
; return (HsCmdTop cmd' placeHolderType placeHolderType (cmd_names `zip` cmd_names'),
fvCmd `plusFV` cmd_fvs) }
rnLCmd :: LHsCmd RdrName -> RnM (LHsCmd Name, FreeVars)
rnLCmd = wrapLocFstM rnCmd
......@@ -451,10 +444,10 @@ rnCmd (HsCmdArrApp arrow arg _ ho rtl)
HsHigherOrderApp -> tc
HsFirstOrderApp -> escapeArrowScope tc
-- See Note [Escaping the arrow scope] in TcRnTypes
-- Before renaming 'arrow', use the environment of the enclosing
-- proc for the (-<) case.
-- Local bindings, inside the enclosing proc, are not in scope
-- inside 'arrow'. In the higher-order case (-<<), they are.
-- Before renaming 'arrow', use the environment of the enclosing
-- proc for the (-<) case.
-- Local bindings, inside the enclosing proc, are not in scope
-- inside 'arrow'. In the higher-order case (-<<), they are.
-- infix form
rnCmd (HsCmdArrForm op (Just _) [arg1, arg2])
......@@ -467,7 +460,7 @@ rnCmd (HsCmdArrForm op (Just _) [arg1, arg2])
-- Deal with fixity
lookupFixityRn op_name `thenM` \ fixity ->
mkOpFormRn arg1' op' fixity arg2' `thenM` \ final_e ->
mkOpFormRn arg1' op' fixity arg2' `thenM` \ final_e ->
return (final_e,
fv_arg1 `plusFV` fv_op `plusFV` fv_arg2)
......@@ -514,8 +507,8 @@ rnCmd (HsCmdDo stmts _)
rnCmd cmd@(HsCmdCast {}) = pprPanic "rnCmd" (ppr cmd)
---------------------------------------------------
type CmdNeeds = FreeVars -- Only inhabitants are
-- appAName, choiceAName, loopAName
type CmdNeeds = FreeVars -- Only inhabitants are
-- appAName, choiceAName, loopAName
-- find what methods the Cmd needs (loop, choice, apply)
methodNamesLCmd :: LHsCmd Name -> CmdNeeds
......@@ -536,7 +529,7 @@ methodNamesCmd (HsCmdIf _ _ c1 c2)
= methodNamesLCmd c1 `plusFV` methodNamesLCmd c2 `addOneFV` choiceAName
methodNamesCmd (HsCmdLet _ c) = methodNamesLCmd c
methodNamesCmd (HsCmdDo stmts _) = methodNamesStmts stmts
methodNamesCmd (HsCmdDo stmts _) = methodNamesStmts stmts
methodNamesCmd (HsCmdApp c _) = methodNamesLCmd c
methodNamesCmd (HsCmdLam match) = methodNamesMatch match
......@@ -544,7 +537,7 @@ methodNamesCmd (HsCmdCase _ matches)
= methodNamesMatch matches `addOneFV` choiceAName
--methodNamesCmd _ = emptyFVs
-- Other forms can't occur in commands, but it's not convenient
-- Other forms can't occur in commands, but it's not convenient
-- to error here so we just do what's convenient.
-- The type checker will complain later
......@@ -552,7 +545,7 @@ methodNamesCmd (HsCmdCase _ matches)
methodNamesMatch :: MatchGroup Name (LHsCmd Name) -> FreeVars
methodNamesMatch (MG { mg_alts = ms })
= plusFVs (map do_one ms)
where
where
do_one (L _ (Match _ _ grhss)) = methodNamesGRHSs grhss
-------------------------------------------------
......@@ -581,107 +574,107 @@ methodNamesStmt (RecStmt { recS_stmts = stmts }) = methodNamesStmts stmts `addOn
methodNamesStmt (LetStmt {}) = emptyFVs
methodNamesStmt (ParStmt {}) = emptyFVs
methodNamesStmt (TransStmt {}) = emptyFVs
-- ParStmt and TransStmt can't occur in commands, but it's not convenient to error
-- ParStmt and TransStmt can't occur in commands, but it's not convenient to error
-- here so we just do what's convenient
\end{code}
%************************************************************************
%* *
Arithmetic sequences
%* *
%* *
Arithmetic sequences
%* *
%************************************************************************
\begin{code}
rnArithSeq :: ArithSeqInfo RdrName -> RnM (ArithSeqInfo Name, FreeVars)
rnArithSeq (From expr)
= rnLExpr expr `thenM` \ (expr', fvExpr) ->
= rnLExpr expr `thenM` \ (expr', fvExpr) ->
return (From expr', fvExpr)
rnArithSeq (FromThen expr1 expr2)
= rnLExpr expr1 `thenM` \ (expr1', fvExpr1) ->
rnLExpr expr2 `thenM` \ (expr2', fvExpr2) ->
= rnLExpr expr1 `thenM` \ (expr1', fvExpr1) ->
rnLExpr expr2 `thenM` \ (expr2', fvExpr2) ->
return (FromThen expr1' expr2', fvExpr1 `plusFV` fvExpr2)
rnArithSeq (FromTo expr1 expr2)
= rnLExpr expr1 `thenM` \ (expr1', fvExpr1) ->
rnLExpr expr2 `thenM` \ (expr2', fvExpr2) ->
= rnLExpr expr1 `thenM` \ (expr1', fvExpr1) ->
rnLExpr expr2 `thenM` \ (expr2', fvExpr2) ->
return (FromTo expr1' expr2', fvExpr1 `plusFV` fvExpr2)
rnArithSeq (FromThenTo expr1 expr2 expr3)
= rnLExpr expr1 `thenM` \ (expr1', fvExpr1) ->
rnLExpr expr2 `thenM` \ (expr2', fvExpr2) ->
rnLExpr expr3 `thenM` \ (expr3', fvExpr3) ->
= rnLExpr expr1 `thenM` \ (expr1', fvExpr1) ->
rnLExpr expr2 `thenM` \ (expr2', fvExpr2) ->
rnLExpr expr3 `thenM` \ (expr3', fvExpr3) ->
return (FromThenTo expr1' expr2' expr3',
plusFVs [fvExpr1, fvExpr2, fvExpr3])
plusFVs [fvExpr1, fvExpr2, fvExpr3])
\end{code}
%************************************************************************
%* *
Template Haskell brackets
%* *
%* *
Template Haskell brackets
%* *
%************************************************************************
\begin{code}
rnBracket :: HsBracket RdrName -> RnM (HsBracket Name, FreeVars)
rnBracket (VarBr flg n)
rnBracket (VarBr flg n)
= do { name <- lookupOccRn n
; this_mod <- getModule
; unless (nameIsLocalOrFrom this_mod name) $ -- Reason: deprecation checking assumes
do { _ <- loadInterfaceForName msg name -- the home interface is loaded, and
; return () } -- this is the only way that is going
-- to happen
; return () } -- this is the only way that is going
-- to happen
; return (VarBr flg name, unitFV name) }
where
msg = ptext (sLit "Need interface for Template Haskell quoted Name")
rnBracket (ExpBr e) = do { (e', fvs) <- rnLExpr e
; return (ExpBr e', fvs) }
; return (ExpBr e', fvs) }
rnBracket (PatBr p) = rnPat ThPatQuote p $ \ p' -> return (PatBr p', emptyFVs)
rnBracket (TypBr t) = do { (t', fvs) <- rnLHsType TypBrCtx t
; return (TypBr t', fvs) }
; return (TypBr t', fvs) }
rnBracket (DecBrL decls)
rnBracket (DecBrL decls)
= do { (group, mb_splice) <- findSplice decls
; case mb_splice of
Nothing -> return ()
Just (SpliceDecl (L loc _) _, _)
Just (SpliceDecl (L loc _) _, _)
-> setSrcSpan loc $
addErr (ptext (sLit "Declaration splices are not permitted inside declaration brackets"))
-- Why not? See Section 7.3 of the TH paper.
-- Why not? See Section 7.3 of the TH paper.
; gbl_env <- getGblEnv
; let new_gbl_env = gbl_env { tcg_dus = emptyDUs }
-- The emptyDUs is so that we just collect uses for this
-- The emptyDUs is so that we just collect uses for this
-- group alone in the call to rnSrcDecls below
; (tcg_env, group') <- setGblEnv new_gbl_env $
setStage thRnBrack $
rnSrcDecls [] group
; (tcg_env, group') <- setGblEnv new_gbl_env $
setStage thRnBrack $
rnSrcDecls [] group
-- The empty list is for extra dependencies coming from .hs-boot files
-- See Note [Extra dependencies from .hs-boot files] in RnSource
-- Discard the tcg_env; it contains only extra info about fixity
; traceRn (text "rnBracket dec" <+> (ppr (tcg_dus tcg_env) $$
-- Discard the tcg_env; it contains only extra info about fixity
; traceRn (text "rnBracket dec" <+> (ppr (tcg_dus tcg_env) $$
ppr (duUses (tcg_dus tcg_env))))
; return (DecBrG group', duUses (tcg_dus tcg_env)) }
; return (DecBrG group', duUses (tcg_dus tcg_env)) }