{-# LANGUAGE CPP #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE ViewPatterns #-}
module RnExpr (
rnLExpr, rnExpr, rnStmts
) where
#include "HsVersions.h"
import GhcPrelude
import RnBinds ( rnLocalBindsAndThen, rnLocalValBindsLHS, rnLocalValBindsRHS,
rnMatchGroup, rnGRHS, makeMiniFixityEnv)
import GHC.Hs
import TcEnv ( isBrackStage )
import TcRnMonad
import Module ( getModule )
import RnEnv
import RnFixity
import RnUtils ( HsDocContext(..), bindLocalNamesFV, checkDupNames
, bindLocalNames
, mapMaybeFvRn, mapFvRn
, warnUnusedLocalBinds, typeAppErr
, checkUnusedRecordWildcard )
import RnUnbound ( reportUnboundName )
import RnSplice ( rnBracket, rnSpliceExpr, checkThLocalName )
import RnTypes
import RnPat
import DynFlags
import PrelNames
import BasicTypes
import Name
import NameSet
import RdrName
import UniqSet
import Data.List
import Util
import ListSetOps ( removeDups )
import ErrUtils
import Outputable
import SrcLoc
import FastString
import Control.Monad
import TysWiredIn ( nilDataConName )
import qualified GHC.LanguageExtensions as LangExt
import Data.Ord
import Data.Array
import qualified Data.List.NonEmpty as NE
import Unique ( mkVarOccUnique )
rnExprs :: [LHsExpr GhcPs] -> RnM ([LHsExpr GhcRn], FreeVars)
rnExprs :: [LHsExpr GhcPs] -> RnM ([LHsExpr GhcRn], FreeVars)
rnExprs [LHsExpr GhcPs]
ls = [LHsExpr GhcPs] -> FreeVars -> RnM ([LHsExpr GhcRn], FreeVars)
rnExprs' [LHsExpr GhcPs]
ls FreeVars
forall a. UniqSet a
emptyUniqSet
where
rnExprs' :: [LHsExpr GhcPs] -> FreeVars -> RnM ([LHsExpr GhcRn], FreeVars)
rnExprs' [] FreeVars
acc = ([LHsExpr GhcRn], FreeVars) -> RnM ([LHsExpr GhcRn], FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], FreeVars
acc)
rnExprs' (LHsExpr GhcPs
expr:[LHsExpr GhcPs]
exprs) FreeVars
acc =
do { (LHsExpr GhcRn
expr', FreeVars
fvExpr) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
expr
; let acc' :: FreeVars
acc' = FreeVars
acc FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvExpr
; ([LHsExpr GhcRn]
exprs', FreeVars
fvExprs) <- FreeVars
acc' FreeVars
-> RnM ([LHsExpr GhcRn], FreeVars)
-> RnM ([LHsExpr GhcRn], FreeVars)
`seq` [LHsExpr GhcPs] -> FreeVars -> RnM ([LHsExpr GhcRn], FreeVars)
rnExprs' [LHsExpr GhcPs]
exprs FreeVars
acc'
; ([LHsExpr GhcRn], FreeVars) -> RnM ([LHsExpr GhcRn], FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsExpr GhcRn
expr'LHsExpr GhcRn -> [LHsExpr GhcRn] -> [LHsExpr GhcRn]
forall a. a -> [a] -> [a]
:[LHsExpr GhcRn]
exprs', FreeVars
fvExprs) }
rnLExpr :: LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr :: LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr = (SrcSpanLess (LHsExpr GhcPs)
-> TcM (SrcSpanLess (LHsExpr GhcRn), FreeVars))
-> LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
forall a b c.
(HasSrcSpan a, HasSrcSpan b) =>
(SrcSpanLess a -> TcM (SrcSpanLess b, c)) -> a -> TcM (b, c)
wrapLocFstM SrcSpanLess (LHsExpr GhcPs)
-> TcM (SrcSpanLess (LHsExpr GhcRn), FreeVars)
HsExpr GhcPs -> RnM (HsExpr GhcRn, FreeVars)
rnExpr
rnExpr :: HsExpr GhcPs -> RnM (HsExpr GhcRn, FreeVars)
finishHsVar :: Located Name -> RnM (HsExpr GhcRn, FreeVars)
finishHsVar :: Located Name -> RnM (HsExpr GhcRn, FreeVars)
finishHsVar (L SrcSpan
l Name
name)
= do { Module
this_mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
; Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Module -> Name -> Bool
nameIsLocalOrFrom Module
this_mod Name
name) (IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
Name -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkThLocalName Name
name
; (HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XVar GhcRn -> Located (IdP GhcRn) -> HsExpr GhcRn
forall p. XVar p -> Located (IdP p) -> HsExpr p
HsVar XVar GhcRn
NoExtField
noExtField (SrcSpan -> Name -> Located Name
forall l e. l -> e -> GenLocated l e
L SrcSpan
l Name
name), Name -> FreeVars
unitFV Name
name) }
rnUnboundVar :: RdrName -> RnM (HsExpr GhcRn, FreeVars)
rnUnboundVar :: RdrName -> RnM (HsExpr GhcRn, FreeVars)
rnUnboundVar RdrName
v
= do { if RdrName -> Bool
isUnqual RdrName
v
then
do { let occ :: OccName
occ = RdrName -> OccName
rdrNameOcc RdrName
v
; UnboundVar
uv <- if OccName -> Bool
startsWithUnderscore OccName
occ
then UnboundVar -> IOEnv (Env TcGblEnv TcLclEnv) UnboundVar
forall (m :: * -> *) a. Monad m => a -> m a
return (OccName -> UnboundVar
TrueExprHole OccName
occ)
else OccName -> GlobalRdrEnv -> UnboundVar
OutOfScope OccName
occ (GlobalRdrEnv -> UnboundVar)
-> IOEnv (Env TcGblEnv TcLclEnv) GlobalRdrEnv
-> IOEnv (Env TcGblEnv TcLclEnv) UnboundVar
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IOEnv (Env TcGblEnv TcLclEnv) GlobalRdrEnv
getGlobalRdrEnv
; (HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XUnboundVar GhcRn -> UnboundVar -> HsExpr GhcRn
forall p. XUnboundVar p -> UnboundVar -> HsExpr p
HsUnboundVar XUnboundVar GhcRn
NoExtField
noExtField UnboundVar
uv, FreeVars
emptyFVs) }
else
do { Name
n <- RdrName -> RnM Name
reportUnboundName RdrName
v
; (HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XVar GhcRn -> Located (IdP GhcRn) -> HsExpr GhcRn
forall p. XVar p -> Located (IdP p) -> HsExpr p
HsVar XVar GhcRn
NoExtField
noExtField (SrcSpanLess (Located Name) -> Located Name
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc Name
SrcSpanLess (Located Name)
n), FreeVars
emptyFVs) } }
rnExpr :: HsExpr GhcPs -> RnM (HsExpr GhcRn, FreeVars)
rnExpr (HsVar XVar GhcPs
_ (L SrcSpan
l IdP GhcPs
v))
= do { Bool
opt_DuplicateRecordFields <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.DuplicateRecordFields
; Maybe (Either Name [Name])
mb_name <- Bool -> RdrName -> RnM (Maybe (Either Name [Name]))
lookupOccRn_overloaded Bool
opt_DuplicateRecordFields RdrName
IdP GhcPs
v
; DynFlags
dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
; case Maybe (Either Name [Name])
mb_name of {
Maybe (Either Name [Name])
Nothing -> RdrName -> RnM (HsExpr GhcRn, FreeVars)
rnUnboundVar RdrName
IdP GhcPs
v ;
Just (Left Name
name)
| Name
name Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
nilDataConName
, Extension -> DynFlags -> Bool
xopt Extension
LangExt.OverloadedLists DynFlags
dflags
-> HsExpr GhcPs -> RnM (HsExpr GhcRn, FreeVars)
rnExpr (XExplicitList GhcPs
-> Maybe (SyntaxExpr GhcPs) -> [LHsExpr GhcPs] -> HsExpr GhcPs
forall p.
XExplicitList p -> Maybe (SyntaxExpr p) -> [LHsExpr p] -> HsExpr p
ExplicitList XExplicitList GhcPs
NoExtField
noExtField Maybe (SyntaxExpr GhcPs)
forall a. Maybe a
Nothing [])
| Bool
otherwise
-> Located Name -> RnM (HsExpr GhcRn, FreeVars)
finishHsVar (SrcSpan -> Name -> Located Name
forall l e. l -> e -> GenLocated l e
L SrcSpan
l Name
name) ;
Just (Right [Name
s]) ->
(HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return ( XRecFld GhcRn -> AmbiguousFieldOcc GhcRn -> HsExpr GhcRn
forall p. XRecFld p -> AmbiguousFieldOcc p -> HsExpr p
HsRecFld XRecFld GhcRn
NoExtField
noExtField (XUnambiguous GhcRn -> Located RdrName -> AmbiguousFieldOcc GhcRn
forall pass.
XUnambiguous pass -> Located RdrName -> AmbiguousFieldOcc pass
Unambiguous Name
XUnambiguous GhcRn
s (SrcSpan -> RdrName -> Located RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpan
l RdrName
IdP GhcPs
v) ), Name -> FreeVars
unitFV Name
s) ;
Just (Right fs :: [Name]
fs@(Name
_:Name
_:[Name]
_)) ->
(HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return ( XRecFld GhcRn -> AmbiguousFieldOcc GhcRn -> HsExpr GhcRn
forall p. XRecFld p -> AmbiguousFieldOcc p -> HsExpr p
HsRecFld XRecFld GhcRn
NoExtField
noExtField (XAmbiguous GhcRn -> Located RdrName -> AmbiguousFieldOcc GhcRn
forall pass.
XAmbiguous pass -> Located RdrName -> AmbiguousFieldOcc pass
Ambiguous XAmbiguous GhcRn
NoExtField
noExtField (SrcSpan -> RdrName -> Located RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpan
l RdrName
IdP GhcPs
v))
, [Name] -> FreeVars
mkFVs [Name]
fs);
Just (Right []) -> String -> RnM (HsExpr GhcRn, FreeVars)
forall a. String -> a
panic String
"runExpr/HsVar" } }
rnExpr (HsIPVar XIPVar GhcPs
x HsIPName
v)
= (HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XIPVar GhcRn -> HsIPName -> HsExpr GhcRn
forall p. XIPVar p -> HsIPName -> HsExpr p
HsIPVar XIPVar GhcPs
XIPVar GhcRn
x HsIPName
v, FreeVars
emptyFVs)
rnExpr (HsUnboundVar XUnboundVar GhcPs
x UnboundVar
v)
= (HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XUnboundVar GhcRn -> UnboundVar -> HsExpr GhcRn
forall p. XUnboundVar p -> UnboundVar -> HsExpr p
HsUnboundVar XUnboundVar GhcPs
XUnboundVar GhcRn
x UnboundVar
v, FreeVars
emptyFVs)
rnExpr (HsOverLabel XOverLabel GhcPs
x Maybe (IdP GhcPs)
_ FastString
v)
= do { Bool
rebindable_on <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.RebindableSyntax
; if Bool
rebindable_on
then do { Name
fromLabel <- RdrName -> RnM Name
lookupOccRn (FastString -> RdrName
mkVarUnqual (String -> FastString
fsLit String
"fromLabel"))
; (HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XOverLabel GhcRn -> Maybe (IdP GhcRn) -> FastString -> HsExpr GhcRn
forall p. XOverLabel p -> Maybe (IdP p) -> FastString -> HsExpr p
HsOverLabel XOverLabel GhcPs
XOverLabel GhcRn
x (Name -> Maybe Name
forall a. a -> Maybe a
Just Name
fromLabel) FastString
v, Name -> FreeVars
unitFV Name
fromLabel) }
else (HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XOverLabel GhcRn -> Maybe (IdP GhcRn) -> FastString -> HsExpr GhcRn
forall p. XOverLabel p -> Maybe (IdP p) -> FastString -> HsExpr p
HsOverLabel XOverLabel GhcPs
XOverLabel GhcRn
x Maybe (IdP GhcRn)
forall a. Maybe a
Nothing FastString
v, FreeVars
emptyFVs) }
rnExpr (HsLit XLitE GhcPs
x lit :: HsLit GhcPs
lit@(HsString XHsString GhcPs
src FastString
s))
= do { Bool
opt_OverloadedStrings <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.OverloadedStrings
; if Bool
opt_OverloadedStrings then
HsExpr GhcPs -> RnM (HsExpr GhcRn, FreeVars)
rnExpr (XOverLitE GhcPs -> HsOverLit GhcPs -> HsExpr GhcPs
forall p. XOverLitE p -> HsOverLit p -> HsExpr p
HsOverLit XLitE GhcPs
XOverLitE GhcPs
x (SourceText -> FastString -> HsOverLit GhcPs
mkHsIsString SourceText
XHsString GhcPs
src FastString
s))
else do {
; HsLit GhcPs -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall p. HsLit p -> IOEnv (Env TcGblEnv TcLclEnv) ()
rnLit HsLit GhcPs
lit
; (HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XLitE GhcRn -> HsLit GhcRn -> HsExpr GhcRn
forall p. XLitE p -> HsLit p -> HsExpr p
HsLit XLitE GhcPs
XLitE GhcRn
x (HsLit GhcPs -> HsLit GhcRn
forall a b. ConvertIdX a b => HsLit a -> HsLit b
convertLit HsLit GhcPs
lit), FreeVars
emptyFVs) } }
rnExpr (HsLit XLitE GhcPs
x HsLit GhcPs
lit)
= do { HsLit GhcPs -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall p. HsLit p -> IOEnv (Env TcGblEnv TcLclEnv) ()
rnLit HsLit GhcPs
lit
; (HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XLitE GhcRn -> HsLit GhcRn -> HsExpr GhcRn
forall p. XLitE p -> HsLit p -> HsExpr p
HsLit XLitE GhcPs
XLitE GhcRn
x(HsLit GhcPs -> HsLit GhcRn
forall a b. ConvertIdX a b => HsLit a -> HsLit b
convertLit HsLit GhcPs
lit), FreeVars
emptyFVs) }
rnExpr (HsOverLit XOverLitE GhcPs
x HsOverLit GhcPs
lit)
= do { ((HsOverLit GhcRn
lit', Maybe (HsExpr GhcRn)
mb_neg), FreeVars
fvs) <- HsOverLit GhcPs
-> RnM ((HsOverLit GhcRn, Maybe (HsExpr GhcRn)), FreeVars)
forall t.
HsOverLit t
-> RnM ((HsOverLit GhcRn, Maybe (HsExpr GhcRn)), FreeVars)
rnOverLit HsOverLit GhcPs
lit
; case Maybe (HsExpr GhcRn)
mb_neg of
Maybe (HsExpr GhcRn)
Nothing -> (HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XOverLitE GhcRn -> HsOverLit GhcRn -> HsExpr GhcRn
forall p. XOverLitE p -> HsOverLit p -> HsExpr p
HsOverLit XOverLitE GhcPs
XOverLitE GhcRn
x HsOverLit GhcRn
lit', FreeVars
fvs)
Just HsExpr GhcRn
neg -> (HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XApp GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp XApp GhcRn
XOverLitE GhcPs
x (SrcSpanLess (LHsExpr GhcRn) -> LHsExpr GhcRn
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc SrcSpanLess (LHsExpr GhcRn)
HsExpr GhcRn
neg) (SrcSpanLess (LHsExpr GhcRn) -> LHsExpr GhcRn
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (XOverLitE GhcRn -> HsOverLit GhcRn -> HsExpr GhcRn
forall p. XOverLitE p -> HsOverLit p -> HsExpr p
HsOverLit XOverLitE GhcPs
XOverLitE GhcRn
x HsOverLit GhcRn
lit'))
, FreeVars
fvs ) }
rnExpr (HsApp XApp GhcPs
x LHsExpr GhcPs
fun LHsExpr GhcPs
arg)
= do { (LHsExpr GhcRn
fun',FreeVars
fvFun) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
fun
; (LHsExpr GhcRn
arg',FreeVars
fvArg) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
arg
; (HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XApp GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp XApp GhcPs
XApp GhcRn
x LHsExpr GhcRn
fun' LHsExpr GhcRn
arg', FreeVars
fvFun FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvArg) }
rnExpr (HsAppType XAppTypeE GhcPs
x LHsExpr GhcPs
fun LHsWcType (NoGhcTc GhcPs)
arg)
= do { Bool
type_app <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.TypeApplications
; Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
type_app (IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ String -> LHsType GhcPs -> MsgDoc
typeAppErr String
"type" (LHsType GhcPs -> MsgDoc) -> LHsType GhcPs -> MsgDoc
forall a b. (a -> b) -> a -> b
$ HsWildCardBndrs GhcPs (LHsType GhcPs) -> LHsType GhcPs
forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body LHsWcType (NoGhcTc GhcPs)
HsWildCardBndrs GhcPs (LHsType GhcPs)
arg
; (LHsExpr GhcRn
fun',FreeVars
fvFun) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
fun
; (LHsWcType GhcRn
arg',FreeVars
fvArg) <- HsDocContext
-> HsWildCardBndrs GhcPs (LHsType GhcPs)
-> RnM (LHsWcType GhcRn, FreeVars)
rnHsWcType HsDocContext
HsTypeCtx LHsWcType (NoGhcTc GhcPs)
HsWildCardBndrs GhcPs (LHsType GhcPs)
arg
; (HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XAppTypeE GhcRn
-> LHsExpr GhcRn -> LHsWcType (NoGhcTc GhcRn) -> HsExpr GhcRn
forall p.
XAppTypeE p -> LHsExpr p -> LHsWcType (NoGhcTc p) -> HsExpr p
HsAppType XAppTypeE GhcPs
XAppTypeE GhcRn
x LHsExpr GhcRn
fun' LHsWcType (NoGhcTc GhcRn)
LHsWcType GhcRn
arg', FreeVars
fvFun FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvArg) }
rnExpr (OpApp XOpApp GhcPs
_ LHsExpr GhcPs
e1 LHsExpr GhcPs
op LHsExpr GhcPs
e2)
= do { (LHsExpr GhcRn
e1', FreeVars
fv_e1) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
e1
; (LHsExpr GhcRn
e2', FreeVars
fv_e2) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
e2
; (LHsExpr GhcRn
op', FreeVars
fv_op) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
op
; Fixity
fixity <- case LHsExpr GhcRn
op' of
L SrcSpan
_ (HsVar XVar GhcRn
_ (L SrcSpan
_ IdP GhcRn
n)) -> Name -> IOEnv (Env TcGblEnv TcLclEnv) Fixity
lookupFixityRn Name
IdP GhcRn
n
L SrcSpan
_ (HsRecFld XRecFld GhcRn
_ AmbiguousFieldOcc GhcRn
f) -> AmbiguousFieldOcc GhcRn -> IOEnv (Env TcGblEnv TcLclEnv) Fixity
lookupFieldFixityRn AmbiguousFieldOcc GhcRn
f
LHsExpr GhcRn
_ -> Fixity -> IOEnv (Env TcGblEnv TcLclEnv) Fixity
forall (m :: * -> *) a. Monad m => a -> m a
return (SourceText -> Int -> FixityDirection -> Fixity
Fixity SourceText
NoSourceText Int
minPrecedence FixityDirection
InfixL)
; HsExpr GhcRn
final_e <- LHsExpr GhcRn
-> LHsExpr GhcRn -> Fixity -> LHsExpr GhcRn -> RnM (HsExpr GhcRn)
mkOpAppRn LHsExpr GhcRn
e1' LHsExpr GhcRn
op' Fixity
fixity LHsExpr GhcRn
e2'
; (HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr GhcRn
final_e, FreeVars
fv_e1 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fv_op FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fv_e2) }
rnExpr (NegApp XNegApp GhcPs
_ LHsExpr GhcPs
e SyntaxExpr GhcPs
_)
= do { (LHsExpr GhcRn
e', FreeVars
fv_e) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
e
; (SyntaxExpr GhcRn
neg_name, FreeVars
fv_neg) <- Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupSyntaxName Name
negateName
; HsExpr GhcRn
final_e <- LHsExpr GhcRn -> SyntaxExpr GhcRn -> RnM (HsExpr GhcRn)
forall (id :: Pass).
LHsExpr (GhcPass id)
-> SyntaxExpr (GhcPass id) -> RnM (HsExpr (GhcPass id))
mkNegAppRn LHsExpr GhcRn
e' SyntaxExpr GhcRn
neg_name
; (HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr GhcRn
final_e, FreeVars
fv_e FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fv_neg) }
rnExpr e :: HsExpr GhcPs
e@(HsBracket XBracket GhcPs
_ HsBracket GhcPs
br_body) = HsExpr GhcPs -> HsBracket GhcPs -> RnM (HsExpr GhcRn, FreeVars)
rnBracket HsExpr GhcPs
e HsBracket GhcPs
br_body
rnExpr (HsSpliceE XSpliceE GhcPs
_ HsSplice GhcPs
splice) = HsSplice GhcPs -> RnM (HsExpr GhcRn, FreeVars)
rnSpliceExpr HsSplice GhcPs
splice
rnExpr (HsPar XPar GhcPs
x (L SrcSpan
loc (section :: HsExpr GhcPs
section@(SectionL {}))))
= do { (HsExpr GhcRn
section', FreeVars
fvs) <- HsExpr GhcPs -> RnM (HsExpr GhcRn, FreeVars)
rnSection HsExpr GhcPs
section
; (HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XPar GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn
forall p. XPar p -> LHsExpr p -> HsExpr p
HsPar XPar GhcPs
XPar GhcRn
x (SrcSpan -> HsExpr GhcRn -> LHsExpr GhcRn
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc HsExpr GhcRn
section'), FreeVars
fvs) }
rnExpr (HsPar XPar GhcPs
x (L SrcSpan
loc (section :: HsExpr GhcPs
section@(SectionR {}))))
= do { (HsExpr GhcRn
section', FreeVars
fvs) <- HsExpr GhcPs -> RnM (HsExpr GhcRn, FreeVars)
rnSection HsExpr GhcPs
section
; (HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XPar GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn
forall p. XPar p -> LHsExpr p -> HsExpr p
HsPar XPar GhcPs
XPar GhcRn
x (SrcSpan -> HsExpr GhcRn -> LHsExpr GhcRn
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc HsExpr GhcRn
section'), FreeVars
fvs) }
rnExpr (HsPar XPar GhcPs
x LHsExpr GhcPs
e)
= do { (LHsExpr GhcRn
e', FreeVars
fvs_e) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
e
; (HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XPar GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn
forall p. XPar p -> LHsExpr p -> HsExpr p
HsPar XPar GhcPs
XPar GhcRn
x LHsExpr GhcRn
e', FreeVars
fvs_e) }
rnExpr expr :: HsExpr GhcPs
expr@(SectionL {})
= do { MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (HsExpr GhcPs -> MsgDoc
sectionErr HsExpr GhcPs
expr); HsExpr GhcPs -> RnM (HsExpr GhcRn, FreeVars)
rnSection HsExpr GhcPs
expr }
rnExpr expr :: HsExpr GhcPs
expr@(SectionR {})
= do { MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (HsExpr GhcPs -> MsgDoc
sectionErr HsExpr GhcPs
expr); HsExpr GhcPs -> RnM (HsExpr GhcRn, FreeVars)
rnSection HsExpr GhcPs
expr }
rnExpr (HsCoreAnn XCoreAnn GhcPs
x SourceText
src StringLiteral
ann LHsExpr GhcPs
expr)
= do { (LHsExpr GhcRn
expr', FreeVars
fvs_expr) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
expr
; (HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XCoreAnn GhcRn
-> SourceText -> StringLiteral -> LHsExpr GhcRn -> HsExpr GhcRn
forall p.
XCoreAnn p -> SourceText -> StringLiteral -> LHsExpr p -> HsExpr p
HsCoreAnn XCoreAnn GhcPs
XCoreAnn GhcRn
x SourceText
src StringLiteral
ann LHsExpr GhcRn
expr', FreeVars
fvs_expr) }
rnExpr (HsSCC XSCC GhcPs
x SourceText
src StringLiteral
lbl LHsExpr GhcPs
expr)
= do { (LHsExpr GhcRn
expr', FreeVars
fvs_expr) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
expr
; (HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XSCC GhcRn
-> SourceText -> StringLiteral -> LHsExpr GhcRn -> HsExpr GhcRn
forall p.
XSCC p -> SourceText -> StringLiteral -> LHsExpr p -> HsExpr p
HsSCC XSCC GhcPs
XSCC GhcRn
x SourceText
src StringLiteral
lbl LHsExpr GhcRn
expr', FreeVars
fvs_expr) }
rnExpr (HsTickPragma XTickPragma GhcPs
x SourceText
src (StringLiteral, (Int, Int), (Int, Int))
info ((SourceText, SourceText), (SourceText, SourceText))
srcInfo LHsExpr GhcPs
expr)
= do { (LHsExpr GhcRn
expr', FreeVars
fvs_expr) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
expr
; (HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XTickPragma GhcRn
-> SourceText
-> (StringLiteral, (Int, Int), (Int, Int))
-> ((SourceText, SourceText), (SourceText, SourceText))
-> LHsExpr GhcRn
-> HsExpr GhcRn
forall p.
XTickPragma p
-> SourceText
-> (StringLiteral, (Int, Int), (Int, Int))
-> ((SourceText, SourceText), (SourceText, SourceText))
-> LHsExpr p
-> HsExpr p
HsTickPragma XTickPragma GhcPs
XTickPragma GhcRn
x SourceText
src (StringLiteral, (Int, Int), (Int, Int))
info ((SourceText, SourceText), (SourceText, SourceText))
srcInfo LHsExpr GhcRn
expr', FreeVars
fvs_expr) }
rnExpr (HsLam XLam GhcPs
x MatchGroup GhcPs (LHsExpr GhcPs)
matches)
= do { (MatchGroup GhcRn (LHsExpr GhcRn)
matches', FreeVars
fvMatch) <- HsMatchContext Name
-> (LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars))
-> MatchGroup GhcPs (LHsExpr GhcPs)
-> RnM (MatchGroup GhcRn (LHsExpr GhcRn), FreeVars)
forall (body :: * -> *).
Outputable (body GhcPs) =>
HsMatchContext Name
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> MatchGroup GhcPs (Located (body GhcPs))
-> RnM (MatchGroup GhcRn (Located (body GhcRn)), FreeVars)
rnMatchGroup HsMatchContext Name
forall id. HsMatchContext id
LambdaExpr LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr MatchGroup GhcPs (LHsExpr GhcPs)
matches
; (HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XLam GhcRn -> MatchGroup GhcRn (LHsExpr GhcRn) -> HsExpr GhcRn
forall p. XLam p -> MatchGroup p (LHsExpr p) -> HsExpr p
HsLam XLam GhcPs
XLam GhcRn
x MatchGroup GhcRn (LHsExpr GhcRn)
matches', FreeVars
fvMatch) }
rnExpr (HsLamCase XLamCase GhcPs
x MatchGroup GhcPs (LHsExpr GhcPs)
matches)
= do { (MatchGroup GhcRn (LHsExpr GhcRn)
matches', FreeVars
fvs_ms) <- HsMatchContext Name
-> (LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars))
-> MatchGroup GhcPs (LHsExpr GhcPs)
-> RnM (MatchGroup GhcRn (LHsExpr GhcRn), FreeVars)
forall (body :: * -> *).
Outputable (body GhcPs) =>
HsMatchContext Name
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> MatchGroup GhcPs (Located (body GhcPs))
-> RnM (MatchGroup GhcRn (Located (body GhcRn)), FreeVars)
rnMatchGroup HsMatchContext Name
forall id. HsMatchContext id
CaseAlt LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr MatchGroup GhcPs (LHsExpr GhcPs)
matches
; (HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XLamCase GhcRn -> MatchGroup GhcRn (LHsExpr GhcRn) -> HsExpr GhcRn
forall p. XLamCase p -> MatchGroup p (LHsExpr p) -> HsExpr p
HsLamCase XLamCase GhcPs
XLamCase GhcRn
x MatchGroup GhcRn (LHsExpr GhcRn)
matches', FreeVars
fvs_ms) }
rnExpr (HsCase XCase GhcPs
x LHsExpr GhcPs
expr MatchGroup GhcPs (LHsExpr GhcPs)
matches)
= do { (LHsExpr GhcRn
new_expr, FreeVars
e_fvs) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
expr
; (MatchGroup GhcRn (LHsExpr GhcRn)
new_matches, FreeVars
ms_fvs) <- HsMatchContext Name
-> (LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars))
-> MatchGroup GhcPs (LHsExpr GhcPs)
-> RnM (MatchGroup GhcRn (LHsExpr GhcRn), FreeVars)
forall (body :: * -> *).
Outputable (body GhcPs) =>
HsMatchContext Name
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> MatchGroup GhcPs (Located (body GhcPs))
-> RnM (MatchGroup GhcRn (Located (body GhcRn)), FreeVars)
rnMatchGroup HsMatchContext Name
forall id. HsMatchContext id
CaseAlt LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr MatchGroup GhcPs (LHsExpr GhcPs)
matches
; (HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XCase GhcRn
-> LHsExpr GhcRn
-> MatchGroup GhcRn (LHsExpr GhcRn)
-> HsExpr GhcRn
forall p.
XCase p -> LHsExpr p -> MatchGroup p (LHsExpr p) -> HsExpr p
HsCase XCase GhcPs
XCase GhcRn
x LHsExpr GhcRn
new_expr MatchGroup GhcRn (LHsExpr GhcRn)
new_matches, FreeVars
e_fvs FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
ms_fvs) }
rnExpr (HsLet XLet GhcPs
x (L SrcSpan
l HsLocalBinds GhcPs
binds) LHsExpr GhcPs
expr)
= HsLocalBinds GhcPs
-> (HsLocalBinds GhcRn -> FreeVars -> RnM (HsExpr GhcRn, FreeVars))
-> RnM (HsExpr GhcRn, FreeVars)
forall result.
HsLocalBinds GhcPs
-> (HsLocalBinds GhcRn -> FreeVars -> RnM (result, FreeVars))
-> RnM (result, FreeVars)
rnLocalBindsAndThen HsLocalBinds GhcPs
binds ((HsLocalBinds GhcRn -> FreeVars -> RnM (HsExpr GhcRn, FreeVars))
-> RnM (HsExpr GhcRn, FreeVars))
-> (HsLocalBinds GhcRn -> FreeVars -> RnM (HsExpr GhcRn, FreeVars))
-> RnM (HsExpr GhcRn, FreeVars)
forall a b. (a -> b) -> a -> b
$ \HsLocalBinds GhcRn
binds' FreeVars
_ -> do
{ (LHsExpr GhcRn
expr',FreeVars
fvExpr) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
expr
; (HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XLet GhcRn -> LHsLocalBinds GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn
forall p. XLet p -> LHsLocalBinds p -> LHsExpr p -> HsExpr p
HsLet XLet GhcPs
XLet GhcRn
x (SrcSpan -> HsLocalBinds GhcRn -> LHsLocalBinds GhcRn
forall l e. l -> e -> GenLocated l e
L SrcSpan
l HsLocalBinds GhcRn
binds') LHsExpr GhcRn
expr', FreeVars
fvExpr) }
rnExpr (HsDo XDo GhcPs
x HsStmtContext Name
do_or_lc (L SrcSpan
l [ExprLStmt GhcPs]
stmts))
= do { (([LStmt GhcRn (LHsExpr GhcRn)]
stmts', ()
_), FreeVars
fvs) <-
HsStmtContext Name
-> (LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars))
-> (HsStmtContext Name
-> [(LStmt GhcRn (LHsExpr GhcRn), FreeVars)]
-> RnM ([LStmt GhcRn (LHsExpr GhcRn)], FreeVars))
-> [ExprLStmt GhcPs]
-> ([Name] -> RnM ((), FreeVars))
-> RnM (([LStmt GhcRn (LHsExpr GhcRn)], ()), FreeVars)
forall (body :: * -> *) thing.
Outputable (body GhcPs) =>
HsStmtContext Name
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> (HsStmtContext Name
-> [(LStmt GhcRn (Located (body GhcRn)), FreeVars)]
-> RnM ([LStmt GhcRn (Located (body GhcRn))], FreeVars))
-> [LStmt GhcPs (Located (body GhcPs))]
-> ([Name] -> RnM (thing, FreeVars))
-> RnM (([LStmt GhcRn (Located (body GhcRn))], thing), FreeVars)
rnStmtsWithPostProcessing HsStmtContext Name
do_or_lc LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr
HsStmtContext Name
-> [(LStmt GhcRn (LHsExpr GhcRn), FreeVars)]
-> RnM ([LStmt GhcRn (LHsExpr GhcRn)], FreeVars)
postProcessStmtsForApplicativeDo [ExprLStmt GhcPs]
stmts
(\ [Name]
_ -> ((), FreeVars) -> RnM ((), FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return ((), FreeVars
emptyFVs))
; (HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return ( XDo GhcRn
-> HsStmtContext Name
-> Located [LStmt GhcRn (LHsExpr GhcRn)]
-> HsExpr GhcRn
forall p.
XDo p -> HsStmtContext Name -> Located [ExprLStmt p] -> HsExpr p
HsDo XDo GhcPs
XDo GhcRn
x HsStmtContext Name
do_or_lc (SrcSpan
-> [LStmt GhcRn (LHsExpr GhcRn)]
-> Located [LStmt GhcRn (LHsExpr GhcRn)]
forall l e. l -> e -> GenLocated l e
L SrcSpan
l [LStmt GhcRn (LHsExpr GhcRn)]
stmts'), FreeVars
fvs ) }
rnExpr (ExplicitList XExplicitList GhcPs
x Maybe (SyntaxExpr GhcPs)
_ [LHsExpr GhcPs]
exps)
= do { Bool
opt_OverloadedLists <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.OverloadedLists
; ([LHsExpr GhcRn]
exps', FreeVars
fvs) <- [LHsExpr GhcPs] -> RnM ([LHsExpr GhcRn], FreeVars)
rnExprs [LHsExpr GhcPs]
exps
; if Bool
opt_OverloadedLists
then do {
; (SyntaxExpr GhcRn
from_list_n_name, FreeVars
fvs') <- Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupSyntaxName Name
fromListNName
; (HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XExplicitList GhcRn
-> Maybe (SyntaxExpr GhcRn) -> [LHsExpr GhcRn] -> HsExpr GhcRn
forall p.
XExplicitList p -> Maybe (SyntaxExpr p) -> [LHsExpr p] -> HsExpr p
ExplicitList XExplicitList GhcPs
XExplicitList GhcRn
x (SyntaxExpr GhcRn -> Maybe (SyntaxExpr GhcRn)
forall a. a -> Maybe a
Just SyntaxExpr GhcRn
from_list_n_name) [LHsExpr GhcRn]
exps'
, FreeVars
fvs FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs') }
else
(HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XExplicitList GhcRn
-> Maybe (SyntaxExpr GhcRn) -> [LHsExpr GhcRn] -> HsExpr GhcRn
forall p.
XExplicitList p -> Maybe (SyntaxExpr p) -> [LHsExpr p] -> HsExpr p
ExplicitList XExplicitList GhcPs
XExplicitList GhcRn
x Maybe (SyntaxExpr GhcRn)
forall a. Maybe a
Nothing [LHsExpr GhcRn]
exps', FreeVars
fvs) }
rnExpr (ExplicitTuple XExplicitTuple GhcPs
x [LHsTupArg GhcPs]
tup_args Boxity
boxity)
= do { [LHsTupArg GhcPs] -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkTupleSection [LHsTupArg GhcPs]
tup_args
; Int -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkTupSize ([LHsTupArg GhcPs] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [LHsTupArg GhcPs]
tup_args)
; ([GenLocated SrcSpan (HsTupArg GhcRn)]
tup_args', [FreeVars]
fvs) <- (LHsTupArg GhcPs
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpan (HsTupArg GhcRn), FreeVars))
-> [LHsTupArg GhcPs]
-> IOEnv
(Env TcGblEnv TcLclEnv)
([GenLocated SrcSpan (HsTupArg GhcRn)], [FreeVars])
forall (m :: * -> *) a b c.
Applicative m =>
(a -> m (b, c)) -> [a] -> m ([b], [c])
mapAndUnzipM LHsTupArg GhcPs
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpan (HsTupArg GhcRn), FreeVars)
forall l.
GenLocated l (HsTupArg GhcPs)
-> IOEnv
(Env TcGblEnv TcLclEnv) (GenLocated l (HsTupArg GhcRn), FreeVars)
rnTupArg [LHsTupArg GhcPs]
tup_args
; (HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XExplicitTuple GhcRn
-> [GenLocated SrcSpan (HsTupArg GhcRn)] -> Boxity -> HsExpr GhcRn
forall p. XExplicitTuple p -> [LHsTupArg p] -> Boxity -> HsExpr p
ExplicitTuple XExplicitTuple GhcPs
XExplicitTuple GhcRn
x [GenLocated SrcSpan (HsTupArg GhcRn)]
tup_args' Boxity
boxity, [FreeVars] -> FreeVars
plusFVs [FreeVars]
fvs) }
where
rnTupArg :: GenLocated l (HsTupArg GhcPs)
-> IOEnv
(Env TcGblEnv TcLclEnv) (GenLocated l (HsTupArg GhcRn), FreeVars)
rnTupArg (L l
l (Present XPresent GhcPs
x LHsExpr GhcPs
e)) = do { (LHsExpr GhcRn
e',FreeVars
fvs) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
e
; (GenLocated l (HsTupArg GhcRn), FreeVars)
-> IOEnv
(Env TcGblEnv TcLclEnv) (GenLocated l (HsTupArg GhcRn), FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (l -> HsTupArg GhcRn -> GenLocated l (HsTupArg GhcRn)
forall l e. l -> e -> GenLocated l e
L l
l (XPresent GhcRn -> LHsExpr GhcRn -> HsTupArg GhcRn
forall id. XPresent id -> LHsExpr id -> HsTupArg id
Present XPresent GhcPs
XPresent GhcRn
x LHsExpr GhcRn
e'), FreeVars
fvs) }
rnTupArg (L l
l (Missing XMissing GhcPs
_)) = (GenLocated l (HsTupArg GhcRn), FreeVars)
-> IOEnv
(Env TcGblEnv TcLclEnv) (GenLocated l (HsTupArg GhcRn), FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (l -> HsTupArg GhcRn -> GenLocated l (HsTupArg GhcRn)
forall l e. l -> e -> GenLocated l e
L l
l (XMissing GhcRn -> HsTupArg GhcRn
forall id. XMissing id -> HsTupArg id
Missing XMissing GhcRn
NoExtField
noExtField)
, FreeVars
emptyFVs)
rnTupArg (L l
_ (XTupArg XXTupArg GhcPs
nec)) = NoExtCon
-> IOEnv
(Env TcGblEnv TcLclEnv) (GenLocated l (HsTupArg GhcRn), FreeVars)
forall a. NoExtCon -> a
noExtCon XXTupArg GhcPs
NoExtCon
nec
rnExpr (ExplicitSum XExplicitSum GhcPs
x Int
alt Int
arity LHsExpr GhcPs
expr)
= do { (LHsExpr GhcRn
expr', FreeVars
fvs) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
expr
; (HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XExplicitSum GhcRn -> Int -> Int -> LHsExpr GhcRn -> HsExpr GhcRn
forall p. XExplicitSum p -> Int -> Int -> LHsExpr p -> HsExpr p
ExplicitSum XExplicitSum GhcPs
XExplicitSum GhcRn
x Int
alt Int
arity LHsExpr GhcRn
expr', FreeVars
fvs) }
rnExpr (RecordCon { rcon_con_name :: forall p. HsExpr p -> Located (IdP p)
rcon_con_name = GenLocated SrcSpan (IdP GhcPs)
con_id
, rcon_flds :: forall p. HsExpr p -> HsRecordBinds p
rcon_flds = rec_binds :: HsRecordBinds GhcPs
rec_binds@(HsRecFields { rec_dotdot :: forall p arg. HsRecFields p arg -> Maybe (Located Int)
rec_dotdot = Maybe (Located Int)
dd }) })
= do { con_lname :: Located Name
con_lname@(L SrcSpan
_ Name
con_name) <- Located RdrName -> RnM (Located Name)
lookupLocatedOccRn Located RdrName
GenLocated SrcSpan (IdP GhcPs)
con_id
; ([LHsRecField GhcRn (LHsExpr GhcPs)]
flds, FreeVars
fvs) <- HsRecFieldContext
-> (SrcSpan -> RdrName -> SrcSpanLess (LHsExpr GhcPs))
-> HsRecordBinds GhcPs
-> RnM ([LHsRecField GhcRn (LHsExpr GhcPs)], FreeVars)
forall arg.
HasSrcSpan arg =>
HsRecFieldContext
-> (SrcSpan -> RdrName -> SrcSpanLess arg)
-> HsRecFields GhcPs arg
-> RnM ([LHsRecField GhcRn arg], FreeVars)
rnHsRecFields (Name -> HsRecFieldContext
HsRecFieldCon Name
con_name) SrcSpan -> RdrName -> SrcSpanLess (LHsExpr GhcPs)
forall p. (XVar p ~ NoExtField) => SrcSpan -> IdP p -> HsExpr p
mk_hs_var HsRecordBinds GhcPs
rec_binds
; ([GenLocated SrcSpan (HsRecField' (FieldOcc GhcRn) (LHsExpr GhcRn))]
flds', [FreeVars]
fvss) <- (LHsRecField GhcRn (LHsExpr GhcPs)
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpan (HsRecField' (FieldOcc GhcRn) (LHsExpr GhcRn)),
FreeVars))
-> [LHsRecField GhcRn (LHsExpr GhcPs)]
-> IOEnv
(Env TcGblEnv TcLclEnv)
([GenLocated
SrcSpan (HsRecField' (FieldOcc GhcRn) (LHsExpr GhcRn))],
[FreeVars])
forall (m :: * -> *) a b c.
Applicative m =>
(a -> m (b, c)) -> [a] -> m ([b], [c])
mapAndUnzipM LHsRecField GhcRn (LHsExpr GhcPs)
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpan (HsRecField' (FieldOcc GhcRn) (LHsExpr GhcRn)),
FreeVars)
forall l id.
GenLocated l (HsRecField' id (LHsExpr GhcPs))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated l (HsRecField' id (LHsExpr GhcRn)), FreeVars)
rn_field [LHsRecField GhcRn (LHsExpr GhcPs)]
flds
; let rec_binds' :: HsRecFields GhcRn (LHsExpr GhcRn)
rec_binds' = HsRecFields :: forall p arg.
[LHsRecField p arg] -> Maybe (Located Int) -> HsRecFields p arg
HsRecFields { rec_flds :: [GenLocated SrcSpan (HsRecField' (FieldOcc GhcRn) (LHsExpr GhcRn))]
rec_flds = [GenLocated SrcSpan (HsRecField' (FieldOcc GhcRn) (LHsExpr GhcRn))]
flds', rec_dotdot :: Maybe (Located Int)
rec_dotdot = Maybe (Located Int)
dd }
; (HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (RecordCon :: forall p.
XRecordCon p -> Located (IdP p) -> HsRecordBinds p -> HsExpr p
RecordCon { rcon_ext :: XRecordCon GhcRn
rcon_ext = XRecordCon GhcRn
NoExtField
noExtField
, rcon_con_name :: Located (IdP GhcRn)
rcon_con_name = Located Name
Located (IdP GhcRn)
con_lname, rcon_flds :: HsRecFields GhcRn (LHsExpr GhcRn)
rcon_flds = HsRecFields GhcRn (LHsExpr GhcRn)
rec_binds' }
, FreeVars
fvs FreeVars -> FreeVars -> FreeVars
`plusFV` [FreeVars] -> FreeVars
plusFVs [FreeVars]
fvss FreeVars -> Name -> FreeVars
`addOneFV` Name
con_name) }
where
mk_hs_var :: SrcSpan -> IdP p -> HsExpr p
mk_hs_var SrcSpan
l IdP p
n = XVar p -> Located (IdP p) -> HsExpr p
forall p. XVar p -> Located (IdP p) -> HsExpr p
HsVar XVar p
NoExtField
noExtField (SrcSpan -> IdP p -> Located (IdP p)
forall l e. l -> e -> GenLocated l e
L SrcSpan
l IdP p
n)
rn_field :: GenLocated l (HsRecField' id (LHsExpr GhcPs))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated l (HsRecField' id (LHsExpr GhcRn)), FreeVars)
rn_field (L l
l HsRecField' id (LHsExpr GhcPs)
fld) = do { (LHsExpr GhcRn
arg', FreeVars
fvs) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr (HsRecField' id (LHsExpr GhcPs) -> LHsExpr GhcPs
forall id arg. HsRecField' id arg -> arg
hsRecFieldArg HsRecField' id (LHsExpr GhcPs)
fld)
; (GenLocated l (HsRecField' id (LHsExpr GhcRn)), FreeVars)
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated l (HsRecField' id (LHsExpr GhcRn)), FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (l
-> HsRecField' id (LHsExpr GhcRn)
-> GenLocated l (HsRecField' id (LHsExpr GhcRn))
forall l e. l -> e -> GenLocated l e
L l
l (HsRecField' id (LHsExpr GhcPs)
fld { hsRecFieldArg :: LHsExpr GhcRn
hsRecFieldArg = LHsExpr GhcRn
arg' }), FreeVars
fvs) }
rnExpr (RecordUpd { rupd_expr :: forall p. HsExpr p -> LHsExpr p
rupd_expr = LHsExpr GhcPs
expr, rupd_flds :: forall p. HsExpr p -> [LHsRecUpdField p]
rupd_flds = [LHsRecUpdField GhcPs]
rbinds })
= do { (LHsExpr GhcRn
expr', FreeVars
fvExpr) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
expr
; ([LHsRecUpdField GhcRn]
rbinds', FreeVars
fvRbinds) <- [LHsRecUpdField GhcPs] -> RnM ([LHsRecUpdField GhcRn], FreeVars)
rnHsRecUpdFields [LHsRecUpdField GhcPs]
rbinds
; (HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (RecordUpd :: forall p.
XRecordUpd p -> LHsExpr p -> [LHsRecUpdField p] -> HsExpr p
RecordUpd { rupd_ext :: XRecordUpd GhcRn
rupd_ext = XRecordUpd GhcRn
NoExtField
noExtField, rupd_expr :: LHsExpr GhcRn
rupd_expr = LHsExpr GhcRn
expr'
, rupd_flds :: [LHsRecUpdField GhcRn]
rupd_flds = [LHsRecUpdField GhcRn]
rbinds' }
, FreeVars
fvExpr FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvRbinds) }
rnExpr (ExprWithTySig XExprWithTySig GhcPs
_ LHsExpr GhcPs
expr LHsSigWcType (NoGhcTc GhcPs)
pty)
= do { (LHsSigWcType GhcRn
pty', FreeVars
fvTy) <- HsSigWcTypeScoping
-> HsDocContext
-> LHsSigWcType GhcPs
-> RnM (LHsSigWcType GhcRn, FreeVars)
rnHsSigWcType HsSigWcTypeScoping
BindUnlessForall HsDocContext
ExprWithTySigCtx LHsSigWcType (NoGhcTc GhcPs)
LHsSigWcType GhcPs
pty
; (LHsExpr GhcRn
expr', FreeVars
fvExpr) <- [Name]
-> RnM (LHsExpr GhcRn, FreeVars) -> RnM (LHsExpr GhcRn, FreeVars)
forall a. [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
bindSigTyVarsFV (LHsSigWcType GhcRn -> [Name]
hsWcScopedTvs LHsSigWcType GhcRn
pty') (RnM (LHsExpr GhcRn, FreeVars) -> RnM (LHsExpr GhcRn, FreeVars))
-> RnM (LHsExpr GhcRn, FreeVars) -> RnM (LHsExpr GhcRn, FreeVars)
forall a b. (a -> b) -> a -> b
$
LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
expr
; (HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XExprWithTySig GhcRn
-> LHsExpr GhcRn -> LHsSigWcType (NoGhcTc GhcRn) -> HsExpr GhcRn
forall p.
XExprWithTySig p
-> LHsExpr p -> LHsSigWcType (NoGhcTc p) -> HsExpr p
ExprWithTySig XExprWithTySig GhcRn
NoExtField
noExtField LHsExpr GhcRn
expr' LHsSigWcType (NoGhcTc GhcRn)
LHsSigWcType GhcRn
pty', FreeVars
fvExpr FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvTy) }
rnExpr (HsIf XIf GhcPs
x Maybe (SyntaxExpr GhcPs)
_ LHsExpr GhcPs
p LHsExpr GhcPs
b1 LHsExpr GhcPs
b2)
= do { (LHsExpr GhcRn
p', FreeVars
fvP) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
p
; (LHsExpr GhcRn
b1', FreeVars
fvB1) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
b1
; (LHsExpr GhcRn
b2', FreeVars
fvB2) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
b2
; (Maybe (SyntaxExpr GhcRn)
mb_ite, FreeVars
fvITE) <- RnM (Maybe (SyntaxExpr GhcRn), FreeVars)
lookupIfThenElse
; (HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XIf GhcRn
-> Maybe (SyntaxExpr GhcRn)
-> LHsExpr GhcRn
-> LHsExpr GhcRn
-> LHsExpr GhcRn
-> HsExpr GhcRn
forall p.
XIf p
-> Maybe (SyntaxExpr p)
-> LHsExpr p
-> LHsExpr p
-> LHsExpr p
-> HsExpr p
HsIf XIf GhcPs
XIf GhcRn
x Maybe (SyntaxExpr GhcRn)
mb_ite LHsExpr GhcRn
p' LHsExpr GhcRn
b1' LHsExpr GhcRn
b2', [FreeVars] -> FreeVars
plusFVs [FreeVars
fvITE, FreeVars
fvP, FreeVars
fvB1, FreeVars
fvB2]) }
rnExpr (HsMultiIf XMultiIf GhcPs
x [LGRHS GhcPs (LHsExpr GhcPs)]
alts)
= do { ([LGRHS GhcRn (LHsExpr GhcRn)]
alts', FreeVars
fvs) <- (LGRHS GhcPs (LHsExpr GhcPs)
-> RnM (LGRHS GhcRn (LHsExpr GhcRn), FreeVars))
-> [LGRHS GhcPs (LHsExpr GhcPs)]
-> RnM ([LGRHS GhcRn (LHsExpr GhcRn)], FreeVars)
forall a b. (a -> RnM (b, FreeVars)) -> [a] -> RnM ([b], FreeVars)
mapFvRn (HsMatchContext Name
-> (LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars))
-> LGRHS GhcPs (LHsExpr GhcPs)
-> RnM (LGRHS GhcRn (LHsExpr GhcRn), FreeVars)
forall (body :: * -> *).
HsMatchContext Name
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> LGRHS GhcPs (Located (body GhcPs))
-> RnM (LGRHS GhcRn (Located (body GhcRn)), FreeVars)
rnGRHS HsMatchContext Name
forall id. HsMatchContext id
IfAlt LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr) [LGRHS GhcPs (LHsExpr GhcPs)]
alts
; (HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XMultiIf GhcRn -> [LGRHS GhcRn (LHsExpr GhcRn)] -> HsExpr GhcRn
forall p. XMultiIf p -> [LGRHS p (LHsExpr p)] -> HsExpr p
HsMultiIf XMultiIf GhcPs
XMultiIf GhcRn
x [LGRHS GhcRn (LHsExpr GhcRn)]
alts', FreeVars
fvs) }
rnExpr (ArithSeq XArithSeq GhcPs
x Maybe (SyntaxExpr GhcPs)
_ ArithSeqInfo GhcPs
seq)
= do { Bool
opt_OverloadedLists <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.OverloadedLists
; (ArithSeqInfo GhcRn
new_seq, FreeVars
fvs) <- ArithSeqInfo GhcPs -> RnM (ArithSeqInfo GhcRn, FreeVars)
rnArithSeq ArithSeqInfo GhcPs
seq
; if Bool
opt_OverloadedLists
then do {
; (SyntaxExpr GhcRn
from_list_name, FreeVars
fvs') <- Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupSyntaxName Name
fromListName
; (HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XArithSeq GhcRn
-> Maybe (SyntaxExpr GhcRn) -> ArithSeqInfo GhcRn -> HsExpr GhcRn
forall p.
XArithSeq p -> Maybe (SyntaxExpr p) -> ArithSeqInfo p -> HsExpr p
ArithSeq XArithSeq GhcPs
XArithSeq GhcRn
x (SyntaxExpr GhcRn -> Maybe (SyntaxExpr GhcRn)
forall a. a -> Maybe a
Just SyntaxExpr GhcRn
from_list_name) ArithSeqInfo GhcRn
new_seq
, FreeVars
fvs FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs') }
else
(HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XArithSeq GhcRn
-> Maybe (SyntaxExpr GhcRn) -> ArithSeqInfo GhcRn -> HsExpr GhcRn
forall p.
XArithSeq p -> Maybe (SyntaxExpr p) -> ArithSeqInfo p -> HsExpr p
ArithSeq XArithSeq GhcPs
XArithSeq GhcRn
x Maybe (SyntaxExpr GhcRn)
forall a. Maybe a
Nothing ArithSeqInfo GhcRn
new_seq, FreeVars
fvs) }
rnExpr e :: HsExpr GhcPs
e@(HsStatic XStatic GhcPs
_ LHsExpr GhcPs
expr) = do
Extension
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall gbl lcl. Extension -> TcRnIf gbl lcl () -> TcRnIf gbl lcl ()
unlessXOptM Extension
LangExt.StaticPointers (IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ())
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$
MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ MsgDoc -> Int -> MsgDoc -> MsgDoc
hang (String -> MsgDoc
text String
"Illegal static expression:" MsgDoc -> MsgDoc -> MsgDoc
<+> HsExpr GhcPs -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr HsExpr GhcPs
e)
Int
2 (String -> MsgDoc
text String
"Use StaticPointers to enable this extension")
(LHsExpr GhcRn
expr',FreeVars
fvExpr) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
expr
ThStage
stage <- TcM ThStage
getStage
case ThStage
stage of
Splice SpliceType
_ -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a b. (a -> b) -> a -> b
$ [MsgDoc] -> MsgDoc
sep
[ String -> MsgDoc
text String
"static forms cannot be used in splices:"
, Int -> MsgDoc -> MsgDoc
nest Int
2 (MsgDoc -> MsgDoc) -> MsgDoc -> MsgDoc
forall a b. (a -> b) -> a -> b
$ HsExpr GhcPs -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr HsExpr GhcPs
e
]
ThStage
_ -> () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Module
mod <- IOEnv (Env TcGblEnv TcLclEnv) Module
forall (m :: * -> *). HasModule m => m Module
getModule
let fvExpr' :: FreeVars
fvExpr' = (Name -> Bool) -> FreeVars -> FreeVars
filterNameSet (Module -> Name -> Bool
nameIsLocalOrFrom Module
mod) FreeVars
fvExpr
(HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XStatic GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn
forall p. XStatic p -> LHsExpr p -> HsExpr p
HsStatic FreeVars
XStatic GhcRn
fvExpr' LHsExpr GhcRn
expr', FreeVars
fvExpr)
rnExpr (HsProc XProc GhcPs
x LPat GhcPs
pat LHsCmdTop GhcPs
body)
= RnM (HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars)
forall a. TcM a -> TcM a
newArrowScope (RnM (HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars))
-> RnM (HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars)
forall a b. (a -> b) -> a -> b
$
HsMatchContext Name
-> LPat GhcPs
-> (LPat GhcRn -> RnM (HsExpr GhcRn, FreeVars))
-> RnM (HsExpr GhcRn, FreeVars)
forall a.
HsMatchContext Name
-> LPat GhcPs
-> (LPat GhcRn -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
rnPat HsMatchContext Name
forall id. HsMatchContext id
ProcExpr LPat GhcPs
pat ((LPat GhcRn -> RnM (HsExpr GhcRn, FreeVars))
-> RnM (HsExpr GhcRn, FreeVars))
-> (LPat GhcRn -> RnM (HsExpr GhcRn, FreeVars))
-> RnM (HsExpr GhcRn, FreeVars)
forall a b. (a -> b) -> a -> b
$ \ LPat GhcRn
pat' -> do
{ (LHsCmdTop GhcRn
body',FreeVars
fvBody) <- LHsCmdTop GhcPs -> RnM (LHsCmdTop GhcRn, FreeVars)
rnCmdTop LHsCmdTop GhcPs
body
; (HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XProc GhcRn -> LPat GhcRn -> LHsCmdTop GhcRn -> HsExpr GhcRn
forall p. XProc p -> LPat p -> LHsCmdTop p -> HsExpr p
HsProc XProc GhcPs
XProc GhcRn
x LPat GhcRn
pat' LHsCmdTop GhcRn
body', FreeVars
fvBody) }
rnExpr HsExpr GhcPs
other = String -> MsgDoc -> RnM (HsExpr GhcRn, FreeVars)
forall a. HasCallStack => String -> MsgDoc -> a
pprPanic String
"rnExpr: unexpected expression" (HsExpr GhcPs -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr HsExpr GhcPs
other)
rnSection :: HsExpr GhcPs -> RnM (HsExpr GhcRn, FreeVars)
rnSection :: HsExpr GhcPs -> RnM (HsExpr GhcRn, FreeVars)
rnSection section :: HsExpr GhcPs
section@(SectionR XSectionR GhcPs
x LHsExpr GhcPs
op LHsExpr GhcPs
expr)
= do { (LHsExpr GhcRn
op', FreeVars
fvs_op) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
op
; (LHsExpr GhcRn
expr', FreeVars
fvs_expr) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
expr
; FixityDirection
-> HsExpr GhcPs
-> LHsExpr GhcRn
-> LHsExpr GhcRn
-> IOEnv (Env TcGblEnv TcLclEnv) ()
checkSectionPrec FixityDirection
InfixR HsExpr GhcPs
section LHsExpr GhcRn
op' LHsExpr GhcRn
expr'
; (HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XSectionR GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn
forall p. XSectionR p -> LHsExpr p -> LHsExpr p -> HsExpr p
SectionR XSectionR GhcPs
XSectionR GhcRn
x LHsExpr GhcRn
op' LHsExpr GhcRn
expr', FreeVars
fvs_op FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs_expr) }
rnSection section :: HsExpr GhcPs
section@(SectionL XSectionL GhcPs
x LHsExpr GhcPs
expr LHsExpr GhcPs
op)
= do { (LHsExpr GhcRn
expr', FreeVars
fvs_expr) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
expr
; (LHsExpr GhcRn
op', FreeVars
fvs_op) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
op
; FixityDirection
-> HsExpr GhcPs
-> LHsExpr GhcRn
-> LHsExpr GhcRn
-> IOEnv (Env TcGblEnv TcLclEnv) ()
checkSectionPrec FixityDirection
InfixL HsExpr GhcPs
section LHsExpr GhcRn
op' LHsExpr GhcRn
expr'
; (HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XSectionL GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn
forall p. XSectionL p -> LHsExpr p -> LHsExpr p -> HsExpr p
SectionL XSectionL GhcPs
XSectionL GhcRn
x LHsExpr GhcRn
expr' LHsExpr GhcRn
op', FreeVars
fvs_op FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs_expr) }
rnSection HsExpr GhcPs
other = String -> MsgDoc -> RnM (HsExpr GhcRn, FreeVars)
forall a. HasCallStack => String -> MsgDoc -> a
pprPanic String
"rnSection" (HsExpr GhcPs -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr HsExpr GhcPs
other)
rnCmdArgs :: [LHsCmdTop GhcPs] -> RnM ([LHsCmdTop GhcRn], FreeVars)
rnCmdArgs :: [LHsCmdTop GhcPs] -> RnM ([LHsCmdTop GhcRn], FreeVars)
rnCmdArgs [] = ([LHsCmdTop GhcRn], FreeVars) -> RnM ([LHsCmdTop GhcRn], FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], FreeVars
emptyFVs)
rnCmdArgs (LHsCmdTop GhcPs
arg:[LHsCmdTop GhcPs]
args)
= do { (LHsCmdTop GhcRn
arg',FreeVars
fvArg) <- LHsCmdTop GhcPs -> RnM (LHsCmdTop GhcRn, FreeVars)
rnCmdTop LHsCmdTop GhcPs
arg
; ([LHsCmdTop GhcRn]
args',FreeVars
fvArgs) <- [LHsCmdTop GhcPs] -> RnM ([LHsCmdTop GhcRn], FreeVars)
rnCmdArgs [LHsCmdTop GhcPs]
args
; ([LHsCmdTop GhcRn], FreeVars) -> RnM ([LHsCmdTop GhcRn], FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsCmdTop GhcRn
arg'LHsCmdTop GhcRn -> [LHsCmdTop GhcRn] -> [LHsCmdTop GhcRn]
forall a. a -> [a] -> [a]
:[LHsCmdTop GhcRn]
args', FreeVars
fvArg FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvArgs) }
rnCmdTop :: LHsCmdTop GhcPs -> RnM (LHsCmdTop GhcRn, FreeVars)
rnCmdTop :: LHsCmdTop GhcPs -> RnM (LHsCmdTop GhcRn, FreeVars)
rnCmdTop = (SrcSpanLess (LHsCmdTop GhcPs)
-> TcM (SrcSpanLess (LHsCmdTop GhcRn), FreeVars))
-> LHsCmdTop GhcPs -> RnM (LHsCmdTop GhcRn, FreeVars)
forall a b c.
(HasSrcSpan a, HasSrcSpan b) =>
(SrcSpanLess a -> TcM (SrcSpanLess b, c)) -> a -> TcM (b, c)
wrapLocFstM SrcSpanLess (LHsCmdTop GhcPs)
-> TcM (SrcSpanLess (LHsCmdTop GhcRn), FreeVars)
HsCmdTop GhcPs
-> IOEnv (Env TcGblEnv TcLclEnv) (HsCmdTop GhcRn, FreeVars)
rnCmdTop'
where
rnCmdTop' :: HsCmdTop GhcPs
-> IOEnv (Env TcGblEnv TcLclEnv) (HsCmdTop GhcRn, FreeVars)
rnCmdTop' (HsCmdTop XCmdTop GhcPs
_ LHsCmd GhcPs
cmd)
= do { (LHsCmd GhcRn
cmd', FreeVars
fvCmd) <- LHsCmd GhcPs -> RnM (LHsCmd GhcRn, FreeVars)
rnLCmd LHsCmd GhcPs
cmd
; let cmd_names :: [Name]
cmd_names = [Name
arrAName, Name
composeAName, Name
firstAName] [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++
FreeVars -> [Name]
nameSetElemsStable (HsCmd GhcRn -> FreeVars
methodNamesCmd (LHsCmd GhcRn -> SrcSpanLess (LHsCmd GhcRn)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc LHsCmd GhcRn
cmd'))
; ([HsExpr GhcRn]
cmd_names', FreeVars
cmd_fvs) <- [Name] -> RnM ([HsExpr GhcRn], FreeVars)
lookupSyntaxNames [Name]
cmd_names
; (HsCmdTop GhcRn, FreeVars)
-> IOEnv (Env TcGblEnv TcLclEnv) (HsCmdTop GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdTop GhcRn -> LHsCmd GhcRn -> HsCmdTop GhcRn
forall p. XCmdTop p -> LHsCmd p -> HsCmdTop p
HsCmdTop ([Name]
cmd_names [Name] -> [HsExpr GhcRn] -> [(Name, HsExpr GhcRn)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [HsExpr GhcRn]
cmd_names') LHsCmd GhcRn
cmd',
FreeVars
fvCmd FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
cmd_fvs) }
rnCmdTop' (XCmdTop XXCmdTop GhcPs
nec) = NoExtCon
-> IOEnv (Env TcGblEnv TcLclEnv) (HsCmdTop GhcRn, FreeVars)
forall a. NoExtCon -> a
noExtCon XXCmdTop GhcPs
NoExtCon
nec
rnLCmd :: LHsCmd GhcPs -> RnM (LHsCmd GhcRn, FreeVars)
rnLCmd :: LHsCmd GhcPs -> RnM (LHsCmd GhcRn, FreeVars)
rnLCmd = (SrcSpanLess (LHsCmd GhcPs)
-> TcM (SrcSpanLess (LHsCmd GhcRn), FreeVars))
-> LHsCmd GhcPs -> RnM (LHsCmd GhcRn, FreeVars)
forall a b c.
(HasSrcSpan a, HasSrcSpan b) =>
(SrcSpanLess a -> TcM (SrcSpanLess b, c)) -> a -> TcM (b, c)
wrapLocFstM SrcSpanLess (LHsCmd GhcPs)
-> TcM (SrcSpanLess (LHsCmd GhcRn), FreeVars)
HsCmd GhcPs -> RnM (HsCmd GhcRn, FreeVars)
rnCmd
rnCmd :: HsCmd GhcPs -> RnM (HsCmd GhcRn, FreeVars)
rnCmd :: HsCmd GhcPs -> RnM (HsCmd GhcRn, FreeVars)
rnCmd (HsCmdArrApp XCmdArrApp GhcPs
x LHsExpr GhcPs
arrow LHsExpr GhcPs
arg HsArrAppType
ho Bool
rtl)
= do { (LHsExpr GhcRn
arrow',FreeVars
fvArrow) <- RnM (LHsExpr GhcRn, FreeVars) -> RnM (LHsExpr GhcRn, FreeVars)
select_arrow_scope (LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
arrow)
; (LHsExpr GhcRn
arg',FreeVars
fvArg) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
arg
; (HsCmd GhcRn, FreeVars) -> RnM (HsCmd GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdArrApp GhcRn
-> LHsExpr GhcRn
-> LHsExpr GhcRn
-> HsArrAppType
-> Bool
-> HsCmd GhcRn
forall id.
XCmdArrApp id
-> LHsExpr id -> LHsExpr id -> HsArrAppType -> Bool -> HsCmd id
HsCmdArrApp XCmdArrApp GhcPs
XCmdArrApp GhcRn
x LHsExpr GhcRn
arrow' LHsExpr GhcRn
arg' HsArrAppType
ho Bool
rtl,
FreeVars
fvArrow FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvArg) }
where
select_arrow_scope :: RnM (LHsExpr GhcRn, FreeVars) -> RnM (LHsExpr GhcRn, FreeVars)
select_arrow_scope RnM (LHsExpr GhcRn, FreeVars)
tc = case HsArrAppType
ho of
HsArrAppType
HsHigherOrderApp -> RnM (LHsExpr GhcRn, FreeVars)
tc
HsArrAppType
HsFirstOrderApp -> RnM (LHsExpr GhcRn, FreeVars) -> RnM (LHsExpr GhcRn, FreeVars)
forall a. TcM a -> TcM a
escapeArrowScope RnM (LHsExpr GhcRn, FreeVars)
tc
rnCmd (HsCmdArrForm XCmdArrForm GhcPs
_ LHsExpr GhcPs
op LexicalFixity
_ (Just Fixity
_) [LHsCmdTop GhcPs
arg1, LHsCmdTop GhcPs
arg2])
= do { (LHsExpr GhcRn
op',FreeVars
fv_op) <- RnM (LHsExpr GhcRn, FreeVars) -> RnM (LHsExpr GhcRn, FreeVars)
forall a. TcM a -> TcM a
escapeArrowScope (LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
op)
; let L SrcSpan
_ (HsVar XVar GhcRn
_ (L SrcSpan
_ IdP GhcRn
op_name)) = LHsExpr GhcRn
op'
; (LHsCmdTop GhcRn
arg1',FreeVars
fv_arg1) <- LHsCmdTop GhcPs -> RnM (LHsCmdTop GhcRn, FreeVars)
rnCmdTop LHsCmdTop GhcPs
arg1
; (LHsCmdTop GhcRn
arg2',FreeVars
fv_arg2) <- LHsCmdTop GhcPs -> RnM (LHsCmdTop GhcRn, FreeVars)
rnCmdTop LHsCmdTop GhcPs
arg2
; Fixity
fixity <- Name -> IOEnv (Env TcGblEnv TcLclEnv) Fixity
lookupFixityRn Name
IdP GhcRn
op_name
; HsCmd GhcRn
final_e <- LHsCmdTop GhcRn
-> LHsExpr GhcRn -> Fixity -> LHsCmdTop GhcRn -> RnM (HsCmd GhcRn)
mkOpFormRn LHsCmdTop GhcRn
arg1' LHsExpr GhcRn
op' Fixity
fixity LHsCmdTop GhcRn
arg2'
; (HsCmd GhcRn, FreeVars) -> RnM (HsCmd GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (HsCmd GhcRn
final_e, FreeVars
fv_arg1 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fv_op FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fv_arg2) }
rnCmd (HsCmdArrForm XCmdArrForm GhcPs
x LHsExpr GhcPs
op LexicalFixity
f Maybe Fixity
fixity [LHsCmdTop GhcPs]
cmds)
= do { (LHsExpr GhcRn
op',FreeVars
fvOp) <- RnM (LHsExpr GhcRn, FreeVars) -> RnM (LHsExpr GhcRn, FreeVars)
forall a. TcM a -> TcM a
escapeArrowScope (LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
op)
; ([LHsCmdTop GhcRn]
cmds',FreeVars
fvCmds) <- [LHsCmdTop GhcPs] -> RnM ([LHsCmdTop GhcRn], FreeVars)
rnCmdArgs [LHsCmdTop GhcPs]
cmds
; (HsCmd GhcRn, FreeVars) -> RnM (HsCmd GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdArrForm GhcRn
-> LHsExpr GhcRn
-> LexicalFixity
-> Maybe Fixity
-> [LHsCmdTop GhcRn]
-> HsCmd GhcRn
forall id.
XCmdArrForm id
-> LHsExpr id
-> LexicalFixity
-> Maybe Fixity
-> [LHsCmdTop id]
-> HsCmd id
HsCmdArrForm XCmdArrForm GhcPs
XCmdArrForm GhcRn
x LHsExpr GhcRn
op' LexicalFixity
f Maybe Fixity
fixity [LHsCmdTop GhcRn]
cmds', FreeVars
fvOp FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvCmds) }
rnCmd (HsCmdApp XCmdApp GhcPs
x LHsCmd GhcPs
fun LHsExpr GhcPs
arg)
= do { (LHsCmd GhcRn
fun',FreeVars
fvFun) <- LHsCmd GhcPs -> RnM (LHsCmd GhcRn, FreeVars)
rnLCmd LHsCmd GhcPs
fun
; (LHsExpr GhcRn
arg',FreeVars
fvArg) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
arg
; (HsCmd GhcRn, FreeVars) -> RnM (HsCmd GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdApp GhcRn -> LHsCmd GhcRn -> LHsExpr GhcRn -> HsCmd GhcRn
forall id. XCmdApp id -> LHsCmd id -> LHsExpr id -> HsCmd id
HsCmdApp XCmdApp GhcPs
XCmdApp GhcRn
x LHsCmd GhcRn
fun' LHsExpr GhcRn
arg', FreeVars
fvFun FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvArg) }
rnCmd (HsCmdLam XCmdLam GhcPs
x MatchGroup GhcPs (LHsCmd GhcPs)
matches)
= do { (MatchGroup GhcRn (LHsCmd GhcRn)
matches', FreeVars
fvMatch) <- HsMatchContext Name
-> (LHsCmd GhcPs -> RnM (LHsCmd GhcRn, FreeVars))
-> MatchGroup GhcPs (LHsCmd GhcPs)
-> RnM (MatchGroup GhcRn (LHsCmd GhcRn), FreeVars)
forall (body :: * -> *).
Outputable (body GhcPs) =>
HsMatchContext Name
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> MatchGroup GhcPs (Located (body GhcPs))
-> RnM (MatchGroup GhcRn (Located (body GhcRn)), FreeVars)
rnMatchGroup HsMatchContext Name
forall id. HsMatchContext id
LambdaExpr LHsCmd GhcPs -> RnM (LHsCmd GhcRn, FreeVars)
rnLCmd MatchGroup GhcPs (LHsCmd GhcPs)
matches
; (HsCmd GhcRn, FreeVars) -> RnM (HsCmd GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdLam GhcRn -> MatchGroup GhcRn (LHsCmd GhcRn) -> HsCmd GhcRn
forall id. XCmdLam id -> MatchGroup id (LHsCmd id) -> HsCmd id
HsCmdLam XCmdLam GhcPs
XCmdLam GhcRn
x MatchGroup GhcRn (LHsCmd GhcRn)
matches', FreeVars
fvMatch) }
rnCmd (HsCmdPar XCmdPar GhcPs
x LHsCmd GhcPs
e)
= do { (LHsCmd GhcRn
e', FreeVars
fvs_e) <- LHsCmd GhcPs -> RnM (LHsCmd GhcRn, FreeVars)
rnLCmd LHsCmd GhcPs
e
; (HsCmd GhcRn, FreeVars) -> RnM (HsCmd GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdPar GhcRn -> LHsCmd GhcRn -> HsCmd GhcRn
forall id. XCmdPar id -> LHsCmd id -> HsCmd id
HsCmdPar XCmdPar GhcPs
XCmdPar GhcRn
x LHsCmd GhcRn
e', FreeVars
fvs_e) }
rnCmd (HsCmdCase XCmdCase GhcPs
x LHsExpr GhcPs
expr MatchGroup GhcPs (LHsCmd GhcPs)
matches)
= do { (LHsExpr GhcRn
new_expr, FreeVars
e_fvs) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
expr
; (MatchGroup GhcRn (LHsCmd GhcRn)
new_matches, FreeVars
ms_fvs) <- HsMatchContext Name
-> (LHsCmd GhcPs -> RnM (LHsCmd GhcRn, FreeVars))
-> MatchGroup GhcPs (LHsCmd GhcPs)
-> RnM (MatchGroup GhcRn (LHsCmd GhcRn), FreeVars)
forall (body :: * -> *).
Outputable (body GhcPs) =>
HsMatchContext Name
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> MatchGroup GhcPs (Located (body GhcPs))
-> RnM (MatchGroup GhcRn (Located (body GhcRn)), FreeVars)
rnMatchGroup HsMatchContext Name
forall id. HsMatchContext id
CaseAlt LHsCmd GhcPs -> RnM (LHsCmd GhcRn, FreeVars)
rnLCmd MatchGroup GhcPs (LHsCmd GhcPs)
matches
; (HsCmd GhcRn, FreeVars) -> RnM (HsCmd GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdCase GhcRn
-> LHsExpr GhcRn -> MatchGroup GhcRn (LHsCmd GhcRn) -> HsCmd GhcRn
forall id.
XCmdCase id -> LHsExpr id -> MatchGroup id (LHsCmd id) -> HsCmd id
HsCmdCase XCmdCase GhcPs
XCmdCase GhcRn
x LHsExpr GhcRn
new_expr MatchGroup GhcRn (LHsCmd GhcRn)
new_matches, FreeVars
e_fvs FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
ms_fvs) }
rnCmd (HsCmdIf XCmdIf GhcPs
x Maybe (SyntaxExpr GhcPs)
_ LHsExpr GhcPs
p LHsCmd GhcPs
b1 LHsCmd GhcPs
b2)
= do { (LHsExpr GhcRn
p', FreeVars
fvP) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
p
; (LHsCmd GhcRn
b1', FreeVars
fvB1) <- LHsCmd GhcPs -> RnM (LHsCmd GhcRn, FreeVars)
rnLCmd LHsCmd GhcPs
b1
; (LHsCmd GhcRn
b2', FreeVars
fvB2) <- LHsCmd GhcPs -> RnM (LHsCmd GhcRn, FreeVars)
rnLCmd LHsCmd GhcPs
b2
; (Maybe (SyntaxExpr GhcRn)
mb_ite, FreeVars
fvITE) <- RnM (Maybe (SyntaxExpr GhcRn), FreeVars)
lookupIfThenElse
; (HsCmd GhcRn, FreeVars) -> RnM (HsCmd GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdIf GhcRn
-> Maybe (SyntaxExpr GhcRn)
-> LHsExpr GhcRn
-> LHsCmd GhcRn
-> LHsCmd GhcRn
-> HsCmd GhcRn
forall id.
XCmdIf id
-> Maybe (SyntaxExpr id)
-> LHsExpr id
-> LHsCmd id
-> LHsCmd id
-> HsCmd id
HsCmdIf XCmdIf GhcPs
XCmdIf GhcRn
x Maybe (SyntaxExpr GhcRn)
mb_ite LHsExpr GhcRn
p' LHsCmd GhcRn
b1' LHsCmd GhcRn
b2', [FreeVars] -> FreeVars
plusFVs [FreeVars
fvITE, FreeVars
fvP, FreeVars
fvB1, FreeVars
fvB2])}
rnCmd (HsCmdLet XCmdLet GhcPs
x (L SrcSpan
l HsLocalBinds GhcPs
binds) LHsCmd GhcPs
cmd)
= HsLocalBinds GhcPs
-> (HsLocalBinds GhcRn -> FreeVars -> RnM (HsCmd GhcRn, FreeVars))
-> RnM (HsCmd GhcRn, FreeVars)
forall result.
HsLocalBinds GhcPs
-> (HsLocalBinds GhcRn -> FreeVars -> RnM (result, FreeVars))
-> RnM (result, FreeVars)
rnLocalBindsAndThen HsLocalBinds GhcPs
binds ((HsLocalBinds GhcRn -> FreeVars -> RnM (HsCmd GhcRn, FreeVars))
-> RnM (HsCmd GhcRn, FreeVars))
-> (HsLocalBinds GhcRn -> FreeVars -> RnM (HsCmd GhcRn, FreeVars))
-> RnM (HsCmd GhcRn, FreeVars)
forall a b. (a -> b) -> a -> b
$ \ HsLocalBinds GhcRn
binds' FreeVars
_ -> do
{ (LHsCmd GhcRn
cmd',FreeVars
fvExpr) <- LHsCmd GhcPs -> RnM (LHsCmd GhcRn, FreeVars)
rnLCmd LHsCmd GhcPs
cmd
; (HsCmd GhcRn, FreeVars) -> RnM (HsCmd GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdLet GhcRn -> LHsLocalBinds GhcRn -> LHsCmd GhcRn -> HsCmd GhcRn
forall id. XCmdLet id -> LHsLocalBinds id -> LHsCmd id -> HsCmd id
HsCmdLet XCmdLet GhcPs
XCmdLet GhcRn
x (SrcSpan -> HsLocalBinds GhcRn -> LHsLocalBinds GhcRn
forall l e. l -> e -> GenLocated l e
L SrcSpan
l HsLocalBinds GhcRn
binds') LHsCmd GhcRn
cmd', FreeVars
fvExpr) }
rnCmd (HsCmdDo XCmdDo GhcPs
x (L SrcSpan
l [CmdLStmt GhcPs]
stmts))
= do { (([LStmt GhcRn (LHsCmd GhcRn)]
stmts', ()
_), FreeVars
fvs) <-
HsStmtContext Name
-> (LHsCmd GhcPs -> RnM (LHsCmd GhcRn, FreeVars))
-> [CmdLStmt GhcPs]
-> ([Name] -> RnM ((), FreeVars))
-> RnM (([LStmt GhcRn (LHsCmd GhcRn)], ()), FreeVars)
forall (body :: * -> *) thing.
Outputable (body GhcPs) =>
HsStmtContext Name
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> [LStmt GhcPs (Located (body GhcPs))]
-> ([Name] -> RnM (thing, FreeVars))
-> RnM (([LStmt GhcRn (Located (body GhcRn))], thing), FreeVars)
rnStmts HsStmtContext Name
forall id. HsStmtContext id
ArrowExpr LHsCmd GhcPs -> RnM (LHsCmd GhcRn, FreeVars)
rnLCmd [CmdLStmt GhcPs]
stmts (\ [Name]
_ -> ((), FreeVars) -> RnM ((), FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return ((), FreeVars
emptyFVs))
; (HsCmd GhcRn, FreeVars) -> RnM (HsCmd GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return ( XCmdDo GhcRn -> Located [LStmt GhcRn (LHsCmd GhcRn)] -> HsCmd GhcRn
forall id. XCmdDo id -> Located [CmdLStmt id] -> HsCmd id
HsCmdDo XCmdDo GhcPs
XCmdDo GhcRn
x (SrcSpan
-> [LStmt GhcRn (LHsCmd GhcRn)]
-> Located [LStmt GhcRn (LHsCmd GhcRn)]
forall l e. l -> e -> GenLocated l e
L SrcSpan
l [LStmt GhcRn (LHsCmd GhcRn)]
stmts'), FreeVars
fvs ) }
rnCmd cmd :: HsCmd GhcPs
cmd@(HsCmdWrap {}) = String -> MsgDoc -> RnM (HsCmd GhcRn, FreeVars)
forall a. HasCallStack => String -> MsgDoc -> a
pprPanic String
"rnCmd" (HsCmd GhcPs -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr HsCmd GhcPs
cmd)
rnCmd (XCmd XXCmd GhcPs
nec) = NoExtCon -> RnM (HsCmd GhcRn, FreeVars)
forall a. NoExtCon -> a
noExtCon XXCmd GhcPs
NoExtCon
nec
type CmdNeeds = FreeVars
methodNamesLCmd :: LHsCmd GhcRn -> CmdNeeds
methodNamesLCmd :: LHsCmd GhcRn -> FreeVars
methodNamesLCmd = HsCmd GhcRn -> FreeVars
methodNamesCmd (HsCmd GhcRn -> FreeVars)
-> (LHsCmd GhcRn -> HsCmd GhcRn) -> LHsCmd GhcRn -> FreeVars
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LHsCmd GhcRn -> HsCmd GhcRn
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc
methodNamesCmd :: HsCmd GhcRn -> CmdNeeds
methodNamesCmd :: HsCmd GhcRn -> FreeVars
methodNamesCmd (HsCmdArrApp XCmdArrApp GhcRn
_ LHsExpr GhcRn
_arrow LHsExpr GhcRn
_arg HsArrAppType
HsFirstOrderApp Bool
_rtl)
= FreeVars
emptyFVs
methodNamesCmd (HsCmdArrApp XCmdArrApp GhcRn
_ LHsExpr GhcRn
_arrow LHsExpr GhcRn
_arg HsArrAppType
HsHigherOrderApp Bool
_rtl)
= Name -> FreeVars
unitFV Name
appAName
methodNamesCmd (HsCmdArrForm {}) = FreeVars
emptyFVs
methodNamesCmd (HsCmdWrap XCmdWrap GhcRn
_ HsWrapper
_ HsCmd GhcRn
cmd) = HsCmd GhcRn -> FreeVars
methodNamesCmd HsCmd GhcRn
cmd
methodNamesCmd (HsCmdPar XCmdPar GhcRn
_ LHsCmd GhcRn
c) = LHsCmd GhcRn -> FreeVars
methodNamesLCmd LHsCmd GhcRn
c
methodNamesCmd (HsCmdIf XCmdIf GhcRn
_ Maybe (SyntaxExpr GhcRn)
_ LHsExpr GhcRn
_ LHsCmd GhcRn
c1 LHsCmd GhcRn
c2)
= LHsCmd GhcRn -> FreeVars
methodNamesLCmd LHsCmd GhcRn
c1 FreeVars -> FreeVars -> FreeVars
`plusFV` LHsCmd GhcRn -> FreeVars
methodNamesLCmd LHsCmd GhcRn
c2 FreeVars -> Name -> FreeVars
`addOneFV` Name
choiceAName
methodNamesCmd (HsCmdLet XCmdLet GhcRn
_ LHsLocalBinds GhcRn
_ LHsCmd GhcRn
c) = LHsCmd GhcRn -> FreeVars
methodNamesLCmd LHsCmd GhcRn
c
methodNamesCmd (HsCmdDo XCmdDo GhcRn
_ (L SrcSpan
_ [LStmt GhcRn (LHsCmd GhcRn)]
stmts)) = [LStmt GhcRn (LHsCmd GhcRn)] -> FreeVars
methodNamesStmts [LStmt GhcRn (LHsCmd GhcRn)]
stmts
methodNamesCmd (HsCmdApp XCmdApp GhcRn
_ LHsCmd GhcRn
c LHsExpr GhcRn
_) = LHsCmd GhcRn -> FreeVars
methodNamesLCmd LHsCmd GhcRn
c
methodNamesCmd (HsCmdLam XCmdLam GhcRn
_ MatchGroup GhcRn (LHsCmd GhcRn)
match) = MatchGroup GhcRn (LHsCmd GhcRn) -> FreeVars
methodNamesMatch MatchGroup GhcRn (LHsCmd GhcRn)
match
methodNamesCmd (HsCmdCase XCmdCase GhcRn
_ LHsExpr GhcRn
_ MatchGroup GhcRn (LHsCmd GhcRn)
matches)
= MatchGroup GhcRn (LHsCmd GhcRn) -> FreeVars
methodNamesMatch MatchGroup GhcRn (LHsCmd GhcRn)
matches FreeVars -> Name -> FreeVars
`addOneFV` Name
choiceAName
methodNamesCmd (XCmd XXCmd GhcRn
nec) = NoExtCon -> FreeVars
forall a. NoExtCon -> a
noExtCon XXCmd GhcRn
NoExtCon
nec
methodNamesMatch :: MatchGroup GhcRn (LHsCmd GhcRn) -> FreeVars
methodNamesMatch :: MatchGroup GhcRn (LHsCmd GhcRn) -> FreeVars
methodNamesMatch (MG { mg_alts :: forall p body. MatchGroup p body -> Located [LMatch p body]
mg_alts = L SrcSpan
_ [LMatch GhcRn (LHsCmd GhcRn)]
ms })
= [FreeVars] -> FreeVars
plusFVs ((LMatch GhcRn (LHsCmd GhcRn) -> FreeVars)
-> [LMatch GhcRn (LHsCmd GhcRn)] -> [FreeVars]
forall a b. (a -> b) -> [a] -> [b]
map LMatch GhcRn (LHsCmd GhcRn) -> FreeVars
forall l. GenLocated l (Match GhcRn (LHsCmd GhcRn)) -> FreeVars
do_one [LMatch GhcRn (LHsCmd GhcRn)]
ms)
where
do_one :: GenLocated l (Match GhcRn (LHsCmd GhcRn)) -> FreeVars
do_one (L l
_ (Match { m_grhss :: forall p body. Match p body -> GRHSs p body
m_grhss = GRHSs GhcRn (LHsCmd GhcRn)
grhss })) = GRHSs GhcRn (LHsCmd GhcRn) -> FreeVars
methodNamesGRHSs GRHSs GhcRn (LHsCmd GhcRn)
grhss
do_one (L l
_ (XMatch XXMatch GhcRn (LHsCmd GhcRn)
nec)) = NoExtCon -> FreeVars
forall a. NoExtCon -> a
noExtCon XXMatch GhcRn (LHsCmd GhcRn)
NoExtCon
nec
methodNamesMatch (XMatchGroup XXMatchGroup GhcRn (LHsCmd GhcRn)
nec) = NoExtCon -> FreeVars
forall a. NoExtCon -> a
noExtCon XXMatchGroup GhcRn (LHsCmd GhcRn)
NoExtCon
nec
methodNamesGRHSs :: GRHSs GhcRn (LHsCmd GhcRn) -> FreeVars
methodNamesGRHSs :: GRHSs GhcRn (LHsCmd GhcRn) -> FreeVars
methodNamesGRHSs (GRHSs XCGRHSs GhcRn (LHsCmd GhcRn)
_ [LGRHS GhcRn (LHsCmd GhcRn)]
grhss LHsLocalBinds GhcRn
_) = [FreeVars] -> FreeVars
plusFVs ((LGRHS GhcRn (LHsCmd GhcRn) -> FreeVars)
-> [LGRHS GhcRn (LHsCmd GhcRn)] -> [FreeVars]
forall a b. (a -> b) -> [a] -> [b]
map LGRHS GhcRn (LHsCmd GhcRn) -> FreeVars
methodNamesGRHS [LGRHS GhcRn (LHsCmd GhcRn)]
grhss)
methodNamesGRHSs (XGRHSs XXGRHSs GhcRn (LHsCmd GhcRn)
nec) = NoExtCon -> FreeVars
forall a. NoExtCon -> a
noExtCon XXGRHSs GhcRn (LHsCmd GhcRn)
NoExtCon
nec
methodNamesGRHS :: Located (GRHS GhcRn (LHsCmd GhcRn)) -> CmdNeeds
methodNamesGRHS :: LGRHS GhcRn (LHsCmd GhcRn) -> FreeVars
methodNamesGRHS (L SrcSpan
_ (GRHS XCGRHS GhcRn (LHsCmd GhcRn)
_ [LStmt GhcRn (LHsExpr GhcRn)]
_ LHsCmd GhcRn
rhs)) = LHsCmd GhcRn -> FreeVars
methodNamesLCmd LHsCmd GhcRn
rhs
methodNamesGRHS (L SrcSpan
_ (XGRHS XXGRHS GhcRn (LHsCmd GhcRn)
nec)) = NoExtCon -> FreeVars
forall a. NoExtCon -> a
noExtCon XXGRHS GhcRn (LHsCmd GhcRn)
NoExtCon
nec
methodNamesStmts :: [Located (StmtLR GhcRn GhcRn (LHsCmd GhcRn))] -> FreeVars
methodNamesStmts :: [LStmt GhcRn (LHsCmd GhcRn)] -> FreeVars
methodNamesStmts [LStmt GhcRn (LHsCmd GhcRn)]
stmts = [FreeVars] -> FreeVars
plusFVs ((LStmt GhcRn (LHsCmd GhcRn) -> FreeVars)
-> [LStmt GhcRn (LHsCmd GhcRn)] -> [FreeVars]
forall a b. (a -> b) -> [a] -> [b]
map LStmt GhcRn (LHsCmd GhcRn) -> FreeVars
methodNamesLStmt [LStmt GhcRn (LHsCmd GhcRn)]
stmts)
methodNamesLStmt :: Located (StmtLR GhcRn GhcRn (LHsCmd GhcRn)) -> FreeVars
methodNamesLStmt :: LStmt GhcRn (LHsCmd GhcRn) -> FreeVars
methodNamesLStmt = StmtLR GhcRn GhcRn (LHsCmd GhcRn) -> FreeVars
methodNamesStmt (StmtLR GhcRn GhcRn (LHsCmd GhcRn) -> FreeVars)
-> (LStmt GhcRn (LHsCmd GhcRn)
-> StmtLR GhcRn GhcRn (LHsCmd GhcRn))
-> LStmt GhcRn (LHsCmd GhcRn)
-> FreeVars
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LStmt GhcRn (LHsCmd GhcRn) -> StmtLR GhcRn GhcRn (LHsCmd GhcRn)
forall a. HasSrcSpan a => a -> SrcSpanLess a
unLoc
methodNamesStmt :: StmtLR GhcRn GhcRn (LHsCmd GhcRn) -> FreeVars
methodNamesStmt :: StmtLR GhcRn GhcRn (LHsCmd GhcRn) -> FreeVars
methodNamesStmt (LastStmt XLastStmt GhcRn GhcRn (LHsCmd GhcRn)
_ LHsCmd GhcRn
cmd Bool
_ SyntaxExpr GhcRn
_) = LHsCmd GhcRn -> FreeVars
methodNamesLCmd LHsCmd GhcRn
cmd
methodNamesStmt (BodyStmt XBodyStmt GhcRn GhcRn (LHsCmd GhcRn)
_ LHsCmd GhcRn
cmd SyntaxExpr GhcRn
_ SyntaxExpr GhcRn
_) = LHsCmd GhcRn -> FreeVars
methodNamesLCmd LHsCmd GhcRn
cmd
methodNamesStmt (BindStmt XBindStmt GhcRn GhcRn (LHsCmd GhcRn)
_ LPat GhcRn
_ LHsCmd GhcRn
cmd SyntaxExpr GhcRn
_ SyntaxExpr GhcRn
_) = LHsCmd GhcRn -> FreeVars
methodNamesLCmd LHsCmd GhcRn
cmd
methodNamesStmt (RecStmt { recS_stmts :: forall idL idR body. StmtLR idL idR body -> [LStmtLR idL idR body]
recS_stmts = [LStmt GhcRn (LHsCmd GhcRn)]
stmts }) =
[LStmt GhcRn (LHsCmd GhcRn)] -> FreeVars
methodNamesStmts [LStmt GhcRn (LHsCmd GhcRn)]
stmts FreeVars -> Name -> FreeVars
`addOneFV` Name
loopAName
methodNamesStmt (LetStmt {}) = FreeVars
emptyFVs
methodNamesStmt (ParStmt {}) = FreeVars
emptyFVs
methodNamesStmt (TransStmt {}) = FreeVars
emptyFVs
methodNamesStmt ApplicativeStmt{} = FreeVars
emptyFVs
methodNamesStmt (XStmtLR XXStmtLR GhcRn GhcRn (LHsCmd GhcRn)
nec) = NoExtCon -> FreeVars
forall a. NoExtCon -> a
noExtCon XXStmtLR GhcRn GhcRn (LHsCmd GhcRn)
NoExtCon
nec
rnArithSeq :: ArithSeqInfo GhcPs -> RnM (ArithSeqInfo GhcRn, FreeVars)
rnArithSeq :: ArithSeqInfo GhcPs -> RnM (ArithSeqInfo GhcRn, FreeVars)
rnArithSeq (From LHsExpr GhcPs
expr)
= do { (LHsExpr GhcRn
expr', FreeVars
fvExpr) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
expr
; (ArithSeqInfo GhcRn, FreeVars)
-> RnM (ArithSeqInfo GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsExpr GhcRn -> ArithSeqInfo GhcRn
forall id. LHsExpr id -> ArithSeqInfo id
From LHsExpr GhcRn
expr', FreeVars
fvExpr) }
rnArithSeq (FromThen LHsExpr GhcPs
expr1 LHsExpr GhcPs
expr2)
= do { (LHsExpr GhcRn
expr1', FreeVars
fvExpr1) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
expr1
; (LHsExpr GhcRn
expr2', FreeVars
fvExpr2) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
expr2
; (ArithSeqInfo GhcRn, FreeVars)
-> RnM (ArithSeqInfo GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsExpr GhcRn -> LHsExpr GhcRn -> ArithSeqInfo GhcRn
forall id. LHsExpr id -> LHsExpr id -> ArithSeqInfo id
FromThen LHsExpr GhcRn
expr1' LHsExpr GhcRn
expr2', FreeVars
fvExpr1 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvExpr2) }
rnArithSeq (FromTo LHsExpr GhcPs
expr1 LHsExpr GhcPs
expr2)
= do { (LHsExpr GhcRn
expr1', FreeVars
fvExpr1) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
expr1
; (LHsExpr GhcRn
expr2', FreeVars
fvExpr2) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
expr2
; (ArithSeqInfo GhcRn, FreeVars)
-> RnM (ArithSeqInfo GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsExpr GhcRn -> LHsExpr GhcRn -> ArithSeqInfo GhcRn
forall id. LHsExpr id -> LHsExpr id -> ArithSeqInfo id
FromTo LHsExpr GhcRn
expr1' LHsExpr GhcRn
expr2', FreeVars
fvExpr1 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvExpr2) }
rnArithSeq (FromThenTo LHsExpr GhcPs
expr1 LHsExpr GhcPs
expr2 LHsExpr GhcPs
expr3)
= do { (LHsExpr GhcRn
expr1', FreeVars
fvExpr1) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
expr1
; (LHsExpr GhcRn
expr2', FreeVars
fvExpr2) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
expr2
; (LHsExpr GhcRn
expr3', FreeVars
fvExpr3) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
expr3
; (ArithSeqInfo GhcRn, FreeVars)
-> RnM (ArithSeqInfo GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (LHsExpr GhcRn
-> LHsExpr GhcRn -> LHsExpr GhcRn -> ArithSeqInfo GhcRn
forall id.
LHsExpr id -> LHsExpr id -> LHsExpr id -> ArithSeqInfo id
FromThenTo LHsExpr GhcRn
expr1' LHsExpr GhcRn
expr2' LHsExpr GhcRn
expr3',
[FreeVars] -> FreeVars
plusFVs [FreeVars
fvExpr1, FreeVars
fvExpr2, FreeVars
fvExpr3]) }
rnStmts :: Outputable (body GhcPs)
=> HsStmtContext Name
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> [LStmt GhcPs (Located (body GhcPs))]
-> ([Name] -> RnM (thing, FreeVars))
-> RnM (([LStmt GhcRn (Located (body GhcRn))], thing), FreeVars)
rnStmts :: HsStmtContext Name
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> [LStmt GhcPs (Located (body GhcPs))]
-> ([Name] -> RnM (thing, FreeVars))
-> RnM (([LStmt GhcRn (Located (body GhcRn))], thing), FreeVars)
rnStmts HsStmtContext Name
ctxt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody = HsStmtContext Name
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> (HsStmtContext Name
-> [(LStmt GhcRn (Located (body GhcRn)), FreeVars)]
-> RnM ([LStmt GhcRn (Located (body GhcRn))], FreeVars))
-> [LStmt GhcPs (Located (body GhcPs))]
-> ([Name] -> RnM (thing, FreeVars))
-> RnM (([LStmt GhcRn (Located (body GhcRn))], thing), FreeVars)
forall (body :: * -> *) thing.
Outputable (body GhcPs) =>
HsStmtContext Name
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> (HsStmtContext Name
-> [(LStmt GhcRn (Located (body GhcRn)), FreeVars)]
-> RnM ([LStmt GhcRn (Located (body GhcRn))], FreeVars))
-> [LStmt GhcPs (Located (body GhcPs))]
-> ([Name] -> RnM (thing, FreeVars))
-> RnM (([LStmt GhcRn (Located (body GhcRn))], thing), FreeVars)
rnStmtsWithPostProcessing HsStmtContext Name
ctxt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody HsStmtContext Name
-> [(LStmt GhcRn (Located (body GhcRn)), FreeVars)]
-> RnM ([LStmt GhcRn (Located (body GhcRn))], FreeVars)
forall (body :: * -> *).
HsStmtContext Name
-> [(LStmt GhcRn (Located (body GhcRn)), FreeVars)]
-> RnM ([LStmt GhcRn (Located (body GhcRn))], FreeVars)
noPostProcessStmts
rnStmtsWithPostProcessing
:: Outputable (body GhcPs)
=> HsStmtContext Name
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> (HsStmtContext Name
-> [(LStmt GhcRn (Located (body GhcRn)), FreeVars)]
-> RnM ([LStmt GhcRn (Located (body GhcRn))], FreeVars))
-> [LStmt GhcPs (Located (body GhcPs))]
-> ([Name] -> RnM (thing, FreeVars))
-> RnM (([LStmt GhcRn (Located (body GhcRn))], thing), FreeVars)
rnStmtsWithPostProcessing :: HsStmtContext Name
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> (HsStmtContext Name
-> [(LStmt GhcRn (Located (body GhcRn)), FreeVars)]
-> RnM ([LStmt GhcRn (Located (body GhcRn))], FreeVars))
-> [LStmt GhcPs (Located (body GhcPs))]
-> ([Name] -> RnM (thing, FreeVars))
-> RnM (([LStmt GhcRn (Located (body GhcRn))], thing), FreeVars)
rnStmtsWithPostProcessing HsStmtContext Name
ctxt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody HsStmtContext Name
-> [(LStmt GhcRn (Located (body GhcRn)), FreeVars)]
-> RnM ([LStmt GhcRn (Located (body GhcRn))], FreeVars)
ppStmts [LStmt GhcPs (Located (body GhcPs))]
stmts [Name] -> RnM (thing, FreeVars)
thing_inside
= do { (([(LStmt GhcRn (Located (body GhcRn)), FreeVars)]
stmts', thing
thing), FreeVars
fvs) <-
HsStmtContext Name
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> [LStmt GhcPs (Located (body GhcPs))]
-> ([Name] -> RnM (thing, FreeVars))
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars)
forall (body :: * -> *) thing.
Outputable (body GhcPs) =>
HsStmtContext Name
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> [LStmt GhcPs (Located (body GhcPs))]
-> ([Name] -> RnM (thing, FreeVars))
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars)
rnStmtsWithFreeVars HsStmtContext Name
ctxt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody [LStmt GhcPs (Located (body GhcPs))]
stmts [Name] -> RnM (thing, FreeVars)
thing_inside
; ([LStmt GhcRn (Located (body GhcRn))]
pp_stmts, FreeVars
fvs') <- HsStmtContext Name
-> [(LStmt GhcRn (Located (body GhcRn)), FreeVars)]
-> RnM ([LStmt GhcRn (Located (body GhcRn))], FreeVars)
ppStmts HsStmtContext Name
ctxt [(LStmt GhcRn (Located (body GhcRn)), FreeVars)]
stmts'
; (([LStmt GhcRn (Located (body GhcRn))], thing), FreeVars)
-> RnM (([LStmt GhcRn (Located (body GhcRn))], thing), FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (([LStmt GhcRn (Located (body GhcRn))]
pp_stmts, thing
thing), FreeVars
fvs FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs')
}
postProcessStmtsForApplicativeDo
:: HsStmtContext Name
-> [(ExprLStmt GhcRn, FreeVars)]
-> RnM ([ExprLStmt GhcRn], FreeVars)
postProcessStmtsForApplicativeDo :: HsStmtContext Name
-> [(LStmt GhcRn (LHsExpr GhcRn), FreeVars)]
-> RnM ([LStmt GhcRn (LHsExpr GhcRn)], FreeVars)
postProcessStmtsForApplicativeDo HsStmtContext Name
ctxt [(LStmt GhcRn (LHsExpr GhcRn), FreeVars)]
stmts
= do {
Bool
ado_is_on <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.ApplicativeDo
; let is_do_expr :: Bool
is_do_expr | HsStmtContext Name
DoExpr <- HsStmtContext Name
ctxt = Bool
True
| Bool
otherwise = Bool
False
; Bool
in_th_bracket <- ThStage -> Bool
isBrackStage (ThStage -> Bool) -> TcM ThStage -> TcRnIf TcGblEnv TcLclEnv Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TcM ThStage
getStage
; if Bool
ado_is_on Bool -> Bool -> Bool
&& Bool
is_do_expr Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
in_th_bracket
then do { String -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"ppsfa" ([(LStmt GhcRn (LHsExpr GhcRn), FreeVars)] -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr [(LStmt GhcRn (LHsExpr GhcRn), FreeVars)]
stmts)
; HsStmtContext Name
-> [(LStmt GhcRn (LHsExpr GhcRn), FreeVars)]
-> RnM ([LStmt GhcRn (LHsExpr GhcRn)], FreeVars)
rearrangeForApplicativeDo HsStmtContext Name
ctxt [(LStmt GhcRn (LHsExpr GhcRn), FreeVars)]
stmts }
else HsStmtContext Name
-> [(LStmt GhcRn (LHsExpr GhcRn), FreeVars)]
-> RnM ([LStmt GhcRn (LHsExpr GhcRn)], FreeVars)
forall (body :: * -> *).
HsStmtContext Name
-> [(LStmt GhcRn (Located (body GhcRn)), FreeVars)]
-> RnM ([LStmt GhcRn (Located (body GhcRn))], FreeVars)
noPostProcessStmts HsStmtContext Name
ctxt [(LStmt GhcRn (LHsExpr GhcRn), FreeVars)]
stmts }
noPostProcessStmts
:: HsStmtContext Name
-> [(LStmt GhcRn (Located (body GhcRn)), FreeVars)]
-> RnM ([LStmt GhcRn (Located (body GhcRn))], FreeVars)
noPostProcessStmts :: HsStmtContext Name
-> [(LStmt GhcRn (Located (body GhcRn)), FreeVars)]
-> RnM ([LStmt GhcRn (Located (body GhcRn))], FreeVars)
noPostProcessStmts HsStmtContext Name
_ [(LStmt GhcRn (Located (body GhcRn)), FreeVars)]
stmts = ([LStmt GhcRn (Located (body GhcRn))], FreeVars)
-> RnM ([LStmt GhcRn (Located (body GhcRn))], FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (((LStmt GhcRn (Located (body GhcRn)), FreeVars)
-> LStmt GhcRn (Located (body GhcRn)))
-> [(LStmt GhcRn (Located (body GhcRn)), FreeVars)]
-> [LStmt GhcRn (Located (body GhcRn))]
forall a b. (a -> b) -> [a] -> [b]
map (LStmt GhcRn (Located (body GhcRn)), FreeVars)
-> LStmt GhcRn (Located (body GhcRn))
forall a b. (a, b) -> a
fst [(LStmt GhcRn (Located (body GhcRn)), FreeVars)]
stmts, FreeVars
emptyNameSet)
rnStmtsWithFreeVars :: Outputable (body GhcPs)
=> HsStmtContext Name
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> [LStmt GhcPs (Located (body GhcPs))]
-> ([Name] -> RnM (thing, FreeVars))
-> RnM ( ([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing)
, FreeVars)
rnStmtsWithFreeVars :: HsStmtContext Name
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> [LStmt GhcPs (Located (body GhcPs))]
-> ([Name] -> RnM (thing, FreeVars))
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars)
rnStmtsWithFreeVars HsStmtContext Name
ctxt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
_ [] [Name] -> RnM (thing, FreeVars)
thing_inside
= do { HsStmtContext Name -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkEmptyStmts HsStmtContext Name
ctxt
; (thing
thing, FreeVars
fvs) <- [Name] -> RnM (thing, FreeVars)
thing_inside []
; (([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars)
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (([], thing
thing), FreeVars
fvs) }
rnStmtsWithFreeVars HsStmtContext Name
MDoExpr Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody [LStmt GhcPs (Located (body GhcPs))]
stmts [Name] -> RnM (thing, FreeVars)
thing_inside
=
do { (([(LStmt GhcRn (Located (body GhcRn)), FreeVars)]
stmts1, ([(LStmt GhcRn (Located (body GhcRn)), FreeVars)]
stmts2, thing
thing)), FreeVars
fvs)
<- HsStmtContext Name
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> LStmt GhcPs (Located (body GhcPs))
-> ([Name]
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars))
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)],
([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing)),
FreeVars)
forall (body :: * -> *) thing.
Outputable (body GhcPs) =>
HsStmtContext Name
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> LStmt GhcPs (Located (body GhcPs))
-> ([Name] -> RnM (thing, FreeVars))
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars)
rnStmt HsStmtContext Name
forall id. HsStmtContext id
MDoExpr Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody (SrcSpanLess (LStmt GhcPs (Located (body GhcPs)))
-> LStmt GhcPs (Located (body GhcPs))
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc (SrcSpanLess (LStmt GhcPs (Located (body GhcPs)))
-> LStmt GhcPs (Located (body GhcPs)))
-> SrcSpanLess (LStmt GhcPs (Located (body GhcPs)))
-> LStmt GhcPs (Located (body GhcPs))
forall a b. (a -> b) -> a -> b
$ [LStmt GhcPs (Located (body GhcPs))]
-> StmtLR GhcPs GhcPs (Located (body GhcPs))
forall (idL :: Pass) bodyR.
[LStmtLR (GhcPass idL) GhcPs bodyR]
-> StmtLR (GhcPass idL) GhcPs bodyR
mkRecStmt [LStmt GhcPs (Located (body GhcPs))]
all_but_last) (([Name]
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars))
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)],
([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing)),
FreeVars))
-> ([Name]
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars))
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)],
([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing)),
FreeVars)
forall a b. (a -> b) -> a -> b
$ \ [Name]
_ ->
do { LStmt GhcPs (Located (body GhcPs))
last_stmt' <- HsStmtContext Name
-> LStmt GhcPs (Located (body GhcPs))
-> RnM (LStmt GhcPs (Located (body GhcPs)))
forall (body :: * -> *).
Outputable (body GhcPs) =>
HsStmtContext Name
-> LStmt GhcPs (Located (body GhcPs))
-> RnM (LStmt GhcPs (Located (body GhcPs)))
checkLastStmt HsStmtContext Name
forall id. HsStmtContext id
MDoExpr LStmt GhcPs (Located (body GhcPs))
last_stmt
; HsStmtContext Name
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> LStmt GhcPs (Located (body GhcPs))
-> ([Name] -> RnM (thing, FreeVars))
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars)
forall (body :: * -> *) thing.
Outputable (body GhcPs) =>
HsStmtContext Name
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> LStmt GhcPs (Located (body GhcPs))
-> ([Name] -> RnM (thing, FreeVars))
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars)
rnStmt HsStmtContext Name
forall id. HsStmtContext id
MDoExpr Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody LStmt GhcPs (Located (body GhcPs))
last_stmt' [Name] -> RnM (thing, FreeVars)
thing_inside }
; (([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars)
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return ((([(LStmt GhcRn (Located (body GhcRn)), FreeVars)]
stmts1 [(LStmt GhcRn (Located (body GhcRn)), FreeVars)]
-> [(LStmt GhcRn (Located (body GhcRn)), FreeVars)]
-> [(LStmt GhcRn (Located (body GhcRn)), FreeVars)]
forall a. [a] -> [a] -> [a]
++ [(LStmt GhcRn (Located (body GhcRn)), FreeVars)]
stmts2), thing
thing), FreeVars
fvs) }
where
Just ([LStmt GhcPs (Located (body GhcPs))]
all_but_last, LStmt GhcPs (Located (body GhcPs))
last_stmt) = [LStmt GhcPs (Located (body GhcPs))]
-> Maybe
([LStmt GhcPs (Located (body GhcPs))],
LStmt GhcPs (Located (body GhcPs)))
forall a. [a] -> Maybe ([a], a)
snocView [LStmt GhcPs (Located (body GhcPs))]
stmts
rnStmtsWithFreeVars HsStmtContext Name
ctxt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody (lstmt :: LStmt GhcPs (Located (body GhcPs))
lstmt@(L SrcSpan
loc StmtLR GhcPs GhcPs (Located (body GhcPs))
_) : [LStmt GhcPs (Located (body GhcPs))]
lstmts) [Name] -> RnM (thing, FreeVars)
thing_inside
| [LStmt GhcPs (Located (body GhcPs))] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [LStmt GhcPs (Located (body GhcPs))]
lstmts
= SrcSpan
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars)
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars)
forall a. SrcSpan -> TcRn a -> TcRn a
setSrcSpan SrcSpan
loc (RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars)
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars))
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars)
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars)
forall a b. (a -> b) -> a -> b
$
do { LStmt GhcPs (Located (body GhcPs))
lstmt' <- HsStmtContext Name
-> LStmt GhcPs (Located (body GhcPs))
-> RnM (LStmt GhcPs (Located (body GhcPs)))
forall (body :: * -> *).
Outputable (body GhcPs) =>
HsStmtContext Name
-> LStmt GhcPs (Located (body GhcPs))
-> RnM (LStmt GhcPs (Located (body GhcPs)))
checkLastStmt HsStmtContext Name
ctxt LStmt GhcPs (Located (body GhcPs))
lstmt
; HsStmtContext Name
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> LStmt GhcPs (Located (body GhcPs))
-> ([Name] -> RnM (thing, FreeVars))
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars)
forall (body :: * -> *) thing.
Outputable (body GhcPs) =>
HsStmtContext Name
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> LStmt GhcPs (Located (body GhcPs))
-> ([Name] -> RnM (thing, FreeVars))
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars)
rnStmt HsStmtContext Name
ctxt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody LStmt GhcPs (Located (body GhcPs))
lstmt' [Name] -> RnM (thing, FreeVars)
thing_inside }
| Bool
otherwise
= do { (([(LStmt GhcRn (Located (body GhcRn)), FreeVars)]
stmts1, ([(LStmt GhcRn (Located (body GhcRn)), FreeVars)]
stmts2, thing
thing)), FreeVars
fvs)
<- SrcSpan
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)],
([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing)),
FreeVars)
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)],
([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing)),
FreeVars)
forall a. SrcSpan -> TcRn a -> TcRn a
setSrcSpan SrcSpan
loc (RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)],
([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing)),
FreeVars)
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)],
([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing)),
FreeVars))
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)],
([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing)),
FreeVars)
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)],
([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing)),
FreeVars)
forall a b. (a -> b) -> a -> b
$
do { HsStmtContext Name
-> LStmt GhcPs (Located (body GhcPs))
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (body :: * -> *).
HsStmtContext Name
-> LStmt GhcPs (Located (body GhcPs))
-> IOEnv (Env TcGblEnv TcLclEnv) ()
checkStmt HsStmtContext Name
ctxt LStmt GhcPs (Located (body GhcPs))
lstmt
; HsStmtContext Name
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> LStmt GhcPs (Located (body GhcPs))
-> ([Name]
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars))
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)],
([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing)),
FreeVars)
forall (body :: * -> *) thing.
Outputable (body GhcPs) =>
HsStmtContext Name
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> LStmt GhcPs (Located (body GhcPs))
-> ([Name] -> RnM (thing, FreeVars))
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars)
rnStmt HsStmtContext Name
ctxt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody LStmt GhcPs (Located (body GhcPs))
lstmt (([Name]
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars))
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)],
([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing)),
FreeVars))
-> ([Name]
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars))
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)],
([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing)),
FreeVars)
forall a b. (a -> b) -> a -> b
$ \ [Name]
bndrs1 ->
HsStmtContext Name
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> [LStmt GhcPs (Located (body GhcPs))]
-> ([Name] -> RnM (thing, FreeVars))
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars)
forall (body :: * -> *) thing.
Outputable (body GhcPs) =>
HsStmtContext Name
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> [LStmt GhcPs (Located (body GhcPs))]
-> ([Name] -> RnM (thing, FreeVars))
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars)
rnStmtsWithFreeVars HsStmtContext Name
ctxt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody [LStmt GhcPs (Located (body GhcPs))]
lstmts (([Name] -> RnM (thing, FreeVars))
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars))
-> ([Name] -> RnM (thing, FreeVars))
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars)
forall a b. (a -> b) -> a -> b
$ \ [Name]
bndrs2 ->
[Name] -> RnM (thing, FreeVars)
thing_inside ([Name]
bndrs1 [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name]
bndrs2) }
; (([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars)
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return ((([(LStmt GhcRn (Located (body GhcRn)), FreeVars)]
stmts1 [(LStmt GhcRn (Located (body GhcRn)), FreeVars)]
-> [(LStmt GhcRn (Located (body GhcRn)), FreeVars)]
-> [(LStmt GhcRn (Located (body GhcRn)), FreeVars)]
forall a. [a] -> [a] -> [a]
++ [(LStmt GhcRn (Located (body GhcRn)), FreeVars)]
stmts2), thing
thing), FreeVars
fvs) }
rnStmt :: Outputable (body GhcPs)
=> HsStmtContext Name
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> LStmt GhcPs (Located (body GhcPs))
-> ([Name] -> RnM (thing, FreeVars))
-> RnM ( ([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing)
, FreeVars)
rnStmt :: HsStmtContext Name
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> LStmt GhcPs (Located (body GhcPs))
-> ([Name] -> RnM (thing, FreeVars))
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars)
rnStmt HsStmtContext Name
ctxt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody (L SrcSpan
loc (LastStmt XLastStmt GhcPs GhcPs (Located (body GhcPs))
_ Located (body GhcPs)
body Bool
noret SyntaxExpr GhcPs
_)) [Name] -> RnM (thing, FreeVars)
thing_inside
= do { (Located (body GhcRn)
body', FreeVars
fv_expr) <- Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody Located (body GhcPs)
body
; (SyntaxExpr GhcRn
ret_op, FreeVars
fvs1) <- if HsStmtContext Name -> Bool
forall id. HsStmtContext id -> Bool
isMonadCompContext HsStmtContext Name
ctxt
then HsStmtContext Name -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupStmtName HsStmtContext Name
ctxt Name
returnMName
else (SyntaxExpr GhcRn, FreeVars) -> RnM (SyntaxExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (SyntaxExpr GhcRn
forall (p :: Pass). SyntaxExpr (GhcPass p)
noSyntaxExpr, FreeVars
emptyFVs)
; (thing
thing, FreeVars
fvs3) <- [Name] -> RnM (thing, FreeVars)
thing_inside []
; (([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars)
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (([(SrcSpan
-> StmtLR GhcRn GhcRn (Located (body GhcRn))
-> LStmt GhcRn (Located (body GhcRn))
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc (XLastStmt GhcRn GhcRn (Located (body GhcRn))
-> Located (body GhcRn)
-> Bool
-> SyntaxExpr GhcRn
-> StmtLR GhcRn GhcRn (Located (body GhcRn))
forall idL idR body.
XLastStmt idL idR body
-> body -> Bool -> SyntaxExpr idR -> StmtLR idL idR body
LastStmt XLastStmt GhcRn GhcRn (Located (body GhcRn))
NoExtField
noExtField Located (body GhcRn)
body' Bool
noret SyntaxExpr GhcRn
ret_op), FreeVars
fv_expr)]
, thing
thing), FreeVars
fv_expr FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs1 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs3) }
rnStmt HsStmtContext Name
ctxt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody (L SrcSpan
loc (BodyStmt XBodyStmt GhcPs GhcPs (Located (body GhcPs))
_ Located (body GhcPs)
body SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_)) [Name] -> RnM (thing, FreeVars)
thing_inside
= do { (Located (body GhcRn)
body', FreeVars
fv_expr) <- Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody Located (body GhcPs)
body
; (SyntaxExpr GhcRn
then_op, FreeVars
fvs1) <- HsStmtContext Name -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupStmtName HsStmtContext Name
ctxt Name
thenMName
; (SyntaxExpr GhcRn
guard_op, FreeVars
fvs2) <- if HsStmtContext Name -> Bool
forall id. HsStmtContext id -> Bool
isComprehensionContext HsStmtContext Name
ctxt
then HsStmtContext Name -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupStmtName HsStmtContext Name
ctxt Name
guardMName
else (SyntaxExpr GhcRn, FreeVars) -> RnM (SyntaxExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (SyntaxExpr GhcRn
forall (p :: Pass). SyntaxExpr (GhcPass p)
noSyntaxExpr, FreeVars
emptyFVs)
; (thing
thing, FreeVars
fvs3) <- [Name] -> RnM (thing, FreeVars)
thing_inside []
; (([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars)
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return ( ([(SrcSpan
-> StmtLR GhcRn GhcRn (Located (body GhcRn))
-> LStmt GhcRn (Located (body GhcRn))
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc (XBodyStmt GhcRn GhcRn (Located (body GhcRn))
-> Located (body GhcRn)
-> SyntaxExpr GhcRn
-> SyntaxExpr GhcRn
-> StmtLR GhcRn GhcRn (Located (body GhcRn))
forall idL idR body.
XBodyStmt idL idR body
-> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
BodyStmt XBodyStmt GhcRn GhcRn (Located (body GhcRn))
NoExtField
noExtField Located (body GhcRn)
body' SyntaxExpr GhcRn
then_op SyntaxExpr GhcRn
guard_op), FreeVars
fv_expr)]
, thing
thing), FreeVars
fv_expr FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs1 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs2 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs3) }
rnStmt HsStmtContext Name
ctxt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody (L SrcSpan
loc (BindStmt XBindStmt GhcPs GhcPs (Located (body GhcPs))
_ LPat GhcPs
pat Located (body GhcPs)
body SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_)) [Name] -> RnM (thing, FreeVars)
thing_inside
= do { (Located (body GhcRn)
body', FreeVars
fv_expr) <- Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody Located (body GhcPs)
body
; (SyntaxExpr GhcRn
bind_op, FreeVars
fvs1) <- HsStmtContext Name -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupStmtName HsStmtContext Name
ctxt Name
bindMName
; (SyntaxExpr GhcRn
fail_op, FreeVars
fvs2) <- LPat GhcPs
-> HsStmtContext Name -> RnM (SyntaxExpr GhcRn, FreeVars)
monadFailOp LPat GhcPs
pat HsStmtContext Name
ctxt
; HsMatchContext Name
-> LPat GhcPs
-> (LPat GhcRn
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars))
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars)
forall a.
HsMatchContext Name
-> LPat GhcPs
-> (LPat GhcRn -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
rnPat (HsStmtContext Name -> HsMatchContext Name
forall id. HsStmtContext id -> HsMatchContext id
StmtCtxt HsStmtContext Name
ctxt) LPat GhcPs
pat ((LPat GhcRn
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars))
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars))
-> (LPat GhcRn
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars))
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars)
forall a b. (a -> b) -> a -> b
$ \ LPat GhcRn
pat' -> do
{ (thing
thing, FreeVars
fvs3) <- [Name] -> RnM (thing, FreeVars)
thing_inside (LPat GhcRn -> [IdP GhcRn]
forall (p :: Pass). LPat (GhcPass p) -> [IdP (GhcPass p)]
collectPatBinders LPat GhcRn
pat')
; (([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars)
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (( [( SrcSpan
-> StmtLR GhcRn GhcRn (Located (body GhcRn))
-> LStmt GhcRn (Located (body GhcRn))
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc (XBindStmt GhcRn GhcRn (Located (body GhcRn))
-> LPat GhcRn
-> Located (body GhcRn)
-> SyntaxExpr GhcRn
-> SyntaxExpr GhcRn
-> StmtLR GhcRn GhcRn (Located (body GhcRn))
forall idL idR body.
XBindStmt idL idR body
-> LPat idL
-> body
-> SyntaxExpr idR
-> SyntaxExpr idR
-> StmtLR idL idR body
BindStmt XBindStmt GhcRn GhcRn (Located (body GhcRn))
NoExtField
noExtField LPat GhcRn
pat' Located (body GhcRn)
body' SyntaxExpr GhcRn
bind_op SyntaxExpr GhcRn
fail_op)
, FreeVars
fv_expr )]
, thing
thing),
FreeVars
fv_expr FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs1 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs2 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs3) }}
rnStmt HsStmtContext Name
_ Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
_ (L SrcSpan
loc (LetStmt XLetStmt GhcPs GhcPs (Located (body GhcPs))
_ (L SrcSpan
l HsLocalBinds GhcPs
binds))) [Name] -> RnM (thing, FreeVars)
thing_inside
= do { HsLocalBinds GhcPs
-> (HsLocalBinds GhcRn
-> FreeVars
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars))
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars)
forall result.
HsLocalBinds GhcPs
-> (HsLocalBinds GhcRn -> FreeVars -> RnM (result, FreeVars))
-> RnM (result, FreeVars)
rnLocalBindsAndThen HsLocalBinds GhcPs
binds ((HsLocalBinds GhcRn
-> FreeVars
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars))
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars))
-> (HsLocalBinds GhcRn
-> FreeVars
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars))
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars)
forall a b. (a -> b) -> a -> b
$ \HsLocalBinds GhcRn
binds' FreeVars
bind_fvs -> do
{ (thing
thing, FreeVars
fvs) <- [Name] -> RnM (thing, FreeVars)
thing_inside (HsLocalBinds GhcRn -> [IdP GhcRn]
forall (idL :: Pass) (idR :: Pass).
HsLocalBindsLR (GhcPass idL) (GhcPass idR) -> [IdP (GhcPass idL)]
collectLocalBinders HsLocalBinds GhcRn
binds')
; (([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars)
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return ( ([(SrcSpan
-> StmtLR GhcRn GhcRn (Located (body GhcRn))
-> LStmt GhcRn (Located (body GhcRn))
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc (XLetStmt GhcRn GhcRn (Located (body GhcRn))
-> LHsLocalBinds GhcRn -> StmtLR GhcRn GhcRn (Located (body GhcRn))
forall idL idR body.
XLetStmt idL idR body
-> LHsLocalBindsLR idL idR -> StmtLR idL idR body
LetStmt XLetStmt GhcRn GhcRn (Located (body GhcRn))
NoExtField
noExtField (SrcSpan -> HsLocalBinds GhcRn -> LHsLocalBinds GhcRn
forall l e. l -> e -> GenLocated l e
L SrcSpan
l HsLocalBinds GhcRn
binds')), FreeVars
bind_fvs)], thing
thing)
, FreeVars
fvs) } }
rnStmt HsStmtContext Name
ctxt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody (L SrcSpan
loc (RecStmt { recS_stmts :: forall idL idR body. StmtLR idL idR body -> [LStmtLR idL idR body]
recS_stmts = [LStmt GhcPs (Located (body GhcPs))]
rec_stmts })) [Name] -> RnM (thing, FreeVars)
thing_inside
= do { (SyntaxExpr GhcRn
return_op, FreeVars
fvs1) <- HsStmtContext Name -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupStmtName HsStmtContext Name
ctxt Name
returnMName
; (SyntaxExpr GhcRn
mfix_op, FreeVars
fvs2) <- HsStmtContext Name -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupStmtName HsStmtContext Name
ctxt Name
mfixName
; (SyntaxExpr GhcRn
bind_op, FreeVars
fvs3) <- HsStmtContext Name -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupStmtName HsStmtContext Name
ctxt Name
bindMName
; let empty_rec_stmt :: StmtLR GhcRn GhcRn (Located (body GhcRn))
empty_rec_stmt = StmtLR GhcRn GhcRn (Located (body GhcRn))
forall bodyR. StmtLR GhcRn GhcRn bodyR
emptyRecStmtName { recS_ret_fn :: SyntaxExpr GhcRn
recS_ret_fn = SyntaxExpr GhcRn
return_op
, recS_mfix_fn :: SyntaxExpr GhcRn
recS_mfix_fn = SyntaxExpr GhcRn
mfix_op
, recS_bind_fn :: SyntaxExpr GhcRn
recS_bind_fn = SyntaxExpr GhcRn
bind_op }
; (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> [LStmt GhcPs (Located (body GhcPs))]
-> ([Segment (LStmt GhcRn (Located (body GhcRn)))]
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars))
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars)
forall (body :: * -> *) a.
Outputable (body GhcPs) =>
(Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> [LStmt GhcPs (Located (body GhcPs))]
-> ([Segment (LStmt GhcRn (Located (body GhcRn)))]
-> RnM (a, FreeVars))
-> RnM (a, FreeVars)
rnRecStmtsAndThen Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody [LStmt GhcPs (Located (body GhcPs))]
rec_stmts (([Segment (LStmt GhcRn (Located (body GhcRn)))]
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars))
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars))
-> ([Segment (LStmt GhcRn (Located (body GhcRn)))]
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars))
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars)
forall a b. (a -> b) -> a -> b
$ \ [Segment (LStmt GhcRn (Located (body GhcRn)))]
segs -> do
{ let bndrs :: [Name]
bndrs = FreeVars -> [Name]
nameSetElemsStable (FreeVars -> [Name]) -> FreeVars -> [Name]
forall a b. (a -> b) -> a -> b
$
(Segment (LStmt GhcRn (Located (body GhcRn)))
-> FreeVars -> FreeVars)
-> FreeVars
-> [Segment (LStmt GhcRn (Located (body GhcRn)))]
-> FreeVars
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (FreeVars -> FreeVars -> FreeVars
unionNameSet (FreeVars -> FreeVars -> FreeVars)
-> (Segment (LStmt GhcRn (Located (body GhcRn))) -> FreeVars)
-> Segment (LStmt GhcRn (Located (body GhcRn)))
-> FreeVars
-> FreeVars
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(FreeVars
ds,FreeVars
_,FreeVars
_,LStmt GhcRn (Located (body GhcRn))
_) -> FreeVars
ds))
FreeVars
emptyNameSet
[Segment (LStmt GhcRn (Located (body GhcRn)))]
segs
; (thing
thing, FreeVars
fvs_later) <- [Name] -> RnM (thing, FreeVars)
thing_inside [Name]
bndrs
; let ([LStmt GhcRn (Located (body GhcRn))]
rec_stmts', FreeVars
fvs) = SrcSpan
-> HsStmtContext Name
-> StmtLR GhcRn GhcRn (Located (body GhcRn))
-> [Segment (LStmt GhcRn (Located (body GhcRn)))]
-> FreeVars
-> ([LStmt GhcRn (Located (body GhcRn))], FreeVars)
forall body.
SrcSpan
-> HsStmtContext Name
-> Stmt GhcRn body
-> [Segment (LStmt GhcRn body)]
-> FreeVars
-> ([LStmt GhcRn body], FreeVars)
segmentRecStmts SrcSpan
loc HsStmtContext Name
ctxt StmtLR GhcRn GhcRn (Located (body GhcRn))
empty_rec_stmt [Segment (LStmt GhcRn (Located (body GhcRn)))]
segs FreeVars
fvs_later
; (([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars)
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return ( (([LStmt GhcRn (Located (body GhcRn))]
-> [FreeVars] -> [(LStmt GhcRn (Located (body GhcRn)), FreeVars)]
forall a b. [a] -> [b] -> [(a, b)]
zip [LStmt GhcRn (Located (body GhcRn))]
rec_stmts' (FreeVars -> [FreeVars]
forall a. a -> [a]
repeat FreeVars
emptyNameSet)), thing
thing)
, FreeVars
fvs FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs1 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs2 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs3) } }
rnStmt HsStmtContext Name
ctxt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
_ (L SrcSpan
loc (ParStmt XParStmt GhcPs GhcPs (Located (body GhcPs))
_ [ParStmtBlock GhcPs GhcPs]
segs HsExpr GhcPs
_ SyntaxExpr GhcPs
_)) [Name] -> RnM (thing, FreeVars)
thing_inside
= do { (HsExpr GhcRn
mzip_op, FreeVars
fvs1) <- HsStmtContext Name -> Name -> RnM (HsExpr GhcRn, FreeVars)
lookupStmtNamePoly HsStmtContext Name
ctxt Name
mzipName
; (SyntaxExpr GhcRn
bind_op, FreeVars
fvs2) <- HsStmtContext Name -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupStmtName HsStmtContext Name
ctxt Name
bindMName
; (SyntaxExpr GhcRn
return_op, FreeVars
fvs3) <- HsStmtContext Name -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupStmtName HsStmtContext Name
ctxt Name
returnMName
; (([ParStmtBlock GhcRn GhcRn]
segs', thing
thing), FreeVars
fvs4) <- HsStmtContext Name
-> SyntaxExpr GhcRn
-> [ParStmtBlock GhcPs GhcPs]
-> ([Name] -> RnM (thing, FreeVars))
-> RnM (([ParStmtBlock GhcRn GhcRn], thing), FreeVars)
forall thing.
HsStmtContext Name
-> SyntaxExpr GhcRn
-> [ParStmtBlock GhcPs GhcPs]
-> ([Name] -> RnM (thing, FreeVars))
-> RnM (([ParStmtBlock GhcRn GhcRn], thing), FreeVars)
rnParallelStmts (HsStmtContext Name -> HsStmtContext Name
forall id. HsStmtContext id -> HsStmtContext id
ParStmtCtxt HsStmtContext Name
ctxt) SyntaxExpr GhcRn
return_op [ParStmtBlock GhcPs GhcPs]
segs [Name] -> RnM (thing, FreeVars)
thing_inside
; (([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars)
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (([(SrcSpan
-> StmtLR GhcRn GhcRn (Located (body GhcRn))
-> LStmt GhcRn (Located (body GhcRn))
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc (XParStmt GhcRn GhcRn (Located (body GhcRn))
-> [ParStmtBlock GhcRn GhcRn]
-> HsExpr GhcRn
-> SyntaxExpr GhcRn
-> StmtLR GhcRn GhcRn (Located (body GhcRn))
forall idL idR body.
XParStmt idL idR body
-> [ParStmtBlock idL idR]
-> HsExpr idR
-> SyntaxExpr idR
-> StmtLR idL idR body
ParStmt XParStmt GhcRn GhcRn (Located (body GhcRn))
NoExtField
noExtField [ParStmtBlock GhcRn GhcRn]
segs' HsExpr GhcRn
mzip_op SyntaxExpr GhcRn
bind_op), FreeVars
fvs4)], thing
thing)
, FreeVars
fvs1 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs2 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs3 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs4) }
rnStmt HsStmtContext Name
ctxt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
_ (L SrcSpan
loc (TransStmt { trS_stmts :: forall idL idR body. StmtLR idL idR body -> [ExprLStmt idL]
trS_stmts = [ExprLStmt GhcPs]
stmts, trS_by :: forall idL idR body. StmtLR idL idR body -> Maybe (LHsExpr idR)
trS_by = Maybe (LHsExpr GhcPs)
by, trS_form :: forall idL idR body. StmtLR idL idR body -> TransForm
trS_form = TransForm
form
, trS_using :: forall idL idR body. StmtLR idL idR body -> LHsExpr idR
trS_using = LHsExpr GhcPs
using })) [Name] -> RnM (thing, FreeVars)
thing_inside
= do {
(LHsExpr GhcRn
using', FreeVars
fvs1) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
using
; (([LStmt GhcRn (LHsExpr GhcRn)]
stmts', (Maybe (LHsExpr GhcRn)
by', [Name]
used_bndrs, thing
thing)), FreeVars
fvs2)
<- HsStmtContext Name
-> (LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars))
-> [ExprLStmt GhcPs]
-> ([Name]
-> RnM ((Maybe (LHsExpr GhcRn), [Name], thing), FreeVars))
-> RnM
(([LStmt GhcRn (LHsExpr GhcRn)],
(Maybe (LHsExpr GhcRn), [Name], thing)),
FreeVars)
forall (body :: * -> *) thing.
Outputable (body GhcPs) =>
HsStmtContext Name
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> [LStmt GhcPs (Located (body GhcPs))]
-> ([Name] -> RnM (thing, FreeVars))
-> RnM (([LStmt GhcRn (Located (body GhcRn))], thing), FreeVars)
rnStmts (HsStmtContext Name -> HsStmtContext Name
forall id. HsStmtContext id -> HsStmtContext id
TransStmtCtxt HsStmtContext Name
ctxt) LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr [ExprLStmt GhcPs]
stmts (([Name] -> RnM ((Maybe (LHsExpr GhcRn), [Name], thing), FreeVars))
-> RnM
(([LStmt GhcRn (LHsExpr GhcRn)],
(Maybe (LHsExpr GhcRn), [Name], thing)),
FreeVars))
-> ([Name]
-> RnM ((Maybe (LHsExpr GhcRn), [Name], thing), FreeVars))
-> RnM
(([LStmt GhcRn (LHsExpr GhcRn)],
(Maybe (LHsExpr GhcRn), [Name], thing)),
FreeVars)
forall a b. (a -> b) -> a -> b
$ \ [Name]
bndrs ->
do { (Maybe (LHsExpr GhcRn)
by', FreeVars
fvs_by) <- (LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars))
-> Maybe (LHsExpr GhcPs) -> RnM (Maybe (LHsExpr GhcRn), FreeVars)
forall a b.
(a -> RnM (b, FreeVars)) -> Maybe a -> RnM (Maybe b, FreeVars)
mapMaybeFvRn LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr Maybe (LHsExpr GhcPs)
by
; (thing
thing, FreeVars
fvs_thing) <- [Name] -> RnM (thing, FreeVars)
thing_inside [Name]
bndrs
; let fvs :: FreeVars
fvs = FreeVars
fvs_by FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs_thing
used_bndrs :: [Name]
used_bndrs = (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter (Name -> FreeVars -> Bool
`elemNameSet` FreeVars
fvs) [Name]
bndrs
; ((Maybe (LHsExpr GhcRn), [Name], thing), FreeVars)
-> RnM ((Maybe (LHsExpr GhcRn), [Name], thing), FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe (LHsExpr GhcRn)
by', [Name]
used_bndrs, thing
thing), FreeVars
fvs) }
; (SyntaxExpr GhcRn
return_op, FreeVars
fvs3) <- HsStmtContext Name -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupStmtName HsStmtContext Name
ctxt Name
returnMName
; (SyntaxExpr GhcRn
bind_op, FreeVars
fvs4) <- HsStmtContext Name -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupStmtName HsStmtContext Name
ctxt Name
bindMName
; (HsExpr GhcRn
fmap_op, FreeVars
fvs5) <- case TransForm
form of
TransForm
ThenForm -> (HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr GhcRn
forall (p :: Pass). HsExpr (GhcPass p)
noExpr, FreeVars
emptyFVs)
TransForm
_ -> HsStmtContext Name -> Name -> RnM (HsExpr GhcRn, FreeVars)
lookupStmtNamePoly HsStmtContext Name
ctxt Name
fmapName
; let all_fvs :: FreeVars
all_fvs = FreeVars
fvs1 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs2 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs3
FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs4 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs5
bndr_map :: [(Name, Name)]
bndr_map = [Name]
used_bndrs [Name] -> [Name] -> [(Name, Name)]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [Name]
used_bndrs
; String -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"rnStmt: implicitly rebound these used binders:" ([(Name, Name)] -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr [(Name, Name)]
bndr_map)
; (([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars)
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (([(SrcSpan
-> StmtLR GhcRn GhcRn (Located (body GhcRn))
-> LStmt GhcRn (Located (body GhcRn))
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc (TransStmt :: forall idL idR body.
XTransStmt idL idR body
-> TransForm
-> [ExprLStmt idL]
-> [(IdP idR, IdP idR)]
-> LHsExpr idR
-> Maybe (LHsExpr idR)
-> SyntaxExpr idR
-> SyntaxExpr idR
-> HsExpr idR
-> StmtLR idL idR body
TransStmt { trS_ext :: XTransStmt GhcRn GhcRn (Located (body GhcRn))
trS_ext = XTransStmt GhcRn GhcRn (Located (body GhcRn))
NoExtField
noExtField
, trS_stmts :: [LStmt GhcRn (LHsExpr GhcRn)]
trS_stmts = [LStmt GhcRn (LHsExpr GhcRn)]
stmts', trS_bndrs :: [(IdP GhcRn, IdP GhcRn)]
trS_bndrs = [(Name, Name)]
[(IdP GhcRn, IdP GhcRn)]
bndr_map
, trS_by :: Maybe (LHsExpr GhcRn)
trS_by = Maybe (LHsExpr GhcRn)
by', trS_using :: LHsExpr GhcRn
trS_using = LHsExpr GhcRn
using', trS_form :: TransForm
trS_form = TransForm
form
, trS_ret :: SyntaxExpr GhcRn
trS_ret = SyntaxExpr GhcRn
return_op, trS_bind :: SyntaxExpr GhcRn
trS_bind = SyntaxExpr GhcRn
bind_op
, trS_fmap :: HsExpr GhcRn
trS_fmap = HsExpr GhcRn
fmap_op }), FreeVars
fvs2)], thing
thing), FreeVars
all_fvs) }
rnStmt HsStmtContext Name
_ Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
_ (L SrcSpan
_ ApplicativeStmt{}) [Name] -> RnM (thing, FreeVars)
_ =
String
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars)
forall a. String -> a
panic String
"rnStmt: ApplicativeStmt"
rnStmt HsStmtContext Name
_ Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
_ (L SrcSpan
_ (XStmtLR XXStmtLR GhcPs GhcPs (Located (body GhcPs))
nec)) [Name] -> RnM (thing, FreeVars)
_ =
NoExtCon
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)], thing),
FreeVars)
forall a. NoExtCon -> a
noExtCon XXStmtLR GhcPs GhcPs (Located (body GhcPs))
NoExtCon
nec
rnParallelStmts :: forall thing. HsStmtContext Name
-> SyntaxExpr GhcRn
-> [ParStmtBlock GhcPs GhcPs]
-> ([Name] -> RnM (thing, FreeVars))
-> RnM (([ParStmtBlock GhcRn GhcRn], thing), FreeVars)
rnParallelStmts :: HsStmtContext Name
-> SyntaxExpr GhcRn
-> [ParStmtBlock GhcPs GhcPs]
-> ([Name] -> RnM (thing, FreeVars))
-> RnM (([ParStmtBlock GhcRn GhcRn], thing), FreeVars)
rnParallelStmts HsStmtContext Name
ctxt SyntaxExpr GhcRn
return_op [ParStmtBlock GhcPs GhcPs]
segs [Name] -> RnM (thing, FreeVars)
thing_inside
= do { LocalRdrEnv
orig_lcl_env <- RnM LocalRdrEnv
getLocalRdrEnv
; LocalRdrEnv
-> [Name]
-> [ParStmtBlock GhcPs GhcPs]
-> RnM (([ParStmtBlock GhcRn GhcRn], thing), FreeVars)
rn_segs LocalRdrEnv
orig_lcl_env [] [ParStmtBlock GhcPs GhcPs]
segs }
where
rn_segs :: LocalRdrEnv
-> [Name] -> [ParStmtBlock GhcPs GhcPs]
-> RnM (([ParStmtBlock GhcRn GhcRn], thing), FreeVars)
rn_segs :: LocalRdrEnv
-> [Name]
-> [ParStmtBlock GhcPs GhcPs]
-> RnM (([ParStmtBlock GhcRn GhcRn], thing), FreeVars)
rn_segs LocalRdrEnv
_ [Name]
bndrs_so_far []
= do { let ([Name]
bndrs', [NonEmpty Name]
dups) = (Name -> Name -> Ordering) -> [Name] -> ([Name], [NonEmpty Name])
forall a. (a -> a -> Ordering) -> [a] -> ([a], [NonEmpty a])
removeDups Name -> Name -> Ordering
cmpByOcc [Name]
bndrs_so_far
; (NonEmpty Name -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> [NonEmpty Name] -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ NonEmpty Name -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall a.
Outputable a =>
NonEmpty a -> IOEnv (Env TcGblEnv TcLclEnv) ()
dupErr [NonEmpty Name]
dups
; (thing
thing, FreeVars
fvs) <- [Name] -> RnM (thing, FreeVars) -> RnM (thing, FreeVars)
forall a. [Name] -> RnM a -> RnM a
bindLocalNames [Name]
bndrs' ([Name] -> RnM (thing, FreeVars)
thing_inside [Name]
bndrs')
; (([ParStmtBlock GhcRn GhcRn], thing), FreeVars)
-> RnM (([ParStmtBlock GhcRn GhcRn], thing), FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (([], thing
thing), FreeVars
fvs) }
rn_segs LocalRdrEnv
env [Name]
bndrs_so_far (ParStmtBlock XParStmtBlock GhcPs GhcPs
x [ExprLStmt GhcPs]
stmts [IdP GhcPs]
_ SyntaxExpr GhcPs
_ : [ParStmtBlock GhcPs GhcPs]
segs)
= do { (([LStmt GhcRn (LHsExpr GhcRn)]
stmts', ([Name]
used_bndrs, [ParStmtBlock GhcRn GhcRn]
segs', thing
thing)), FreeVars
fvs)
<- HsStmtContext Name
-> (LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars))
-> [ExprLStmt GhcPs]
-> ([Name]
-> RnM (([Name], [ParStmtBlock GhcRn GhcRn], thing), FreeVars))
-> RnM
(([LStmt GhcRn (LHsExpr GhcRn)],
([Name], [ParStmtBlock GhcRn GhcRn], thing)),
FreeVars)
forall (body :: * -> *) thing.
Outputable (body GhcPs) =>
HsStmtContext Name
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> [LStmt GhcPs (Located (body GhcPs))]
-> ([Name] -> RnM (thing, FreeVars))
-> RnM (([LStmt GhcRn (Located (body GhcRn))], thing), FreeVars)
rnStmts HsStmtContext Name
ctxt LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr [ExprLStmt GhcPs]
stmts (([Name]
-> RnM (([Name], [ParStmtBlock GhcRn GhcRn], thing), FreeVars))
-> RnM
(([LStmt GhcRn (LHsExpr GhcRn)],
([Name], [ParStmtBlock GhcRn GhcRn], thing)),
FreeVars))
-> ([Name]
-> RnM (([Name], [ParStmtBlock GhcRn GhcRn], thing), FreeVars))
-> RnM
(([LStmt GhcRn (LHsExpr GhcRn)],
([Name], [ParStmtBlock GhcRn GhcRn], thing)),
FreeVars)
forall a b. (a -> b) -> a -> b
$ \ [Name]
bndrs ->
LocalRdrEnv
-> RnM (([Name], [ParStmtBlock GhcRn GhcRn], thing), FreeVars)
-> RnM (([Name], [ParStmtBlock GhcRn GhcRn], thing), FreeVars)
forall a. LocalRdrEnv -> RnM a -> RnM a
setLocalRdrEnv LocalRdrEnv
env (RnM (([Name], [ParStmtBlock GhcRn GhcRn], thing), FreeVars)
-> RnM (([Name], [ParStmtBlock GhcRn GhcRn], thing), FreeVars))
-> RnM (([Name], [ParStmtBlock GhcRn GhcRn], thing), FreeVars)
-> RnM (([Name], [ParStmtBlock GhcRn GhcRn], thing), FreeVars)
forall a b. (a -> b) -> a -> b
$ do
{ (([ParStmtBlock GhcRn GhcRn]
segs', thing
thing), FreeVars
fvs) <- LocalRdrEnv
-> [Name]
-> [ParStmtBlock GhcPs GhcPs]
-> RnM (([ParStmtBlock GhcRn GhcRn], thing), FreeVars)
rn_segs LocalRdrEnv
env ([Name]
bndrs [Name] -> [Name] -> [Name]
forall a. [a] -> [a] -> [a]
++ [Name]
bndrs_so_far) [ParStmtBlock GhcPs GhcPs]
segs
; let used_bndrs :: [Name]
used_bndrs = (Name -> Bool) -> [Name] -> [Name]
forall a. (a -> Bool) -> [a] -> [a]
filter (Name -> FreeVars -> Bool
`elemNameSet` FreeVars
fvs) [Name]
bndrs
; (([Name], [ParStmtBlock GhcRn GhcRn], thing), FreeVars)
-> RnM (([Name], [ParStmtBlock GhcRn GhcRn], thing), FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (([Name]
used_bndrs, [ParStmtBlock GhcRn GhcRn]
segs', thing
thing), FreeVars
fvs) }
; let seg' :: ParStmtBlock GhcRn GhcRn
seg' = XParStmtBlock GhcRn GhcRn
-> [LStmt GhcRn (LHsExpr GhcRn)]
-> [IdP GhcRn]
-> SyntaxExpr GhcRn
-> ParStmtBlock GhcRn GhcRn
forall idL idR.
XParStmtBlock idL idR
-> [ExprLStmt idL]
-> [IdP idR]
-> SyntaxExpr idR
-> ParStmtBlock idL idR
ParStmtBlock XParStmtBlock GhcPs GhcPs
XParStmtBlock GhcRn GhcRn
x [LStmt GhcRn (LHsExpr GhcRn)]
stmts' [Name]
[IdP GhcRn]
used_bndrs SyntaxExpr GhcRn
return_op
; (([ParStmtBlock GhcRn GhcRn], thing), FreeVars)
-> RnM (([ParStmtBlock GhcRn GhcRn], thing), FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return ((ParStmtBlock GhcRn GhcRn
seg'ParStmtBlock GhcRn GhcRn
-> [ParStmtBlock GhcRn GhcRn] -> [ParStmtBlock GhcRn GhcRn]
forall a. a -> [a] -> [a]
:[ParStmtBlock GhcRn GhcRn]
segs', thing
thing), FreeVars
fvs) }
rn_segs LocalRdrEnv
_ [Name]
_ (XParStmtBlock XXParStmtBlock GhcPs GhcPs
nec:[ParStmtBlock GhcPs GhcPs]
_) = NoExtCon -> RnM (([ParStmtBlock GhcRn GhcRn], thing), FreeVars)
forall a. NoExtCon -> a
noExtCon XXParStmtBlock GhcPs GhcPs
NoExtCon
nec
cmpByOcc :: Name -> Name -> Ordering
cmpByOcc Name
n1 Name
n2 = Name -> OccName
nameOccName Name
n1 OccName -> OccName -> Ordering
forall a. Ord a => a -> a -> Ordering
`compare` Name -> OccName
nameOccName Name
n2
dupErr :: NonEmpty a -> IOEnv (Env TcGblEnv TcLclEnv) ()
dupErr NonEmpty a
vs = MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (String -> MsgDoc
text String
"Duplicate binding in parallel list comprehension for:"
MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc -> MsgDoc
quotes (a -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (NonEmpty a -> a
forall a. NonEmpty a -> a
NE.head NonEmpty a
vs)))
lookupStmtName :: HsStmtContext Name -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupStmtName :: HsStmtContext Name -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupStmtName HsStmtContext Name
ctxt Name
n
| HsStmtContext Name -> Bool
rebindableContext HsStmtContext Name
ctxt
= Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupSyntaxName Name
n
| Bool
otherwise
= (SyntaxExpr GhcRn, FreeVars) -> RnM (SyntaxExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> SyntaxExpr GhcRn
mkRnSyntaxExpr Name
n, FreeVars
emptyFVs)
lookupStmtNamePoly :: HsStmtContext Name -> Name -> RnM (HsExpr GhcRn, FreeVars)
lookupStmtNamePoly :: HsStmtContext Name -> Name -> RnM (HsExpr GhcRn, FreeVars)
lookupStmtNamePoly HsStmtContext Name
ctxt Name
name
| HsStmtContext Name -> Bool
rebindableContext HsStmtContext Name
ctxt
= do { Bool
rebindable_on <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.RebindableSyntax
; if Bool
rebindable_on
then do { Name
fm <- RdrName -> RnM Name
lookupOccRn (Name -> RdrName
nameRdrName Name
name)
; (HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XVar GhcRn -> Located (IdP GhcRn) -> HsExpr GhcRn
forall p. XVar p -> Located (IdP p) -> HsExpr p
HsVar XVar GhcRn
NoExtField
noExtField (SrcSpanLess (Located Name) -> Located Name
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc Name
SrcSpanLess (Located Name)
fm), Name -> FreeVars
unitFV Name
fm) }
else RnM (HsExpr GhcRn, FreeVars)
not_rebindable }
| Bool
otherwise
= RnM (HsExpr GhcRn, FreeVars)
not_rebindable
where
not_rebindable :: RnM (HsExpr GhcRn, FreeVars)
not_rebindable = (HsExpr GhcRn, FreeVars) -> RnM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XVar GhcRn -> Located (IdP GhcRn) -> HsExpr GhcRn
forall p. XVar p -> Located (IdP p) -> HsExpr p
HsVar XVar GhcRn
NoExtField
noExtField (SrcSpanLess (Located Name) -> Located Name
forall a. HasSrcSpan a => SrcSpanLess a -> a
noLoc Name
SrcSpanLess (Located Name)
name), FreeVars
emptyFVs)
rebindableContext :: HsStmtContext Name -> Bool
rebindableContext :: HsStmtContext Name -> Bool
rebindableContext HsStmtContext Name
ctxt = case HsStmtContext Name
ctxt of
HsStmtContext Name
ListComp -> Bool
False
HsStmtContext Name
ArrowExpr -> Bool
False
PatGuard {} -> Bool
False
HsStmtContext Name
DoExpr -> Bool
True
HsStmtContext Name
MDoExpr -> Bool
True
HsStmtContext Name
MonadComp -> Bool
True
HsStmtContext Name
GhciStmtCtxt -> Bool
True
ParStmtCtxt HsStmtContext Name
c -> HsStmtContext Name -> Bool
rebindableContext HsStmtContext Name
c
TransStmtCtxt HsStmtContext Name
c -> HsStmtContext Name -> Bool
rebindableContext HsStmtContext Name
c
type FwdRefs = NameSet
type Segment stmts = (Defs,
Uses,
FwdRefs,
stmts)
rnRecStmtsAndThen :: Outputable (body GhcPs) =>
(Located (body GhcPs)
-> RnM (Located (body GhcRn), FreeVars))
-> [LStmt GhcPs (Located (body GhcPs))]
-> ([Segment (LStmt GhcRn (Located (body GhcRn)))]
-> RnM (a, FreeVars))
-> RnM (a, FreeVars)
rnRecStmtsAndThen :: (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> [LStmt GhcPs (Located (body GhcPs))]
-> ([Segment (LStmt GhcRn (Located (body GhcRn)))]
-> RnM (a, FreeVars))
-> RnM (a, FreeVars)
rnRecStmtsAndThen Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody [LStmt GhcPs (Located (body GhcPs))]
s [Segment (LStmt GhcRn (Located (body GhcRn)))] -> RnM (a, FreeVars)
cont
= do {
MiniFixityEnv
fix_env <- [LFixitySig GhcPs] -> RnM MiniFixityEnv
makeMiniFixityEnv ([LStmt GhcPs (Located (body GhcPs))] -> [LFixitySig GhcPs]
forall body. [LStmtLR GhcPs GhcPs body] -> [LFixitySig GhcPs]
collectRecStmtsFixities [LStmt GhcPs (Located (body GhcPs))]
s)
; [(LStmtLR GhcRn GhcPs (Located (body GhcPs)), FreeVars)]
new_lhs_and_fv <- MiniFixityEnv
-> [LStmt GhcPs (Located (body GhcPs))]
-> RnM [(LStmtLR GhcRn GhcPs (Located (body GhcPs)), FreeVars)]
forall body.
Outputable body =>
MiniFixityEnv
-> [LStmt GhcPs body] -> RnM [(LStmtLR GhcRn GhcPs body, FreeVars)]
rn_rec_stmts_lhs MiniFixityEnv
fix_env [LStmt GhcPs (Located (body GhcPs))]
s
; let bound_names :: [IdP GhcRn]
bound_names = [LStmtLR GhcRn GhcPs (Located (body GhcPs))] -> [IdP GhcRn]
forall (idL :: Pass) (idR :: Pass) body.
[LStmtLR (GhcPass idL) (GhcPass idR) body] -> [IdP (GhcPass idL)]
collectLStmtsBinders (((LStmtLR GhcRn GhcPs (Located (body GhcPs)), FreeVars)
-> LStmtLR GhcRn GhcPs (Located (body GhcPs)))
-> [(LStmtLR GhcRn GhcPs (Located (body GhcPs)), FreeVars)]
-> [LStmtLR GhcRn GhcPs (Located (body GhcPs))]
forall a b. (a -> b) -> [a] -> [b]
map (LStmtLR GhcRn GhcPs (Located (body GhcPs)), FreeVars)
-> LStmtLR GhcRn GhcPs (Located (body GhcPs))
forall a b. (a, b) -> a
fst [(LStmtLR GhcRn GhcPs (Located (body GhcPs)), FreeVars)]
new_lhs_and_fv)
rec_uses :: [(SrcSpan, [Name])]
rec_uses = [LStmtLR GhcRn GhcPs (Located (body GhcPs))] -> [(SrcSpan, [Name])]
forall (idR :: Pass) (body :: * -> *).
[LStmtLR GhcRn (GhcPass idR) (Located (body (GhcPass idR)))]
-> [(SrcSpan, [Name])]
lStmtsImplicits (((LStmtLR GhcRn GhcPs (Located (body GhcPs)), FreeVars)
-> LStmtLR GhcRn GhcPs (Located (body GhcPs)))
-> [(LStmtLR GhcRn GhcPs (Located (body GhcPs)), FreeVars)]
-> [LStmtLR GhcRn GhcPs (Located (body GhcPs))]
forall a b. (a -> b) -> [a] -> [b]
map (LStmtLR GhcRn GhcPs (Located (body GhcPs)), FreeVars)
-> LStmtLR GhcRn GhcPs (Located (body GhcPs))
forall a b. (a, b) -> a
fst [(LStmtLR GhcRn GhcPs (Located (body GhcPs)), FreeVars)]
new_lhs_and_fv)
implicit_uses :: FreeVars
implicit_uses = [Name] -> FreeVars
mkNameSet ([Name] -> FreeVars) -> [Name] -> FreeVars
forall a b. (a -> b) -> a -> b
$ ((SrcSpan, [Name]) -> [Name]) -> [(SrcSpan, [Name])] -> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (SrcSpan, [Name]) -> [Name]
forall a b. (a, b) -> b
snd ([(SrcSpan, [Name])] -> [Name]) -> [(SrcSpan, [Name])] -> [Name]
forall a b. (a -> b) -> a -> b
$ [(SrcSpan, [Name])]
rec_uses
; [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
forall a. [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
bindLocalNamesFV [Name]
[IdP GhcRn]
bound_names (RnM (a, FreeVars) -> RnM (a, FreeVars))
-> RnM (a, FreeVars) -> RnM (a, FreeVars)
forall a b. (a -> b) -> a -> b
$
MiniFixityEnv -> [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
forall a. MiniFixityEnv -> [Name] -> RnM a -> RnM a
addLocalFixities MiniFixityEnv
fix_env [Name]
[IdP GhcRn]
bound_names (RnM (a, FreeVars) -> RnM (a, FreeVars))
-> RnM (a, FreeVars) -> RnM (a, FreeVars)
forall a b. (a -> b) -> a -> b
$ do
{ [Segment (LStmt GhcRn (Located (body GhcRn)))]
segs <- (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> [Name]
-> [(LStmtLR GhcRn GhcPs (Located (body GhcPs)), FreeVars)]
-> RnM [Segment (LStmt GhcRn (Located (body GhcRn)))]
forall (body :: * -> *).
Outputable (body GhcPs) =>
(Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> [Name]
-> [(LStmtLR GhcRn GhcPs (Located (body GhcPs)), FreeVars)]
-> RnM [Segment (LStmt GhcRn (Located (body GhcRn)))]
rn_rec_stmts Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody [Name]
[IdP GhcRn]
bound_names [(LStmtLR GhcRn GhcPs (Located (body GhcPs)), FreeVars)]
new_lhs_and_fv
; (a
res, FreeVars
fvs) <- [Segment (LStmt GhcRn (Located (body GhcRn)))] -> RnM (a, FreeVars)
cont [Segment (LStmt GhcRn (Located (body GhcRn)))]
segs
; ((SrcSpan, [Name]) -> IOEnv (Env TcGblEnv TcLclEnv) ())
-> [(SrcSpan, [Name])] -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\(SrcSpan
loc, [Name]
ns) -> SrcSpan
-> FreeVars -> Maybe [Name] -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkUnusedRecordWildcard SrcSpan
loc FreeVars
fvs ([Name] -> Maybe [Name]
forall a. a -> Maybe a
Just [Name]
ns))
[(SrcSpan, [Name])]
rec_uses
; [Name] -> FreeVars -> IOEnv (Env TcGblEnv TcLclEnv) ()
warnUnusedLocalBinds [Name]
[IdP GhcRn]
bound_names (FreeVars
fvs FreeVars -> FreeVars -> FreeVars
`unionNameSet` FreeVars
implicit_uses)
; (a, FreeVars) -> RnM (a, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (a
res, FreeVars
fvs) }}
collectRecStmtsFixities :: [LStmtLR GhcPs GhcPs body] -> [LFixitySig GhcPs]
collectRecStmtsFixities :: [LStmtLR GhcPs GhcPs body] -> [LFixitySig GhcPs]
collectRecStmtsFixities [LStmtLR GhcPs GhcPs body]
l =
(LStmtLR GhcPs GhcPs body
-> [LFixitySig GhcPs] -> [LFixitySig GhcPs])
-> [LFixitySig GhcPs]
-> [LStmtLR GhcPs GhcPs body]
-> [LFixitySig GhcPs]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ LStmtLR GhcPs GhcPs body
s -> \[LFixitySig GhcPs]
acc -> case LStmtLR GhcPs GhcPs body
s of
(L SrcSpan
_ (LetStmt XLetStmt GhcPs GhcPs body
_ (L SrcSpan
_ (HsValBinds XHsValBinds GhcPs GhcPs
_ (ValBinds XValBinds GhcPs GhcPs
_ LHsBindsLR GhcPs GhcPs
_ [LSig GhcPs]
sigs))))) ->
(LSig GhcPs -> [LFixitySig GhcPs] -> [LFixitySig GhcPs])
-> [LFixitySig GhcPs] -> [LSig GhcPs] -> [LFixitySig GhcPs]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ LSig GhcPs
sig -> \ [LFixitySig GhcPs]
acc -> case LSig GhcPs
sig of
(L SrcSpan
loc (FixSig XFixSig GhcPs
_ FixitySig GhcPs
s)) -> (SrcSpan -> FixitySig GhcPs -> LFixitySig GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc FixitySig GhcPs
s) LFixitySig GhcPs -> [LFixitySig GhcPs] -> [LFixitySig GhcPs]
forall a. a -> [a] -> [a]
: [LFixitySig GhcPs]
acc
LSig GhcPs
_ -> [LFixitySig GhcPs]
acc) [LFixitySig GhcPs]
acc [LSig GhcPs]
sigs
LStmtLR GhcPs GhcPs body
_ -> [LFixitySig GhcPs]
acc) [] [LStmtLR GhcPs GhcPs body]
l
rn_rec_stmt_lhs :: Outputable body => MiniFixityEnv
-> LStmt GhcPs body
-> RnM [(LStmtLR GhcRn GhcPs body, FreeVars)]
rn_rec_stmt_lhs :: MiniFixityEnv
-> LStmt GhcPs body -> RnM [(LStmtLR GhcRn GhcPs body, FreeVars)]
rn_rec_stmt_lhs MiniFixityEnv
_ (L SrcSpan
loc (BodyStmt XBodyStmt GhcPs GhcPs body
_ body
body SyntaxExpr GhcPs
a SyntaxExpr GhcPs
b))
= [(LStmtLR GhcRn GhcPs body, FreeVars)]
-> RnM [(LStmtLR GhcRn GhcPs body, FreeVars)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(SrcSpan -> StmtLR GhcRn GhcPs body -> LStmtLR GhcRn GhcPs body
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc (XBodyStmt GhcRn GhcPs body
-> body
-> SyntaxExpr GhcPs
-> SyntaxExpr GhcPs
-> StmtLR GhcRn GhcPs body
forall idL idR body.
XBodyStmt idL idR body
-> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
BodyStmt XBodyStmt GhcRn GhcPs body
NoExtField
noExtField body
body SyntaxExpr GhcPs
a SyntaxExpr GhcPs
b), FreeVars
emptyFVs)]
rn_rec_stmt_lhs MiniFixityEnv
_ (L SrcSpan
loc (LastStmt XLastStmt GhcPs GhcPs body
_ body
body Bool
noret SyntaxExpr GhcPs
a))
= [(LStmtLR GhcRn GhcPs body, FreeVars)]
-> RnM [(LStmtLR GhcRn GhcPs body, FreeVars)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(SrcSpan -> StmtLR GhcRn GhcPs body -> LStmtLR GhcRn GhcPs body
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc (XLastStmt GhcRn GhcPs body
-> body -> Bool -> SyntaxExpr GhcPs -> StmtLR GhcRn GhcPs body
forall idL idR body.
XLastStmt idL idR body
-> body -> Bool -> SyntaxExpr idR -> StmtLR idL idR body
LastStmt XLastStmt GhcRn GhcPs body
NoExtField
noExtField body
body Bool
noret SyntaxExpr GhcPs
a), FreeVars
emptyFVs)]
rn_rec_stmt_lhs MiniFixityEnv
fix_env (L SrcSpan
loc (BindStmt XBindStmt GhcPs GhcPs body
_ LPat GhcPs
pat body
body SyntaxExpr GhcPs
a SyntaxExpr GhcPs
b))
= do
(Located (Pat GhcRn)
pat', FreeVars
fv_pat) <- NameMaker -> LPat GhcPs -> RnM (LPat GhcRn, FreeVars)
rnBindPat (MiniFixityEnv -> NameMaker
localRecNameMaker MiniFixityEnv
fix_env) LPat GhcPs
pat
[(LStmtLR GhcRn GhcPs body, FreeVars)]
-> RnM [(LStmtLR GhcRn GhcPs body, FreeVars)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(SrcSpan -> StmtLR GhcRn GhcPs body -> LStmtLR GhcRn GhcPs body
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc (XBindStmt GhcRn GhcPs body
-> LPat GhcRn
-> body
-> SyntaxExpr GhcPs
-> SyntaxExpr GhcPs
-> StmtLR GhcRn GhcPs body
forall idL idR body.
XBindStmt idL idR body
-> LPat idL
-> body
-> SyntaxExpr idR
-> SyntaxExpr idR
-> StmtLR idL idR body
BindStmt XBindStmt GhcRn GhcPs body
NoExtField
noExtField Located (Pat GhcRn)
LPat GhcRn
pat' body
body SyntaxExpr GhcPs
a SyntaxExpr GhcPs
b), FreeVars
fv_pat)]
rn_rec_stmt_lhs MiniFixityEnv
_ (L SrcSpan
_ (LetStmt XLetStmt GhcPs GhcPs body
_ (L SrcSpan
_ binds :: HsLocalBinds GhcPs
binds@(HsIPBinds {}))))
= MsgDoc -> RnM [(LStmtLR GhcRn GhcPs body, FreeVars)]
forall a. MsgDoc -> TcRn a
failWith (MsgDoc -> HsLocalBinds GhcPs -> MsgDoc
forall a. Outputable a => MsgDoc -> a -> MsgDoc
badIpBinds (String -> MsgDoc
text String
"an mdo expression") HsLocalBinds GhcPs
binds)
rn_rec_stmt_lhs MiniFixityEnv
fix_env (L SrcSpan
loc (LetStmt XLetStmt GhcPs GhcPs body
_ (L SrcSpan
l (HsValBinds XHsValBinds GhcPs GhcPs
x HsValBindsLR GhcPs GhcPs
binds))))
= do ([Name]
_bound_names, HsValBindsLR GhcRn GhcPs
binds') <- MiniFixityEnv
-> HsValBindsLR GhcPs GhcPs
-> RnM ([Name], HsValBindsLR GhcRn GhcPs)
rnLocalValBindsLHS MiniFixityEnv
fix_env HsValBindsLR GhcPs GhcPs
binds
[(LStmtLR GhcRn GhcPs body, FreeVars)]
-> RnM [(LStmtLR GhcRn GhcPs body, FreeVars)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(SrcSpan -> StmtLR GhcRn GhcPs body -> LStmtLR GhcRn GhcPs body
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc (XLetStmt GhcRn GhcPs body
-> LHsLocalBindsLR GhcRn GhcPs -> StmtLR GhcRn GhcPs body
forall idL idR body.
XLetStmt idL idR body
-> LHsLocalBindsLR idL idR -> StmtLR idL idR body
LetStmt XLetStmt GhcRn GhcPs body
NoExtField
noExtField (SrcSpan
-> HsLocalBindsLR GhcRn GhcPs -> LHsLocalBindsLR GhcRn GhcPs
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (XHsValBinds GhcRn GhcPs
-> HsValBindsLR GhcRn GhcPs -> HsLocalBindsLR GhcRn GhcPs
forall idL idR.
XHsValBinds idL idR
-> HsValBindsLR idL idR -> HsLocalBindsLR idL idR
HsValBinds XHsValBinds GhcPs GhcPs
XHsValBinds GhcRn GhcPs
x HsValBindsLR GhcRn GhcPs
binds'))),
FreeVars
emptyFVs
)]
rn_rec_stmt_lhs MiniFixityEnv
fix_env (L SrcSpan
_ (RecStmt { recS_stmts :: forall idL idR body. StmtLR idL idR body -> [LStmtLR idL idR body]
recS_stmts = [LStmt GhcPs body]
stmts }))
= MiniFixityEnv
-> [LStmt GhcPs body] -> RnM [(LStmtLR GhcRn GhcPs body, FreeVars)]
forall body.
Outputable body =>
MiniFixityEnv
-> [LStmt GhcPs body] -> RnM [(LStmtLR GhcRn GhcPs body, FreeVars)]
rn_rec_stmts_lhs MiniFixityEnv
fix_env [LStmt GhcPs body]
stmts
rn_rec_stmt_lhs MiniFixityEnv
_ stmt :: LStmt GhcPs body
stmt@(L SrcSpan
_ (ParStmt {}))
= String -> MsgDoc -> RnM [(LStmtLR GhcRn GhcPs body, FreeVars)]
forall a. HasCallStack => String -> MsgDoc -> a
pprPanic String
"rn_rec_stmt" (LStmt GhcPs body -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr LStmt GhcPs body
stmt)
rn_rec_stmt_lhs MiniFixityEnv
_ stmt :: LStmt GhcPs body
stmt@(L SrcSpan
_ (TransStmt {}))
= String -> MsgDoc -> RnM [(LStmtLR GhcRn GhcPs body, FreeVars)]
forall a. HasCallStack => String -> MsgDoc -> a
pprPanic String
"rn_rec_stmt" (LStmt GhcPs body -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr LStmt GhcPs body
stmt)
rn_rec_stmt_lhs MiniFixityEnv
_ stmt :: LStmt GhcPs body
stmt@(L SrcSpan
_ (ApplicativeStmt {}))
= String -> MsgDoc -> RnM [(LStmtLR GhcRn GhcPs body, FreeVars)]
forall a. HasCallStack => String -> MsgDoc -> a
pprPanic String
"rn_rec_stmt" (LStmt GhcPs body -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr LStmt GhcPs body
stmt)
rn_rec_stmt_lhs MiniFixityEnv
_ (L SrcSpan
_ (LetStmt XLetStmt GhcPs GhcPs body
_ (L SrcSpan
_ (EmptyLocalBinds XEmptyLocalBinds GhcPs GhcPs
_))))
= String -> RnM [(LStmtLR GhcRn GhcPs body, FreeVars)]
forall a. String -> a
panic String
"rn_rec_stmt LetStmt EmptyLocalBinds"
rn_rec_stmt_lhs MiniFixityEnv
_ (L SrcSpan
_ (LetStmt XLetStmt GhcPs GhcPs body
_ (L SrcSpan
_ (XHsLocalBindsLR XXHsLocalBindsLR GhcPs GhcPs
nec))))
= NoExtCon -> RnM [(LStmtLR GhcRn GhcPs body, FreeVars)]
forall a. NoExtCon -> a
noExtCon XXHsLocalBindsLR GhcPs GhcPs
NoExtCon
nec
rn_rec_stmt_lhs MiniFixityEnv
_ (L SrcSpan
_ (XStmtLR XXStmtLR GhcPs GhcPs body
nec))
= NoExtCon -> RnM [(LStmtLR GhcRn GhcPs body, FreeVars)]
forall a. NoExtCon -> a
noExtCon XXStmtLR GhcPs GhcPs body
NoExtCon
nec
rn_rec_stmts_lhs :: Outputable body => MiniFixityEnv
-> [LStmt GhcPs body]
-> RnM [(LStmtLR GhcRn GhcPs body, FreeVars)]
rn_rec_stmts_lhs :: MiniFixityEnv
-> [LStmt GhcPs body] -> RnM [(LStmtLR GhcRn GhcPs body, FreeVars)]
rn_rec_stmts_lhs MiniFixityEnv
fix_env [LStmt GhcPs body]
stmts
= do { [(LStmtLR GhcRn GhcPs body, FreeVars)]
ls <- (LStmt GhcPs body -> RnM [(LStmtLR GhcRn GhcPs body, FreeVars)])
-> [LStmt GhcPs body] -> RnM [(LStmtLR GhcRn GhcPs body, FreeVars)]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM (MiniFixityEnv
-> LStmt GhcPs body -> RnM [(LStmtLR GhcRn GhcPs body, FreeVars)]
forall body.
Outputable body =>
MiniFixityEnv
-> LStmt GhcPs body -> RnM [(LStmtLR GhcRn GhcPs body, FreeVars)]
rn_rec_stmt_lhs MiniFixityEnv
fix_env) [LStmt GhcPs body]
stmts
; let boundNames :: [IdP GhcRn]
boundNames = [LStmtLR GhcRn GhcPs body] -> [IdP GhcRn]
forall (idL :: Pass) (idR :: Pass) body.
[LStmtLR (GhcPass idL) (GhcPass idR) body] -> [IdP (GhcPass idL)]
collectLStmtsBinders (((LStmtLR GhcRn GhcPs body, FreeVars) -> LStmtLR GhcRn GhcPs body)
-> [(LStmtLR GhcRn GhcPs body, FreeVars)]
-> [LStmtLR GhcRn GhcPs body]
forall a b. (a -> b) -> [a] -> [b]
map (LStmtLR GhcRn GhcPs body, FreeVars) -> LStmtLR GhcRn GhcPs body
forall a b. (a, b) -> a
fst [(LStmtLR GhcRn GhcPs body, FreeVars)]
ls)
; [Name] -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkDupNames [Name]
[IdP GhcRn]
boundNames
; [(LStmtLR GhcRn GhcPs body, FreeVars)]
-> RnM [(LStmtLR GhcRn GhcPs body, FreeVars)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(LStmtLR GhcRn GhcPs body, FreeVars)]
ls }
rn_rec_stmt :: (Outputable (body GhcPs)) =>
(Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> [Name]
-> (LStmtLR GhcRn GhcPs (Located (body GhcPs)), FreeVars)
-> RnM [Segment (LStmt GhcRn (Located (body GhcRn)))]
rn_rec_stmt :: (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> [Name]
-> (LStmtLR GhcRn GhcPs (Located (body GhcPs)), FreeVars)
-> RnM [Segment (LStmt GhcRn (Located (body GhcRn)))]
rn_rec_stmt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody [Name]
_ (L SrcSpan
loc (LastStmt XLastStmt GhcRn GhcPs (Located (body GhcPs))
_ Located (body GhcPs)
body Bool
noret SyntaxExpr GhcPs
_), FreeVars
_)
= do { (Located (body GhcRn)
body', FreeVars
fv_expr) <- Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody Located (body GhcPs)
body
; (SyntaxExpr GhcRn
ret_op, FreeVars
fvs1) <- Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupSyntaxName Name
returnMName
; [Segment (LStmt GhcRn (Located (body GhcRn)))]
-> RnM [Segment (LStmt GhcRn (Located (body GhcRn)))]
forall (m :: * -> *) a. Monad m => a -> m a
return [(FreeVars
emptyNameSet, FreeVars
fv_expr FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs1, FreeVars
emptyNameSet,
SrcSpan
-> StmtLR GhcRn GhcRn (Located (body GhcRn))
-> LStmt GhcRn (Located (body GhcRn))
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc (XLastStmt GhcRn GhcRn (Located (body GhcRn))
-> Located (body GhcRn)
-> Bool
-> SyntaxExpr GhcRn
-> StmtLR GhcRn GhcRn (Located (body GhcRn))
forall idL idR body.
XLastStmt idL idR body
-> body -> Bool -> SyntaxExpr idR -> StmtLR idL idR body
LastStmt XLastStmt GhcRn GhcRn (Located (body GhcRn))
NoExtField
noExtField Located (body GhcRn)
body' Bool
noret SyntaxExpr GhcRn
ret_op))] }
rn_rec_stmt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody [Name]
_ (L SrcSpan
loc (BodyStmt XBodyStmt GhcRn GhcPs (Located (body GhcPs))
_ Located (body GhcPs)
body SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_), FreeVars
_)
= do { (Located (body GhcRn)
body', FreeVars
fvs) <- Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody Located (body GhcPs)
body
; (SyntaxExpr GhcRn
then_op, FreeVars
fvs1) <- Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupSyntaxName Name
thenMName
; [Segment (LStmt GhcRn (Located (body GhcRn)))]
-> RnM [Segment (LStmt GhcRn (Located (body GhcRn)))]
forall (m :: * -> *) a. Monad m => a -> m a
return [(FreeVars
emptyNameSet, FreeVars
fvs FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs1, FreeVars
emptyNameSet,
SrcSpan
-> StmtLR GhcRn GhcRn (Located (body GhcRn))
-> LStmt GhcRn (Located (body GhcRn))
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc (XBodyStmt GhcRn GhcRn (Located (body GhcRn))
-> Located (body GhcRn)
-> SyntaxExpr GhcRn
-> SyntaxExpr GhcRn
-> StmtLR GhcRn GhcRn (Located (body GhcRn))
forall idL idR body.
XBodyStmt idL idR body
-> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
BodyStmt XBodyStmt GhcRn GhcRn (Located (body GhcRn))
NoExtField
noExtField Located (body GhcRn)
body' SyntaxExpr GhcRn
then_op SyntaxExpr GhcRn
forall (p :: Pass). SyntaxExpr (GhcPass p)
noSyntaxExpr))] }
rn_rec_stmt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody [Name]
_ (L SrcSpan
loc (BindStmt XBindStmt GhcRn GhcPs (Located (body GhcPs))
_ LPat GhcRn
pat' Located (body GhcPs)
body SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_), FreeVars
fv_pat)
= do { (Located (body GhcRn)
body', FreeVars
fv_expr) <- Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody Located (body GhcPs)
body
; (SyntaxExpr GhcRn
bind_op, FreeVars
fvs1) <- Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupSyntaxName Name
bindMName
; (SyntaxExpr GhcRn
fail_op, FreeVars
fvs2) <- RnM (SyntaxExpr GhcRn, FreeVars)
getMonadFailOp
; let bndrs :: FreeVars
bndrs = [Name] -> FreeVars
mkNameSet (LPat GhcRn -> [IdP GhcRn]
forall (p :: Pass). LPat (GhcPass p) -> [IdP (GhcPass p)]
collectPatBinders LPat GhcRn
pat')
fvs :: FreeVars
fvs = FreeVars
fv_expr FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fv_pat FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs1 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs2
; [Segment (LStmt GhcRn (Located (body GhcRn)))]
-> RnM [Segment (LStmt GhcRn (Located (body GhcRn)))]
forall (m :: * -> *) a. Monad m => a -> m a
return [(FreeVars
bndrs, FreeVars
fvs, FreeVars
bndrs FreeVars -> FreeVars -> FreeVars
`intersectNameSet` FreeVars
fvs,
SrcSpan
-> StmtLR GhcRn GhcRn (Located (body GhcRn))
-> LStmt GhcRn (Located (body GhcRn))
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc (XBindStmt GhcRn GhcRn (Located (body GhcRn))
-> LPat GhcRn
-> Located (body GhcRn)
-> SyntaxExpr GhcRn
-> SyntaxExpr GhcRn
-> StmtLR GhcRn GhcRn (Located (body GhcRn))
forall idL idR body.
XBindStmt idL idR body
-> LPat idL
-> body
-> SyntaxExpr idR
-> SyntaxExpr idR
-> StmtLR idL idR body
BindStmt XBindStmt GhcRn GhcRn (Located (body GhcRn))
NoExtField
noExtField LPat GhcRn
pat' Located (body GhcRn)
body' SyntaxExpr GhcRn
bind_op SyntaxExpr GhcRn
fail_op))] }
rn_rec_stmt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
_ [Name]
_ (L SrcSpan
_ (LetStmt XLetStmt GhcRn GhcPs (Located (body GhcPs))
_ (L SrcSpan
_ binds :: HsLocalBindsLR GhcRn GhcPs
binds@(HsIPBinds {}))), FreeVars
_)
= MsgDoc -> RnM [Segment (LStmt GhcRn (Located (body GhcRn)))]
forall a. MsgDoc -> TcRn a
failWith (MsgDoc -> HsLocalBindsLR GhcRn GhcPs -> MsgDoc
forall a. Outputable a => MsgDoc -> a -> MsgDoc
badIpBinds (String -> MsgDoc
text String
"an mdo expression") HsLocalBindsLR GhcRn GhcPs
binds)
rn_rec_stmt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
_ [Name]
all_bndrs (L SrcSpan
loc (LetStmt XLetStmt GhcRn GhcPs (Located (body GhcPs))
_ (L SrcSpan
l (HsValBinds XHsValBinds GhcRn GhcPs
x HsValBindsLR GhcRn GhcPs
binds'))), FreeVars
_)
= do { (HsValBinds GhcRn
binds', DefUses
du_binds) <- FreeVars
-> HsValBindsLR GhcRn GhcPs -> RnM (HsValBinds GhcRn, DefUses)
rnLocalValBindsRHS ([Name] -> FreeVars
mkNameSet [Name]
all_bndrs) HsValBindsLR GhcRn GhcPs
binds'
; let fvs :: FreeVars
fvs = DefUses -> FreeVars
allUses DefUses
du_binds
; [Segment (LStmt GhcRn (Located (body GhcRn)))]
-> RnM [Segment (LStmt GhcRn (Located (body GhcRn)))]
forall (m :: * -> *) a. Monad m => a -> m a
return [(DefUses -> FreeVars
duDefs DefUses
du_binds, FreeVars
fvs, FreeVars
emptyNameSet,
SrcSpan
-> StmtLR GhcRn GhcRn (Located (body GhcRn))
-> LStmt GhcRn (Located (body GhcRn))
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc (XLetStmt GhcRn GhcRn (Located (body GhcRn))
-> LHsLocalBinds GhcRn -> StmtLR GhcRn GhcRn (Located (body GhcRn))
forall idL idR body.
XLetStmt idL idR body
-> LHsLocalBindsLR idL idR -> StmtLR idL idR body
LetStmt XLetStmt GhcRn GhcRn (Located (body GhcRn))
NoExtField
noExtField (SrcSpan -> HsLocalBinds GhcRn -> LHsLocalBinds GhcRn
forall l e. l -> e -> GenLocated l e
L SrcSpan
l (XHsValBinds GhcRn GhcRn -> HsValBinds GhcRn -> HsLocalBinds GhcRn
forall idL idR.
XHsValBinds idL idR
-> HsValBindsLR idL idR -> HsLocalBindsLR idL idR
HsValBinds XHsValBinds GhcRn GhcPs
XHsValBinds GhcRn GhcRn
x HsValBinds GhcRn
binds'))))] }
rn_rec_stmt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
_ [Name]
_ stmt :: (LStmtLR GhcRn GhcPs (Located (body GhcPs)), FreeVars)
stmt@(L SrcSpan
_ (RecStmt {}), FreeVars
_)
= String
-> MsgDoc -> RnM [Segment (LStmt GhcRn (Located (body GhcRn)))]
forall a. HasCallStack => String -> MsgDoc -> a
pprPanic String
"rn_rec_stmt: RecStmt" ((LStmtLR GhcRn GhcPs (Located (body GhcPs)), FreeVars) -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (LStmtLR GhcRn GhcPs (Located (body GhcPs)), FreeVars)
stmt)
rn_rec_stmt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
_ [Name]
_ stmt :: (LStmtLR GhcRn GhcPs (Located (body GhcPs)), FreeVars)
stmt@(L SrcSpan
_ (ParStmt {}), FreeVars
_)
= String
-> MsgDoc -> RnM [Segment (LStmt GhcRn (Located (body GhcRn)))]
forall a. HasCallStack => String -> MsgDoc -> a
pprPanic String
"rn_rec_stmt: ParStmt" ((LStmtLR GhcRn GhcPs (Located (body GhcPs)), FreeVars) -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (LStmtLR GhcRn GhcPs (Located (body GhcPs)), FreeVars)
stmt)
rn_rec_stmt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
_ [Name]
_ stmt :: (LStmtLR GhcRn GhcPs (Located (body GhcPs)), FreeVars)
stmt@(L SrcSpan
_ (TransStmt {}), FreeVars
_)
= String
-> MsgDoc -> RnM [Segment (LStmt GhcRn (Located (body GhcRn)))]
forall a. HasCallStack => String -> MsgDoc -> a
pprPanic String
"rn_rec_stmt: TransStmt" ((LStmtLR GhcRn GhcPs (Located (body GhcPs)), FreeVars) -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (LStmtLR GhcRn GhcPs (Located (body GhcPs)), FreeVars)
stmt)
rn_rec_stmt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
_ [Name]
_ (L SrcSpan
_ (LetStmt XLetStmt GhcRn GhcPs (Located (body GhcPs))
_ (L SrcSpan
_ (XHsLocalBindsLR XXHsLocalBindsLR GhcRn GhcPs
nec))), FreeVars
_)
= NoExtCon -> RnM [Segment (LStmt GhcRn (Located (body GhcRn)))]
forall a. NoExtCon -> a
noExtCon XXHsLocalBindsLR GhcRn GhcPs
NoExtCon
nec
rn_rec_stmt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
_ [Name]
_ (L SrcSpan
_ (LetStmt XLetStmt GhcRn GhcPs (Located (body GhcPs))
_ (L SrcSpan
_ (EmptyLocalBinds XEmptyLocalBinds GhcRn GhcPs
_))), FreeVars
_)
= String -> RnM [Segment (LStmt GhcRn (Located (body GhcRn)))]
forall a. String -> a
panic String
"rn_rec_stmt: LetStmt EmptyLocalBinds"
rn_rec_stmt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
_ [Name]
_ stmt :: (LStmtLR GhcRn GhcPs (Located (body GhcPs)), FreeVars)
stmt@(L SrcSpan
_ (ApplicativeStmt {}), FreeVars
_)
= String
-> MsgDoc -> RnM [Segment (LStmt GhcRn (Located (body GhcRn)))]
forall a. HasCallStack => String -> MsgDoc -> a
pprPanic String
"rn_rec_stmt: ApplicativeStmt" ((LStmtLR GhcRn GhcPs (Located (body GhcPs)), FreeVars) -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (LStmtLR GhcRn GhcPs (Located (body GhcPs)), FreeVars)
stmt)
rn_rec_stmt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
_ [Name]
_ (L SrcSpan
_ (XStmtLR XXStmtLR GhcRn GhcPs (Located (body GhcPs))
nec), FreeVars
_)
= NoExtCon -> RnM [Segment (LStmt GhcRn (Located (body GhcRn)))]
forall a. NoExtCon -> a
noExtCon XXStmtLR GhcRn GhcPs (Located (body GhcPs))
NoExtCon
nec
rn_rec_stmts :: Outputable (body GhcPs) =>
(Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> [Name]
-> [(LStmtLR GhcRn GhcPs (Located (body GhcPs)), FreeVars)]
-> RnM [Segment (LStmt GhcRn (Located (body GhcRn)))]
rn_rec_stmts :: (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> [Name]
-> [(LStmtLR GhcRn GhcPs (Located (body GhcPs)), FreeVars)]
-> RnM [Segment (LStmt GhcRn (Located (body GhcRn)))]
rn_rec_stmts Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody [Name]
bndrs [(LStmtLR GhcRn GhcPs (Located (body GhcPs)), FreeVars)]
stmts
= do { [[Segment (LStmt GhcRn (Located (body GhcRn)))]]
segs_s <- ((LStmtLR GhcRn GhcPs (Located (body GhcPs)), FreeVars)
-> RnM [Segment (LStmt GhcRn (Located (body GhcRn)))])
-> [(LStmtLR GhcRn GhcPs (Located (body GhcPs)), FreeVars)]
-> IOEnv
(Env TcGblEnv TcLclEnv)
[[Segment (LStmt GhcRn (Located (body GhcRn)))]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM ((Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> [Name]
-> (LStmtLR GhcRn GhcPs (Located (body GhcPs)), FreeVars)
-> RnM [Segment (LStmt GhcRn (Located (body GhcRn)))]
forall (body :: * -> *).
Outputable (body GhcPs) =>
(Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> [Name]
-> (LStmtLR GhcRn GhcPs (Located (body GhcPs)), FreeVars)
-> RnM [Segment (LStmt GhcRn (Located (body GhcRn)))]
rn_rec_stmt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody [Name]
bndrs) [(LStmtLR GhcRn GhcPs (Located (body GhcPs)), FreeVars)]
stmts
; [Segment (LStmt GhcRn (Located (body GhcRn)))]
-> RnM [Segment (LStmt GhcRn (Located (body GhcRn)))]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Segment (LStmt GhcRn (Located (body GhcRn)))]]
-> [Segment (LStmt GhcRn (Located (body GhcRn)))]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Segment (LStmt GhcRn (Located (body GhcRn)))]]
segs_s) }
segmentRecStmts :: SrcSpan -> HsStmtContext Name
-> Stmt GhcRn body
-> [Segment (LStmt GhcRn body)] -> FreeVars
-> ([LStmt GhcRn body], FreeVars)
segmentRecStmts :: SrcSpan
-> HsStmtContext Name
-> Stmt GhcRn body
-> [Segment (LStmt GhcRn body)]
-> FreeVars
-> ([LStmt GhcRn body], FreeVars)
segmentRecStmts SrcSpan
loc HsStmtContext Name
ctxt Stmt GhcRn body
empty_rec_stmt [Segment (LStmt GhcRn body)]
segs FreeVars
fvs_later
| [Segment (LStmt GhcRn body)] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Segment (LStmt GhcRn body)]
segs
= ([], FreeVars
fvs_later)
| HsStmtContext Name
MDoExpr <- HsStmtContext Name
ctxt
= Stmt GhcRn body
-> [Segment [LStmt GhcRn body]]
-> FreeVars
-> ([LStmt GhcRn body], FreeVars)
forall body.
Stmt GhcRn body
-> [Segment [LStmt GhcRn body]]
-> FreeVars
-> ([LStmt GhcRn body], FreeVars)
segsToStmts Stmt GhcRn body
empty_rec_stmt [Segment [LStmt GhcRn body]]
grouped_segs FreeVars
fvs_later
| Bool
otherwise
= ([ SrcSpan -> Stmt GhcRn body -> LStmt GhcRn body
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc (Stmt GhcRn body -> LStmt GhcRn body)
-> Stmt GhcRn body -> LStmt GhcRn body
forall a b. (a -> b) -> a -> b
$
Stmt GhcRn body
empty_rec_stmt { recS_stmts :: [LStmt GhcRn body]
recS_stmts = [LStmt GhcRn body]
ss
, recS_later_ids :: [IdP GhcRn]
recS_later_ids = FreeVars -> [Name]
nameSetElemsStable
(FreeVars
defs FreeVars -> FreeVars -> FreeVars
`intersectNameSet` FreeVars
fvs_later)
, recS_rec_ids :: [IdP GhcRn]
recS_rec_ids = FreeVars -> [Name]
nameSetElemsStable
(FreeVars
defs FreeVars -> FreeVars -> FreeVars
`intersectNameSet` FreeVars
uses) }]
, FreeVars
uses FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs_later)
where
([FreeVars]
defs_s, [FreeVars]
uses_s, [FreeVars]
_, [LStmt GhcRn body]
ss) = [Segment (LStmt GhcRn body)]
-> ([FreeVars], [FreeVars], [FreeVars], [LStmt GhcRn body])
forall a b c d. [(a, b, c, d)] -> ([a], [b], [c], [d])
unzip4 [Segment (LStmt GhcRn body)]
segs
defs :: FreeVars
defs = [FreeVars] -> FreeVars
plusFVs [FreeVars]
defs_s
uses :: FreeVars
uses = [FreeVars] -> FreeVars
plusFVs [FreeVars]
uses_s
segs_w_fwd_refs :: [Segment (LStmt GhcRn body)]
segs_w_fwd_refs = [Segment (LStmt GhcRn body)] -> [Segment (LStmt GhcRn body)]
forall a. [Segment a] -> [Segment a]
addFwdRefs [Segment (LStmt GhcRn body)]
segs
grouped_segs :: [Segment [LStmt GhcRn body]]
grouped_segs = HsStmtContext Name
-> [Segment (LStmt GhcRn body)] -> [Segment [LStmt GhcRn body]]
forall body.
HsStmtContext Name
-> [Segment (LStmt GhcRn body)] -> [Segment [LStmt GhcRn body]]
glomSegments HsStmtContext Name
ctxt [Segment (LStmt GhcRn body)]
segs_w_fwd_refs
addFwdRefs :: [Segment a] -> [Segment a]
addFwdRefs :: [Segment a] -> [Segment a]
addFwdRefs [Segment a]
segs
= ([Segment a], FreeVars) -> [Segment a]
forall a b. (a, b) -> a
fst ((Segment a -> ([Segment a], FreeVars) -> ([Segment a], FreeVars))
-> ([Segment a], FreeVars)
-> [Segment a]
-> ([Segment a], FreeVars)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr Segment a -> ([Segment a], FreeVars) -> ([Segment a], FreeVars)
forall d.
(FreeVars, FreeVars, FreeVars, d)
-> ([(FreeVars, FreeVars, FreeVars, d)], FreeVars)
-> ([(FreeVars, FreeVars, FreeVars, d)], FreeVars)
mk_seg ([], FreeVars
emptyNameSet) [Segment a]
segs)
where
mk_seg :: (FreeVars, FreeVars, FreeVars, d)
-> ([(FreeVars, FreeVars, FreeVars, d)], FreeVars)
-> ([(FreeVars, FreeVars, FreeVars, d)], FreeVars)
mk_seg (FreeVars
defs, FreeVars
uses, FreeVars
fwds, d
stmts) ([(FreeVars, FreeVars, FreeVars, d)]
segs, FreeVars
later_defs)
= ((FreeVars, FreeVars, FreeVars, d)
new_seg (FreeVars, FreeVars, FreeVars, d)
-> [(FreeVars, FreeVars, FreeVars, d)]
-> [(FreeVars, FreeVars, FreeVars, d)]
forall a. a -> [a] -> [a]
: [(FreeVars, FreeVars, FreeVars, d)]
segs, FreeVars
all_defs)
where
new_seg :: (FreeVars, FreeVars, FreeVars, d)
new_seg = (FreeVars
defs, FreeVars
uses, FreeVars
new_fwds, d
stmts)
all_defs :: FreeVars
all_defs = FreeVars
later_defs FreeVars -> FreeVars -> FreeVars
`unionNameSet` FreeVars
defs
new_fwds :: FreeVars
new_fwds = FreeVars
fwds FreeVars -> FreeVars -> FreeVars
`unionNameSet` (FreeVars
uses FreeVars -> FreeVars -> FreeVars
`intersectNameSet` FreeVars
later_defs)
glomSegments :: HsStmtContext Name
-> [Segment (LStmt GhcRn body)]
-> [Segment [LStmt GhcRn body]]
glomSegments :: HsStmtContext Name
-> [Segment (LStmt GhcRn body)] -> [Segment [LStmt GhcRn body]]
glomSegments HsStmtContext Name
_ [] = []
glomSegments HsStmtContext Name
ctxt ((FreeVars
defs,FreeVars
uses,FreeVars
fwds,LStmt GhcRn body
stmt) : [Segment (LStmt GhcRn body)]
segs)
= (FreeVars
seg_defs, FreeVars
seg_uses, FreeVars
seg_fwds, [LStmt GhcRn body]
seg_stmts) Segment [LStmt GhcRn body]
-> [Segment [LStmt GhcRn body]] -> [Segment [LStmt GhcRn body]]
forall a. a -> [a] -> [a]
: [Segment [LStmt GhcRn body]]
others
where
segs' :: [Segment [LStmt GhcRn body]]
segs' = HsStmtContext Name
-> [Segment (LStmt GhcRn body)] -> [Segment [LStmt GhcRn body]]
forall body.
HsStmtContext Name
-> [Segment (LStmt GhcRn body)] -> [Segment [LStmt GhcRn body]]
glomSegments HsStmtContext Name
ctxt [Segment (LStmt GhcRn body)]
segs
([Segment [LStmt GhcRn body]]
extras, [Segment [LStmt GhcRn body]]
others) = FreeVars
-> [Segment [LStmt GhcRn body]]
-> ([Segment [LStmt GhcRn body]], [Segment [LStmt GhcRn body]])
forall a. FreeVars -> [Segment a] -> ([Segment a], [Segment a])
grab FreeVars
uses [Segment [LStmt GhcRn body]]
segs'
([FreeVars]
ds, [FreeVars]
us, [FreeVars]
fs, [[LStmt GhcRn body]]
ss) = [Segment [LStmt GhcRn body]]
-> ([FreeVars], [FreeVars], [FreeVars], [[LStmt GhcRn body]])
forall a b c d. [(a, b, c, d)] -> ([a], [b], [c], [d])
unzip4 [Segment [LStmt GhcRn body]]
extras
seg_defs :: FreeVars
seg_defs = [FreeVars] -> FreeVars
plusFVs [FreeVars]
ds FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
defs
seg_uses :: FreeVars
seg_uses = [FreeVars] -> FreeVars
plusFVs [FreeVars]
us FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
uses
seg_fwds :: FreeVars
seg_fwds = [FreeVars] -> FreeVars
plusFVs [FreeVars]
fs FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fwds
seg_stmts :: [LStmt GhcRn body]
seg_stmts = LStmt GhcRn body
stmt LStmt GhcRn body -> [LStmt GhcRn body] -> [LStmt GhcRn body]
forall a. a -> [a] -> [a]
: [[LStmt GhcRn body]] -> [LStmt GhcRn body]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[LStmt GhcRn body]]
ss
grab :: NameSet
-> [Segment a]
-> ([Segment a],
[Segment a])
grab :: FreeVars -> [Segment a] -> ([Segment a], [Segment a])
grab FreeVars
uses [Segment a]
dus
= ([Segment a] -> [Segment a]
forall a. [a] -> [a]
reverse [Segment a]
yeses, [Segment a] -> [Segment a]
forall a. [a] -> [a]
reverse [Segment a]
noes)
where
([Segment a]
noes, [Segment a]
yeses) = (Segment a -> Bool) -> [Segment a] -> ([Segment a], [Segment a])
forall a. (a -> Bool) -> [a] -> ([a], [a])
span Segment a -> Bool
not_needed ([Segment a] -> [Segment a]
forall a. [a] -> [a]
reverse [Segment a]
dus)
not_needed :: Segment a -> Bool
not_needed (FreeVars
defs,FreeVars
_,FreeVars
_,a
_) = Bool -> Bool
not (FreeVars -> FreeVars -> Bool
intersectsNameSet FreeVars
defs FreeVars
uses)
segsToStmts :: Stmt GhcRn body
-> [Segment [LStmt GhcRn body]]
-> FreeVars
-> ([LStmt GhcRn body], FreeVars)
segsToStmts :: Stmt GhcRn body
-> [Segment [LStmt GhcRn body]]
-> FreeVars
-> ([LStmt GhcRn body], FreeVars)
segsToStmts Stmt GhcRn body
_ [] FreeVars
fvs_later = ([], FreeVars
fvs_later)
segsToStmts Stmt GhcRn body
empty_rec_stmt ((FreeVars
defs, FreeVars
uses, FreeVars
fwds, [LStmt GhcRn body]
ss) : [Segment [LStmt GhcRn body]]
segs) FreeVars
fvs_later
= ASSERT( not (null ss) )
(LStmt GhcRn body
new_stmt LStmt GhcRn body -> [LStmt GhcRn body] -> [LStmt GhcRn body]
forall a. a -> [a] -> [a]
: [LStmt GhcRn body]
later_stmts, FreeVars
later_uses FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
uses)
where
([LStmt GhcRn body]
later_stmts, FreeVars
later_uses) = Stmt GhcRn body
-> [Segment [LStmt GhcRn body]]
-> FreeVars
-> ([LStmt GhcRn body], FreeVars)
forall body.
Stmt GhcRn body
-> [Segment [LStmt GhcRn body]]
-> FreeVars
-> ([LStmt GhcRn body], FreeVars)
segsToStmts Stmt GhcRn body
empty_rec_stmt [Segment [LStmt GhcRn body]]
segs FreeVars
fvs_later
new_stmt :: LStmt GhcRn body
new_stmt | Bool
non_rec = [LStmt GhcRn body] -> LStmt GhcRn body
forall a. [a] -> a
head [LStmt GhcRn body]
ss
| Bool
otherwise = SrcSpan -> SrcSpanLess (LStmt GhcRn body) -> LStmt GhcRn body
forall a. HasSrcSpan a => SrcSpan -> SrcSpanLess a -> a
cL (LStmt GhcRn body -> SrcSpan
forall a. HasSrcSpan a => a -> SrcSpan
getLoc ([LStmt GhcRn body] -> LStmt GhcRn body
forall a. [a] -> a
head [LStmt GhcRn body]
ss)) SrcSpanLess (LStmt GhcRn body)
Stmt GhcRn body
rec_stmt
rec_stmt :: Stmt GhcRn body
rec_stmt = Stmt GhcRn body
empty_rec_stmt { recS_stmts :: [LStmt GhcRn body]
recS_stmts = [LStmt GhcRn body]
ss
, recS_later_ids :: [IdP GhcRn]
recS_later_ids = FreeVars -> [Name]
nameSetElemsStable FreeVars
used_later
, recS_rec_ids :: [IdP GhcRn]
recS_rec_ids = FreeVars -> [Name]
nameSetElemsStable FreeVars
fwds }
non_rec :: Bool
non_rec = [LStmt GhcRn body] -> Bool
forall a. [a] -> Bool
isSingleton [LStmt GhcRn body]
ss Bool -> Bool -> Bool
&& FreeVars -> Bool
isEmptyNameSet FreeVars
fwds
used_later :: FreeVars
used_later = FreeVars
defs FreeVars -> FreeVars -> FreeVars
`intersectNameSet` FreeVars
later_uses
data MonadNames = MonadNames { MonadNames -> Name
return_name, MonadNames -> Name
pure_name :: Name }
instance Outputable MonadNames where
ppr :: MonadNames -> MsgDoc
ppr (MonadNames {return_name :: MonadNames -> Name
return_name=Name
return_name,pure_name :: MonadNames -> Name
pure_name=Name
pure_name}) =
[MsgDoc] -> MsgDoc
hcat
[String -> MsgDoc
text String
"MonadNames { return_name = "
,Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Name
return_name
,String -> MsgDoc
text String
", pure_name = "
,Name -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Name
pure_name
,String -> MsgDoc
text String
"}"
]
rearrangeForApplicativeDo
:: HsStmtContext Name
-> [(ExprLStmt GhcRn, FreeVars)]
-> RnM ([ExprLStmt GhcRn], FreeVars)
rearrangeForApplicativeDo :: HsStmtContext Name
-> [(LStmt GhcRn (LHsExpr GhcRn), FreeVars)]
-> RnM ([LStmt GhcRn (LHsExpr GhcRn)], FreeVars)
rearrangeForApplicativeDo HsStmtContext Name
_ [] = ([LStmt GhcRn (LHsExpr GhcRn)], FreeVars)
-> RnM ([LStmt GhcRn (LHsExpr GhcRn)], FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], FreeVars
emptyNameSet)
rearrangeForApplicativeDo HsStmtContext Name
_ [(LStmt GhcRn (LHsExpr GhcRn)
one,FreeVars
_)] = ([LStmt GhcRn (LHsExpr GhcRn)], FreeVars)
-> RnM ([LStmt GhcRn (LHsExpr GhcRn)], FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return ([LStmt GhcRn (LHsExpr GhcRn)
one], FreeVars
emptyNameSet)
rearrangeForApplicativeDo HsStmtContext Name
ctxt [(LStmt GhcRn (LHsExpr GhcRn), FreeVars)]
stmts0 = do
Bool
optimal_ado <- GeneralFlag -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. GeneralFlag -> TcRnIf gbl lcl Bool
goptM GeneralFlag
Opt_OptimalApplicativeDo
let stmt_tree :: ExprStmtTree
stmt_tree | Bool
optimal_ado = [(LStmt GhcRn (LHsExpr GhcRn), FreeVars)] -> ExprStmtTree
mkStmtTreeOptimal [(LStmt GhcRn (LHsExpr GhcRn), FreeVars)]
stmts
| Bool
otherwise = [(LStmt GhcRn (LHsExpr GhcRn), FreeVars)] -> ExprStmtTree
mkStmtTreeHeuristic [(LStmt GhcRn (LHsExpr GhcRn), FreeVars)]
stmts
String -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"rearrangeForADo" (ExprStmtTree -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr ExprStmtTree
stmt_tree)
Name
return_name <- Name -> RnM Name
lookupSyntaxName' Name
returnMName
Name
pure_name <- Name -> RnM Name
lookupSyntaxName' Name
pureAName
let monad_names :: MonadNames
monad_names = MonadNames :: Name -> Name -> MonadNames
MonadNames { return_name :: Name
return_name = Name
return_name
, pure_name :: Name
pure_name = Name
pure_name }
MonadNames
-> HsStmtContext Name
-> ExprStmtTree
-> [LStmt GhcRn (LHsExpr GhcRn)]
-> FreeVars
-> RnM ([LStmt GhcRn (LHsExpr GhcRn)], FreeVars)
stmtTreeToStmts MonadNames
monad_names HsStmtContext Name
ctxt ExprStmtTree
stmt_tree [LStmt GhcRn (LHsExpr GhcRn)
last] FreeVars
last_fvs
where
([(LStmt GhcRn (LHsExpr GhcRn), FreeVars)]
stmts,(LStmt GhcRn (LHsExpr GhcRn)
last,FreeVars
last_fvs)) = [(LStmt GhcRn (LHsExpr GhcRn), FreeVars)]
-> ([(LStmt GhcRn (LHsExpr GhcRn), FreeVars)],
(LStmt GhcRn (LHsExpr GhcRn), FreeVars))
forall a. [a] -> ([a], a)
findLast [(LStmt GhcRn (LHsExpr GhcRn), FreeVars)]
stmts0
findLast :: [a] -> ([a], a)
findLast [] = String -> ([a], a)
forall a. HasCallStack => String -> a
error String
"findLast"
findLast [a
last] = ([],a
last)
findLast (a
x:[a]
xs) = (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:[a]
rest,a
last) where ([a]
rest,a
last) = [a] -> ([a], a)
findLast [a]
xs
data StmtTree a
= StmtTreeOne a
| StmtTreeBind (StmtTree a) (StmtTree a)
| StmtTreeApplicative [StmtTree a]
instance Outputable a => Outputable (StmtTree a) where
ppr :: StmtTree a -> MsgDoc
ppr (StmtTreeOne a
x) = MsgDoc -> MsgDoc
parens (String -> MsgDoc
text String
"StmtTreeOne" MsgDoc -> MsgDoc -> MsgDoc
<+> a -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr a
x)
ppr (StmtTreeBind StmtTree a
x StmtTree a
y) = MsgDoc -> MsgDoc
parens (MsgDoc -> Int -> MsgDoc -> MsgDoc
hang (String -> MsgDoc
text String
"StmtTreeBind")
Int
2 ([MsgDoc] -> MsgDoc
sep [StmtTree a -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr StmtTree a
x, StmtTree a -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr StmtTree a
y]))
ppr (StmtTreeApplicative [StmtTree a]
xs) = MsgDoc -> MsgDoc
parens (MsgDoc -> Int -> MsgDoc -> MsgDoc
hang (String -> MsgDoc
text String
"StmtTreeApplicative")
Int
2 ([MsgDoc] -> MsgDoc
vcat ((StmtTree a -> MsgDoc) -> [StmtTree a] -> [MsgDoc]
forall a b. (a -> b) -> [a] -> [b]
map StmtTree a -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr [StmtTree a]
xs)))
flattenStmtTree :: StmtTree a -> [a]
flattenStmtTree :: StmtTree a -> [a]
flattenStmtTree StmtTree a
t = StmtTree a -> [a] -> [a]
forall a. StmtTree a -> [a] -> [a]
go StmtTree a
t []
where
go :: StmtTree a -> [a] -> [a]
go (StmtTreeOne a
a) [a]
as = a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
as
go (StmtTreeBind StmtTree a
l StmtTree a
r) [a]
as = StmtTree a -> [a] -> [a]
go StmtTree a
l (StmtTree a -> [a] -> [a]
go StmtTree a
r [a]
as)
go (StmtTreeApplicative [StmtTree a]
ts) [a]
as = (StmtTree a -> [a] -> [a]) -> [a] -> [StmtTree a] -> [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr StmtTree a -> [a] -> [a]
go [a]
as [StmtTree a]
ts
type ExprStmtTree = StmtTree (ExprLStmt GhcRn, FreeVars)
type Cost = Int
mkStmtTreeHeuristic :: [(ExprLStmt GhcRn, FreeVars)] -> ExprStmtTree
mkStmtTreeHeuristic :: [(LStmt GhcRn (LHsExpr GhcRn), FreeVars)] -> ExprStmtTree
mkStmtTreeHeuristic [(LStmt GhcRn (LHsExpr GhcRn), FreeVars)
one] = (LStmt GhcRn (LHsExpr GhcRn), FreeVars) -> ExprStmtTree
forall a. a -> StmtTree a
StmtTreeOne (LStmt GhcRn (LHsExpr GhcRn), FreeVars)
one
mkStmtTreeHeuristic [(LStmt GhcRn (LHsExpr GhcRn), FreeVars)]
stmts =
case [(LStmt GhcRn (LHsExpr GhcRn), FreeVars)]
-> [[(LStmt GhcRn (LHsExpr GhcRn), FreeVars)]]
segments [(LStmt GhcRn (LHsExpr GhcRn), FreeVars)]
stmts of
[[(LStmt GhcRn (LHsExpr GhcRn), FreeVars)]
one] -> [(LStmt GhcRn (LHsExpr GhcRn), FreeVars)] -> ExprStmtTree
split [(LStmt GhcRn (LHsExpr GhcRn), FreeVars)]
one
[[(LStmt GhcRn (LHsExpr GhcRn), FreeVars)]]
segs -> [ExprStmtTree] -> ExprStmtTree
forall a. [StmtTree a] -> StmtTree a
StmtTreeApplicative (([(LStmt GhcRn (LHsExpr GhcRn), FreeVars)] -> ExprStmtTree)
-> [[(LStmt GhcRn (LHsExpr GhcRn), FreeVars)]] -> [ExprStmtTree]
forall a b. (a -> b) -> [a] -> [b]
map [(LStmt GhcRn (LHsExpr GhcRn), FreeVars)] -> ExprStmtTree
split [[(LStmt GhcRn (LHsExpr GhcRn), FreeVars)]]
segs)
where
split :: [(LStmt GhcRn (LHsExpr GhcRn), FreeVars)] -> ExprStmtTree
split [(LStmt GhcRn (LHsExpr GhcRn), FreeVars)
one] = (LStmt GhcRn (LHsExpr GhcRn), FreeVars) -> ExprStmtTree
forall a. a -> StmtTree a
StmtTreeOne (LStmt GhcRn (LHsExpr GhcRn), FreeVars)
one
split [(LStmt GhcRn (LHsExpr GhcRn), FreeVars)]
stmts =
ExprStmtTree -> ExprStmtTree -> ExprStmtTree
forall a. StmtTree a -> StmtTree a -> StmtTree a
StmtTreeBind ([(LStmt GhcRn (LHsExpr GhcRn), FreeVars)] -> ExprStmtTree
mkStmtTreeHeuristic [(LStmt GhcRn (LHsExpr GhcRn), FreeVars)]
before) ([(LStmt GhcRn (LHsExpr GhcRn), FreeVars)] -> ExprStmtTree
mkStmtTreeHeuristic [(LStmt GhcRn (LHsExpr GhcRn), FreeVars)]
after)
where ([(LStmt GhcRn (LHsExpr GhcRn), FreeVars)]
before, [(LStmt GhcRn (LHsExpr GhcRn), FreeVars)]
after) = [(LStmt GhcRn (LHsExpr GhcRn), FreeVars)]
-> ([(LStmt GhcRn (LHsExpr GhcRn), FreeVars)],
[(LStmt GhcRn (LHsExpr GhcRn), FreeVars)])
splitSegment [(LStmt GhcRn (LHsExpr GhcRn), FreeVars)]
stmts
mkStmtTreeOptimal :: [(ExprLStmt GhcRn, FreeVars)] -> ExprStmtTree
mkStmtTreeOptimal :: [(LStmt GhcRn (LHsExpr GhcRn), FreeVars)] -> ExprStmtTree
mkStmtTreeOptimal [(LStmt GhcRn (LHsExpr GhcRn), FreeVars)]
stmts =
ASSERT(not (null stmts))
(ExprStmtTree, Int) -> ExprStmtTree
forall a b. (a, b) -> a
fst (Array (Int, Int) (ExprStmtTree, Int)
arr Array (Int, Int) (ExprStmtTree, Int)
-> (Int, Int) -> (ExprStmtTree, Int)
forall i e. Ix i => Array i e -> i -> e
! (Int
0,Int
n))
where
n :: Int
n = [(LStmt GhcRn (LHsExpr GhcRn), FreeVars)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(LStmt GhcRn (LHsExpr GhcRn), FreeVars)]
stmts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
stmt_arr :: Array Int (LStmt GhcRn (LHsExpr GhcRn), FreeVars)
stmt_arr = (Int, Int)
-> [(LStmt GhcRn (LHsExpr GhcRn), FreeVars)]
-> Array Int (LStmt GhcRn (LHsExpr GhcRn), FreeVars)
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
n) [(LStmt GhcRn (LHsExpr GhcRn), FreeVars)]
stmts
arr :: Array (Int,Int) (ExprStmtTree, Cost)
arr :: Array (Int, Int) (ExprStmtTree, Int)
arr = ((Int, Int), (Int, Int))
-> [((Int, Int), (ExprStmtTree, Int))]
-> Array (Int, Int) (ExprStmtTree, Int)
forall i e. Ix i => (i, i) -> [(i, e)] -> Array i e
array ((Int
0,Int
0),(Int
n,Int
n))
[ ((Int
lo,Int
hi), Int -> Int -> (ExprStmtTree, Int)
tree Int
lo Int
hi)
| Int
lo <- [Int
0..Int
n]
, Int
hi <- [Int
lo..Int
n] ]
tree :: Int -> Int -> (ExprStmtTree, Int)
tree Int
lo Int
hi
| Int
hi Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lo = ((LStmt GhcRn (LHsExpr GhcRn), FreeVars) -> ExprStmtTree
forall a. a -> StmtTree a
StmtTreeOne (Array Int (LStmt GhcRn (LHsExpr GhcRn), FreeVars)
stmt_arr Array Int (LStmt GhcRn (LHsExpr GhcRn), FreeVars)
-> Int -> (LStmt GhcRn (LHsExpr GhcRn), FreeVars)
forall i e. Ix i => Array i e -> i -> e
! Int
lo), Int
1)
| Bool
otherwise =
case [(LStmt GhcRn (LHsExpr GhcRn), FreeVars)]
-> [[(LStmt GhcRn (LHsExpr GhcRn), FreeVars)]]
segments [ Array Int (LStmt GhcRn (LHsExpr GhcRn), FreeVars)
stmt_arr Array Int (LStmt GhcRn (LHsExpr GhcRn), FreeVars)
-> Int -> (LStmt GhcRn (LHsExpr GhcRn), FreeVars)
forall i e. Ix i => Array i e -> i -> e
! Int
i | Int
i <- [Int
lo..Int
hi] ] of
[] -> String -> (ExprStmtTree, Int)
forall a. String -> a
panic String
"mkStmtTree"
[[(LStmt GhcRn (LHsExpr GhcRn), FreeVars)]
_one] -> Int -> Int -> (ExprStmtTree, Int)
split Int
lo Int
hi
[[(LStmt GhcRn (LHsExpr GhcRn), FreeVars)]]
segs -> ([ExprStmtTree] -> ExprStmtTree
forall a. [StmtTree a] -> StmtTree a
StmtTreeApplicative [ExprStmtTree]
trees, [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
costs)
where
bounds :: [(Int, Int)]
bounds = ((Int, Int)
-> [(LStmt GhcRn (LHsExpr GhcRn), FreeVars)] -> (Int, Int))
-> (Int, Int)
-> [[(LStmt GhcRn (LHsExpr GhcRn), FreeVars)]]
-> [(Int, Int)]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (\(Int
_,Int
hi) [(LStmt GhcRn (LHsExpr GhcRn), FreeVars)]
a -> (Int
hiInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1, Int
hi Int -> Int -> Int
forall a. Num a => a -> a -> a
+ [(LStmt GhcRn (LHsExpr GhcRn), FreeVars)] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(LStmt GhcRn (LHsExpr GhcRn), FreeVars)]
a)) (Int
0,Int
loInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [[(LStmt GhcRn (LHsExpr GhcRn), FreeVars)]]
segs
([ExprStmtTree]
trees,[Int]
costs) = [(ExprStmtTree, Int)] -> ([ExprStmtTree], [Int])
forall a b. [(a, b)] -> ([a], [b])
unzip (((Int, Int) -> (ExprStmtTree, Int))
-> [(Int, Int)] -> [(ExprStmtTree, Int)]
forall a b. (a -> b) -> [a] -> [b]
map ((Int -> Int -> (ExprStmtTree, Int))
-> (Int, Int) -> (ExprStmtTree, Int)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int -> Int -> (ExprStmtTree, Int)
split) ([(Int, Int)] -> [(Int, Int)]
forall a. [a] -> [a]
tail [(Int, Int)]
bounds))
split :: Int -> Int -> (ExprStmtTree, Cost)
split :: Int -> Int -> (ExprStmtTree, Int)
split Int
lo Int
hi
| Int
hi Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lo = ((LStmt GhcRn (LHsExpr GhcRn), FreeVars) -> ExprStmtTree
forall a. a -> StmtTree a
StmtTreeOne (Array Int (LStmt GhcRn (LHsExpr GhcRn), FreeVars)
stmt_arr Array Int (LStmt GhcRn (LHsExpr GhcRn), FreeVars)
-> Int -> (LStmt GhcRn (LHsExpr GhcRn), FreeVars)
forall i e. Ix i => Array i e -> i -> e
! Int
lo), Int
1)
| Bool
otherwise = (ExprStmtTree -> ExprStmtTree -> ExprStmtTree
forall a. StmtTree a -> StmtTree a -> StmtTree a
StmtTreeBind ExprStmtTree
before ExprStmtTree
after, Int
c1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
c2)
wher