{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-incomplete-record-updates #-}
{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
module GHC.Rename.Expr (
rnLExpr, rnExpr, rnStmts
) where
#include "GhclibHsVersions.h"
import GHC.Prelude
import GHC.Rename.Bind ( rnLocalBindsAndThen, rnLocalValBindsLHS, rnLocalValBindsRHS
, rnMatchGroup, rnGRHS, makeMiniFixityEnv)
import GHC.Hs
import GHC.Tc.Utils.Env ( isBrackStage )
import GHC.Tc.Utils.Monad
import GHC.Unit.Module ( getModule )
import GHC.Rename.Env
import GHC.Rename.Fixity
import GHC.Rename.Utils ( HsDocContext(..), bindLocalNamesFV, checkDupNames
, bindLocalNames
, mapMaybeFvRn, mapFvRn
, warnUnusedLocalBinds, typeAppErr
, checkUnusedRecordWildcard )
import GHC.Rename.Unbound ( reportUnboundName )
import GHC.Rename.Splice ( rnBracket, rnSpliceExpr, checkThLocalName )
import GHC.Rename.HsType
import GHC.Rename.Pat
import GHC.Driver.Session
import GHC.Builtin.Names
import GHC.Types.Fixity
import GHC.Types.Name
import GHC.Types.Name.Set
import GHC.Types.Name.Reader
import GHC.Types.Unique.Set
import GHC.Types.SourceText
import Data.List
import Data.Maybe (isJust, isNothing)
import GHC.Utils.Misc
import GHC.Data.List.SetOps ( removeDups )
import GHC.Utils.Error
import GHC.Utils.Panic
import GHC.Utils.Outputable as Outputable
import GHC.Types.SrcLoc
import GHC.Data.FastString
import Control.Monad
import GHC.Builtin.Types ( nilDataConName )
import qualified GHC.LanguageExtensions as LangExt
import Control.Arrow (first)
import Data.Ord
import Data.Array
import qualified Data.List.NonEmpty as NE
rnExprs :: [LHsExpr GhcPs] -> RnM ([LHsExpr GhcRn], FreeVars)
rnExprs :: [LHsExpr GhcPs] -> RnM ([LHsExpr GhcRn], FreeVars)
rnExprs [LHsExpr GhcPs]
ls = [Located (HsExpr GhcPs)]
-> FreeVars
-> IOEnv
(Env TcGblEnv TcLclEnv) ([Located (HsExpr GhcRn)], FreeVars)
rnExprs' [Located (HsExpr GhcPs)]
[LHsExpr GhcPs]
ls FreeVars
forall a. UniqSet a
emptyUniqSet
where
rnExprs' :: [Located (HsExpr GhcPs)]
-> FreeVars
-> IOEnv
(Env TcGblEnv TcLclEnv) ([Located (HsExpr GhcRn)], FreeVars)
rnExprs' [] FreeVars
acc = ([Located (HsExpr GhcRn)], FreeVars)
-> IOEnv
(Env TcGblEnv TcLclEnv) ([Located (HsExpr GhcRn)], FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], FreeVars
acc)
rnExprs' (Located (HsExpr GhcPs)
expr:[Located (HsExpr GhcPs)]
exprs) FreeVars
acc =
do { (Located (HsExpr GhcRn)
expr', FreeVars
fvExpr) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr Located (HsExpr GhcPs)
LHsExpr GhcPs
expr
; let acc' :: FreeVars
acc' = FreeVars
acc FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvExpr
; ([Located (HsExpr GhcRn)]
exprs', FreeVars
fvExprs) <- FreeVars
acc' FreeVars
-> IOEnv
(Env TcGblEnv TcLclEnv) ([Located (HsExpr GhcRn)], FreeVars)
-> IOEnv
(Env TcGblEnv TcLclEnv) ([Located (HsExpr GhcRn)], FreeVars)
`seq` [Located (HsExpr GhcPs)]
-> FreeVars
-> IOEnv
(Env TcGblEnv TcLclEnv) ([Located (HsExpr GhcRn)], FreeVars)
rnExprs' [Located (HsExpr GhcPs)]
exprs FreeVars
acc'
; ([Located (HsExpr GhcRn)], FreeVars)
-> IOEnv
(Env TcGblEnv TcLclEnv) ([Located (HsExpr GhcRn)], FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (Located (HsExpr GhcRn)
expr'Located (HsExpr GhcRn)
-> [Located (HsExpr GhcRn)] -> [Located (HsExpr GhcRn)]
forall a. a -> [a] -> [a]
:[Located (HsExpr GhcRn)]
exprs', FreeVars
fvExprs) }
rnLExpr :: LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr :: LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr = (HsExpr GhcPs -> TcM (HsExpr GhcRn, FreeVars))
-> Located (HsExpr GhcPs)
-> IOEnv (Env TcGblEnv TcLclEnv) (Located (HsExpr GhcRn), FreeVars)
forall a b c. (a -> TcM (b, c)) -> Located a -> TcM (Located b, c)
wrapLocFstM HsExpr GhcPs -> TcM (HsExpr GhcRn, FreeVars)
rnExpr
rnExpr :: HsExpr GhcPs -> RnM (HsExpr GhcRn, FreeVars)
finishHsVar :: Located Name -> RnM (HsExpr GhcRn, FreeVars)
finishHsVar :: Located Name -> TcM (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) -> TcM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XVar GhcRn -> LIdP GhcRn -> HsExpr GhcRn
forall p. XVar p -> LIdP p -> HsExpr p
HsVar NoExtField
XVar GhcRn
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 -> TcM (HsExpr GhcRn, FreeVars)
rnUnboundVar RdrName
v =
if RdrName -> Bool
isUnqual RdrName
v
then
(HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XUnboundVar GhcRn -> OccName -> HsExpr GhcRn
forall p. XUnboundVar p -> OccName -> HsExpr p
HsUnboundVar NoExtField
XUnboundVar GhcRn
noExtField (RdrName -> OccName
rdrNameOcc RdrName
v), FreeVars
emptyFVs)
else
do { Name
n <- RdrName -> RnM Name
reportUnboundName RdrName
v
; (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XVar GhcRn -> LIdP GhcRn -> HsExpr GhcRn
forall p. XVar p -> LIdP p -> HsExpr p
HsVar NoExtField
XVar GhcRn
noExtField (Name -> Located Name
forall e. e -> Located e
noLoc Name
n), FreeVars
emptyFVs) }
rnExpr :: HsExpr GhcPs -> TcM (HsExpr GhcRn, FreeVars)
rnExpr (HsVar XVar GhcPs
_ (L l 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
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 -> TcM (HsExpr GhcRn, FreeVars)
rnUnboundVar RdrName
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 -> TcM (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 NoExtField
XExplicitList GhcPs
noExtField Maybe (SyntaxExpr GhcPs)
forall a. Maybe a
Nothing [])
| Bool
otherwise
-> Located Name -> TcM (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) -> TcM (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 NoExtField
XRecFld GhcRn
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
v) ), Name -> FreeVars
unitFV Name
s) ;
Just (Right fs :: [Name]
fs@(Name
_:Name
_:[Name]
_)) ->
(HsExpr GhcRn, FreeVars) -> TcM (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 NoExtField
XRecFld GhcRn
noExtField (XAmbiguous GhcRn -> Located RdrName -> AmbiguousFieldOcc GhcRn
forall pass.
XAmbiguous pass -> Located RdrName -> AmbiguousFieldOcc pass
Ambiguous NoExtField
XAmbiguous GhcRn
noExtField (SrcSpan -> RdrName -> Located RdrName
forall l e. l -> e -> GenLocated l e
L SrcSpan
l RdrName
v))
, [Name] -> FreeVars
mkFVs [Name]
fs);
Just (Right []) -> String -> TcM (HsExpr GhcRn, FreeVars)
forall a. String -> a
panic String
"runExpr/HsVar" } }
rnExpr (HsIPVar XIPVar GhcPs
x HsIPName
v)
= (HsExpr GhcRn, FreeVars) -> TcM (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 OccName
v)
= (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XUnboundVar GhcRn -> OccName -> HsExpr GhcRn
forall p. XUnboundVar p -> OccName -> HsExpr p
HsUnboundVar XUnboundVar GhcPs
XUnboundVar GhcRn
x OccName
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) -> TcM (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) -> TcM (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 -> TcM (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) -> TcM (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 (p1 :: Pass) (p2 :: Pass).
HsLit (GhcPass p1) -> HsLit (GhcPass p2)
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) -> TcM (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 (p1 :: Pass) (p2 :: Pass).
HsLit (GhcPass p1) -> HsLit (GhcPass p2)
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) -> TcM (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) -> TcM (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 (HsExpr GhcRn -> Located (HsExpr GhcRn)
forall e. e -> Located e
noLoc HsExpr GhcRn
neg) (HsExpr GhcRn -> Located (HsExpr GhcRn)
forall e. e -> Located e
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 { (Located (HsExpr GhcRn)
fun',FreeVars
fvFun) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
fun
; (Located (HsExpr GhcRn)
arg',FreeVars
fvArg) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
arg
; (HsExpr GhcRn, FreeVars) -> TcM (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 Located (HsExpr GhcRn)
LHsExpr GhcRn
fun' Located (HsExpr GhcRn)
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 (Located (HsType GhcPs))
-> Located (HsType GhcPs)
forall pass thing. HsWildCardBndrs pass thing -> thing
hswc_body HsWildCardBndrs GhcPs (Located (HsType GhcPs))
LHsWcType (NoGhcTc GhcPs)
arg
; (Located (HsExpr GhcRn)
fun',FreeVars
fvFun) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
fun
; (HsWildCardBndrs GhcRn (Located (HsType GhcRn))
arg',FreeVars
fvArg) <- HsDocContext -> LHsWcType GhcPs -> RnM (LHsWcType GhcRn, FreeVars)
rnHsWcType HsDocContext
HsTypeCtx LHsWcType GhcPs
LHsWcType (NoGhcTc GhcPs)
arg
; (HsExpr GhcRn, FreeVars) -> TcM (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 Located (HsExpr GhcRn)
LHsExpr GhcRn
fun' HsWildCardBndrs GhcRn (Located (HsType GhcRn))
LHsWcType (NoGhcTc GhcRn)
arg', FreeVars
fvFun FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvArg) }
rnExpr (OpApp XOpApp GhcPs
_ LHsExpr GhcPs
e1 LHsExpr GhcPs
op LHsExpr GhcPs
e2)
= do { (Located (HsExpr GhcRn)
e1', FreeVars
fv_e1) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
e1
; (Located (HsExpr GhcRn)
e2', FreeVars
fv_e2) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
e2
; (Located (HsExpr GhcRn)
op', FreeVars
fv_op) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
op
; Fixity
fixity <- case Located (HsExpr GhcRn)
op' of
L SrcSpan
_ (HsVar XVar GhcRn
_ (L _ n)) -> Name -> IOEnv (Env TcGblEnv TcLclEnv) Fixity
lookupFixityRn Name
n
L SrcSpan
_ (HsRecFld XRecFld GhcRn
_ AmbiguousFieldOcc GhcRn
f) -> AmbiguousFieldOcc GhcRn -> IOEnv (Env TcGblEnv TcLclEnv) Fixity
lookupFieldFixityRn AmbiguousFieldOcc GhcRn
f
Located (HsExpr 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 Located (HsExpr GhcRn)
LHsExpr GhcRn
e1' Located (HsExpr GhcRn)
LHsExpr GhcRn
op' Fixity
fixity Located (HsExpr GhcRn)
LHsExpr GhcRn
e2'
; (HsExpr GhcRn, FreeVars) -> TcM (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 { (Located (HsExpr GhcRn)
e', FreeVars
fv_e) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
e
; (SyntaxExprRn
neg_name, FreeVars
fv_neg) <- Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupSyntax 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 Located (HsExpr GhcRn)
LHsExpr GhcRn
e' SyntaxExprRn
SyntaxExpr GhcRn
neg_name
; (HsExpr GhcRn, FreeVars) -> TcM (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 -> TcM (HsExpr GhcRn, FreeVars)
rnBracket HsExpr GhcPs
e HsBracket GhcPs
br_body
rnExpr (HsSpliceE XSpliceE GhcPs
_ HsSplice GhcPs
splice) = HsSplice GhcPs -> TcM (HsExpr GhcRn, FreeVars)
rnSpliceExpr HsSplice GhcPs
splice
rnExpr (HsPar XPar GhcPs
x (L loc (section@(SectionL {}))))
= do { (HsExpr GhcRn
section', FreeVars
fvs) <- HsExpr GhcPs -> TcM (HsExpr GhcRn, FreeVars)
rnSection HsExpr GhcPs
section
; (HsExpr GhcRn, FreeVars) -> TcM (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 -> Located (HsExpr GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc HsExpr GhcRn
section'), FreeVars
fvs) }
rnExpr (HsPar XPar GhcPs
x (L loc (section@(SectionR {}))))
= do { (HsExpr GhcRn
section', FreeVars
fvs) <- HsExpr GhcPs -> TcM (HsExpr GhcRn, FreeVars)
rnSection HsExpr GhcPs
section
; (HsExpr GhcRn, FreeVars) -> TcM (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 -> Located (HsExpr 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 { (Located (HsExpr GhcRn)
e', FreeVars
fvs_e) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
e
; (HsExpr GhcRn, FreeVars) -> TcM (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 Located (HsExpr GhcRn)
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 -> TcM (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 -> TcM (HsExpr GhcRn, FreeVars)
rnSection HsExpr GhcPs
expr }
rnExpr (HsPragE XPragE GhcPs
x HsPragE GhcPs
prag LHsExpr GhcPs
expr)
= do { (Located (HsExpr GhcRn)
expr', FreeVars
fvs_expr) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
expr
; (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XPragE GhcRn -> HsPragE GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn
forall p. XPragE p -> HsPragE p -> LHsExpr p -> HsExpr p
HsPragE XPragE GhcPs
XPragE GhcRn
x (HsPragE GhcPs -> HsPragE GhcRn
rn_prag HsPragE GhcPs
prag) Located (HsExpr GhcRn)
LHsExpr GhcRn
expr', FreeVars
fvs_expr) }
where
rn_prag :: HsPragE GhcPs -> HsPragE GhcRn
rn_prag :: HsPragE GhcPs -> HsPragE GhcRn
rn_prag (HsPragSCC XSCC GhcPs
x1 SourceText
src StringLiteral
ann) = XSCC GhcRn -> SourceText -> StringLiteral -> HsPragE GhcRn
forall p. XSCC p -> SourceText -> StringLiteral -> HsPragE p
HsPragSCC XSCC GhcPs
XSCC GhcRn
x1 SourceText
src StringLiteral
ann
rnExpr (HsLam XLam GhcPs
x MatchGroup GhcPs (LHsExpr GhcPs)
matches)
= do { (MatchGroup GhcRn (Located (HsExpr GhcRn))
matches', FreeVars
fvMatch) <- HsMatchContext GhcRn
-> (Located (HsExpr GhcPs)
-> IOEnv
(Env TcGblEnv TcLclEnv) (Located (HsExpr GhcRn), FreeVars))
-> MatchGroup GhcPs (Located (HsExpr GhcPs))
-> RnM (MatchGroup GhcRn (Located (HsExpr GhcRn)), FreeVars)
forall (body :: * -> *).
Outputable (body GhcPs) =>
HsMatchContext GhcRn
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> MatchGroup GhcPs (Located (body GhcPs))
-> RnM (MatchGroup GhcRn (Located (body GhcRn)), FreeVars)
rnMatchGroup HsMatchContext GhcRn
forall p. HsMatchContext p
LambdaExpr Located (HsExpr GhcPs)
-> IOEnv (Env TcGblEnv TcLclEnv) (Located (HsExpr GhcRn), FreeVars)
LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr MatchGroup GhcPs (Located (HsExpr GhcPs))
MatchGroup GhcPs (LHsExpr GhcPs)
matches
; (HsExpr GhcRn, FreeVars) -> TcM (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 (Located (HsExpr GhcRn))
MatchGroup GhcRn (LHsExpr GhcRn)
matches', FreeVars
fvMatch) }
rnExpr (HsLamCase XLamCase GhcPs
x MatchGroup GhcPs (LHsExpr GhcPs)
matches)
= do { (MatchGroup GhcRn (Located (HsExpr GhcRn))
matches', FreeVars
fvs_ms) <- HsMatchContext GhcRn
-> (Located (HsExpr GhcPs)
-> IOEnv
(Env TcGblEnv TcLclEnv) (Located (HsExpr GhcRn), FreeVars))
-> MatchGroup GhcPs (Located (HsExpr GhcPs))
-> RnM (MatchGroup GhcRn (Located (HsExpr GhcRn)), FreeVars)
forall (body :: * -> *).
Outputable (body GhcPs) =>
HsMatchContext GhcRn
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> MatchGroup GhcPs (Located (body GhcPs))
-> RnM (MatchGroup GhcRn (Located (body GhcRn)), FreeVars)
rnMatchGroup HsMatchContext GhcRn
forall p. HsMatchContext p
CaseAlt Located (HsExpr GhcPs)
-> IOEnv (Env TcGblEnv TcLclEnv) (Located (HsExpr GhcRn), FreeVars)
LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr MatchGroup GhcPs (Located (HsExpr GhcPs))
MatchGroup GhcPs (LHsExpr GhcPs)
matches
; (HsExpr GhcRn, FreeVars) -> TcM (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 (Located (HsExpr GhcRn))
MatchGroup GhcRn (LHsExpr GhcRn)
matches', FreeVars
fvs_ms) }
rnExpr (HsCase XCase GhcPs
x LHsExpr GhcPs
expr MatchGroup GhcPs (LHsExpr GhcPs)
matches)
= do { (Located (HsExpr GhcRn)
new_expr, FreeVars
e_fvs) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
expr
; (MatchGroup GhcRn (Located (HsExpr GhcRn))
new_matches, FreeVars
ms_fvs) <- HsMatchContext GhcRn
-> (Located (HsExpr GhcPs)
-> IOEnv
(Env TcGblEnv TcLclEnv) (Located (HsExpr GhcRn), FreeVars))
-> MatchGroup GhcPs (Located (HsExpr GhcPs))
-> RnM (MatchGroup GhcRn (Located (HsExpr GhcRn)), FreeVars)
forall (body :: * -> *).
Outputable (body GhcPs) =>
HsMatchContext GhcRn
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> MatchGroup GhcPs (Located (body GhcPs))
-> RnM (MatchGroup GhcRn (Located (body GhcRn)), FreeVars)
rnMatchGroup HsMatchContext GhcRn
forall p. HsMatchContext p
CaseAlt Located (HsExpr GhcPs)
-> IOEnv (Env TcGblEnv TcLclEnv) (Located (HsExpr GhcRn), FreeVars)
LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr MatchGroup GhcPs (Located (HsExpr GhcPs))
MatchGroup GhcPs (LHsExpr GhcPs)
matches
; (HsExpr GhcRn, FreeVars) -> TcM (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 Located (HsExpr GhcRn)
LHsExpr GhcRn
new_expr MatchGroup GhcRn (Located (HsExpr GhcRn))
MatchGroup GhcRn (LHsExpr GhcRn)
new_matches, FreeVars
e_fvs FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
ms_fvs) }
rnExpr (HsLet XLet GhcPs
x (L l binds) LHsExpr GhcPs
expr)
= HsLocalBinds GhcPs
-> (HsLocalBinds GhcRn -> FreeVars -> TcM (HsExpr GhcRn, FreeVars))
-> TcM (HsExpr GhcRn, FreeVars)
forall result.
HsLocalBinds GhcPs
-> (HsLocalBinds GhcRn -> FreeVars -> RnM (result, FreeVars))
-> RnM (result, FreeVars)
rnLocalBindsAndThen HsLocalBinds GhcPs
binds ((HsLocalBinds GhcRn -> FreeVars -> TcM (HsExpr GhcRn, FreeVars))
-> TcM (HsExpr GhcRn, FreeVars))
-> (HsLocalBinds GhcRn -> FreeVars -> TcM (HsExpr GhcRn, FreeVars))
-> TcM (HsExpr GhcRn, FreeVars)
forall a b. (a -> b) -> a -> b
$ \HsLocalBinds GhcRn
binds' FreeVars
_ -> do
{ (Located (HsExpr GhcRn)
expr',FreeVars
fvExpr) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
expr
; (HsExpr GhcRn, FreeVars) -> TcM (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 -> GenLocated SrcSpan (HsLocalBinds GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpan
l HsLocalBinds GhcRn
binds') Located (HsExpr GhcRn)
LHsExpr GhcRn
expr', FreeVars
fvExpr) }
rnExpr (HsDo XDo GhcPs
x HsStmtContext GhcRn
do_or_lc (L l stmts))
= do { (([Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))]
stmts', ()
_), FreeVars
fvs) <-
HsStmtContext GhcRn
-> (Located (HsExpr GhcPs)
-> IOEnv
(Env TcGblEnv TcLclEnv) (Located (HsExpr GhcRn), FreeVars))
-> (HsStmtContext GhcRn
-> [(LStmt GhcRn (Located (HsExpr GhcRn)), FreeVars)]
-> RnM ([LStmt GhcRn (Located (HsExpr GhcRn))], FreeVars))
-> [LStmt GhcPs (Located (HsExpr GhcPs))]
-> ([Name] -> RnM ((), FreeVars))
-> RnM (([LStmt GhcRn (Located (HsExpr GhcRn))], ()), FreeVars)
forall (body :: * -> *) thing.
Outputable (body GhcPs) =>
HsStmtContext GhcRn
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> (HsStmtContext GhcRn
-> [(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 GhcRn
do_or_lc Located (HsExpr GhcPs)
-> IOEnv (Env TcGblEnv TcLclEnv) (Located (HsExpr GhcRn), FreeVars)
LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr
HsStmtContext GhcRn
-> [(LStmt GhcRn (Located (HsExpr GhcRn)), FreeVars)]
-> RnM ([LStmt GhcRn (Located (HsExpr GhcRn))], FreeVars)
HsStmtContext GhcRn
-> [(ExprLStmt GhcRn, FreeVars)]
-> RnM ([ExprLStmt GhcRn], FreeVars)
postProcessStmtsForApplicativeDo [Located (StmtLR GhcPs GhcPs (Located (HsExpr GhcPs)))]
[LStmt GhcPs (Located (HsExpr GhcPs))]
stmts
(\ [Name]
_ -> ((), FreeVars) -> RnM ((), FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return ((), FreeVars
emptyFVs))
; (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return ( XDo GhcRn
-> HsStmtContext GhcRn
-> XRec GhcRn [ExprLStmt GhcRn]
-> HsExpr GhcRn
forall p.
XDo p -> HsStmtContext GhcRn -> XRec p [ExprLStmt p] -> HsExpr p
HsDo XDo GhcPs
XDo GhcRn
x HsStmtContext GhcRn
do_or_lc (SrcSpan
-> [Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))]
-> GenLocated
SrcSpan [Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))]
forall l e. l -> e -> GenLocated l e
L SrcSpan
l [Located (StmtLR GhcRn GhcRn (Located (HsExpr 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
; ([Located (HsExpr GhcRn)]
exps', FreeVars
fvs) <- [LHsExpr GhcPs] -> RnM ([LHsExpr GhcRn], FreeVars)
rnExprs [LHsExpr GhcPs]
exps
; if Bool
opt_OverloadedLists
then do {
; (SyntaxExprRn
from_list_n_name, FreeVars
fvs') <- Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupSyntax Name
fromListNName
; (HsExpr GhcRn, FreeVars) -> TcM (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 (SyntaxExprRn -> Maybe SyntaxExprRn
forall a. a -> Maybe a
Just SyntaxExprRn
from_list_n_name) [Located (HsExpr GhcRn)]
[LHsExpr GhcRn]
exps'
, FreeVars
fvs FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs') }
else
(HsExpr GhcRn, FreeVars) -> TcM (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 [Located (HsExpr GhcRn)]
[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
; ([GenLocated SrcSpan (HsTupArg GhcRn)]
tup_args', [FreeVars]
fvs) <- (GenLocated SrcSpan (HsTupArg GhcPs)
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpan (HsTupArg GhcRn), FreeVars))
-> [GenLocated SrcSpan (HsTupArg 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 GenLocated SrcSpan (HsTupArg 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 [GenLocated SrcSpan (HsTupArg GhcPs)]
[LHsTupArg GhcPs]
tup_args
; (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XExplicitTuple GhcRn -> [LHsTupArg GhcRn] -> Boxity -> HsExpr GhcRn
forall p. XExplicitTuple p -> [LHsTupArg p] -> Boxity -> HsExpr p
ExplicitTuple XExplicitTuple GhcPs
XExplicitTuple GhcRn
x [GenLocated SrcSpan (HsTupArg GhcRn)]
[LHsTupArg 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 { (Located (HsExpr 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 Located (HsExpr GhcRn)
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 NoExtField
XMissing GhcRn
noExtField)
, FreeVars
emptyFVs)
rnExpr (ExplicitSum XExplicitSum GhcPs
x Int
alt Int
arity LHsExpr GhcPs
expr)
= do { (Located (HsExpr GhcRn)
expr', FreeVars
fvs) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
expr
; (HsExpr GhcRn, FreeVars) -> TcM (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 Located (HsExpr GhcRn)
LHsExpr GhcRn
expr', FreeVars
fvs) }
rnExpr (RecordCon { rcon_con_name :: forall p. HsExpr p -> LIdP p
rcon_con_name = LIdP 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
LIdP GhcPs
con_id
; ([LHsRecField GhcRn (Located (HsExpr GhcPs))]
flds, FreeVars
fvs) <- HsRecFieldContext
-> (SrcSpan -> RdrName -> HsExpr GhcPs)
-> HsRecFields GhcPs (Located (HsExpr GhcPs))
-> RnM ([LHsRecField GhcRn (Located (HsExpr GhcPs))], FreeVars)
forall arg.
HsRecFieldContext
-> (SrcSpan -> RdrName -> arg)
-> HsRecFields GhcPs (Located arg)
-> RnM ([LHsRecField GhcRn (Located arg)], FreeVars)
rnHsRecFields (Name -> HsRecFieldContext
HsRecFieldCon Name
con_name) SrcSpan -> RdrName -> HsExpr GhcPs
forall p l e.
(XVar p ~ NoExtField, XRec p (IdP p) ~ GenLocated l e) =>
l -> e -> HsExpr p
mk_hs_var HsRecFields GhcPs (Located (HsExpr GhcPs))
HsRecordBinds GhcPs
rec_binds
; ([GenLocated
SrcSpan (HsRecField' (FieldOcc GhcRn) (Located (HsExpr GhcRn)))]
flds', [FreeVars]
fvss) <- (LHsRecField GhcRn (Located (HsExpr GhcPs))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated
SrcSpan (HsRecField' (FieldOcc GhcRn) (Located (HsExpr GhcRn))),
FreeVars))
-> [LHsRecField GhcRn (Located (HsExpr GhcPs))]
-> IOEnv
(Env TcGblEnv TcLclEnv)
([GenLocated
SrcSpan (HsRecField' (FieldOcc GhcRn) (Located (HsExpr GhcRn)))],
[FreeVars])
forall (m :: * -> *) a b c.
Applicative m =>
(a -> m (b, c)) -> [a] -> m ([b], [c])
mapAndUnzipM LHsRecField GhcRn (Located (HsExpr GhcPs))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated
SrcSpan (HsRecField' (FieldOcc GhcRn) (Located (HsExpr GhcRn))),
FreeVars)
forall l id.
GenLocated l (HsRecField' id (Located (HsExpr GhcPs)))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated l (HsRecField' id (Located (HsExpr GhcRn))), FreeVars)
rn_field [LHsRecField GhcRn (Located (HsExpr GhcPs))]
flds
; let rec_binds' :: HsRecFields GhcRn (Located (HsExpr GhcRn))
rec_binds' = HsRecFields :: forall p arg.
[LHsRecField p arg] -> Maybe (Located Int) -> HsRecFields p arg
HsRecFields { rec_flds :: [GenLocated
SrcSpan (HsRecField' (FieldOcc GhcRn) (Located (HsExpr GhcRn)))]
rec_flds = [GenLocated
SrcSpan (HsRecField' (FieldOcc GhcRn) (Located (HsExpr GhcRn)))]
flds', rec_dotdot :: Maybe (Located Int)
rec_dotdot = Maybe (Located Int)
dd }
; (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (RecordCon :: forall p. XRecordCon p -> LIdP p -> HsRecordBinds p -> HsExpr p
RecordCon { rcon_ext :: XRecordCon GhcRn
rcon_ext = NoExtField
XRecordCon GhcRn
noExtField
, rcon_con_name :: LIdP GhcRn
rcon_con_name = Located Name
LIdP GhcRn
con_lname, rcon_flds :: HsRecordBinds GhcRn
rcon_flds = HsRecFields GhcRn (Located (HsExpr GhcRn))
HsRecordBinds 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 :: l -> e -> HsExpr p
mk_hs_var l
l e
n = XVar p -> XRec p (IdP p) -> HsExpr p
forall p. XVar p -> LIdP p -> HsExpr p
HsVar NoExtField
XVar p
noExtField (l -> e -> GenLocated l e
forall l e. l -> e -> GenLocated l e
L l
l e
n)
rn_field :: GenLocated l (HsRecField' id (Located (HsExpr GhcPs)))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated l (HsRecField' id (Located (HsExpr GhcRn))), FreeVars)
rn_field (L l
l HsRecField' id (Located (HsExpr GhcPs))
fld) = do { (Located (HsExpr GhcRn)
arg', FreeVars
fvs) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr (HsRecField' id (Located (HsExpr GhcPs)) -> Located (HsExpr GhcPs)
forall id arg. HsRecField' id arg -> arg
hsRecFieldArg HsRecField' id (Located (HsExpr GhcPs))
fld)
; (GenLocated l (HsRecField' id (Located (HsExpr GhcRn))), FreeVars)
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated l (HsRecField' id (Located (HsExpr GhcRn))), FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (l
-> HsRecField' id (Located (HsExpr GhcRn))
-> GenLocated l (HsRecField' id (Located (HsExpr GhcRn)))
forall l e. l -> e -> GenLocated l e
L l
l (HsRecField' id (Located (HsExpr GhcPs))
fld { hsRecFieldArg :: Located (HsExpr GhcRn)
hsRecFieldArg = Located (HsExpr 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 { (Located (HsExpr GhcRn)
expr', FreeVars
fvExpr) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
expr
; ([Located
(HsRecField' (AmbiguousFieldOcc GhcRn) (Located (HsExpr GhcRn)))]
rbinds', FreeVars
fvRbinds) <- [LHsRecUpdField GhcPs] -> RnM ([LHsRecUpdField GhcRn], FreeVars)
rnHsRecUpdFields [LHsRecUpdField GhcPs]
rbinds
; (HsExpr GhcRn, FreeVars) -> TcM (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 = NoExtField
XRecordUpd GhcRn
noExtField, rupd_expr :: LHsExpr GhcRn
rupd_expr = Located (HsExpr GhcRn)
LHsExpr GhcRn
expr'
, rupd_flds :: [LHsRecUpdField GhcRn]
rupd_flds = [Located
(HsRecField' (AmbiguousFieldOcc GhcRn) (Located (HsExpr GhcRn)))]
[LHsRecUpdField GhcRn]
rbinds' }
, FreeVars
fvExpr FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvRbinds) }
rnExpr (ExprWithTySig XExprWithTySig GhcPs
_ LHsExpr GhcPs
expr LHsSigWcType (NoGhcTc GhcPs)
pty)
= do { (HsWildCardBndrs
GhcRn (HsImplicitBndrs GhcRn (Located (HsType GhcRn)))
pty', FreeVars
fvTy) <- HsDocContext
-> LHsSigWcType GhcPs -> RnM (LHsSigWcType GhcRn, FreeVars)
rnHsSigWcType HsDocContext
ExprWithTySigCtx LHsSigWcType GhcPs
LHsSigWcType (NoGhcTc GhcPs)
pty
; (Located (HsExpr GhcRn)
expr', FreeVars
fvExpr) <- [Name]
-> IOEnv (Env TcGblEnv TcLclEnv) (Located (HsExpr GhcRn), FreeVars)
-> IOEnv (Env TcGblEnv TcLclEnv) (Located (HsExpr GhcRn), FreeVars)
forall a. [Name] -> RnM (a, FreeVars) -> RnM (a, FreeVars)
bindSigTyVarsFV (LHsSigWcType GhcRn -> [Name]
hsWcScopedTvs HsWildCardBndrs
GhcRn (HsImplicitBndrs GhcRn (Located (HsType GhcRn)))
LHsSigWcType GhcRn
pty') (IOEnv (Env TcGblEnv TcLclEnv) (Located (HsExpr GhcRn), FreeVars)
-> IOEnv
(Env TcGblEnv TcLclEnv) (Located (HsExpr GhcRn), FreeVars))
-> IOEnv (Env TcGblEnv TcLclEnv) (Located (HsExpr GhcRn), FreeVars)
-> IOEnv (Env TcGblEnv TcLclEnv) (Located (HsExpr GhcRn), FreeVars)
forall a b. (a -> b) -> a -> b
$
LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
expr
; (HsExpr GhcRn, FreeVars) -> TcM (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 NoExtField
XExprWithTySig GhcRn
noExtField Located (HsExpr GhcRn)
LHsExpr GhcRn
expr' HsWildCardBndrs
GhcRn (HsImplicitBndrs GhcRn (Located (HsType GhcRn)))
LHsSigWcType (NoGhcTc GhcRn)
pty', FreeVars
fvExpr FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvTy) }
rnExpr (HsIf XIf GhcPs
_ LHsExpr GhcPs
p LHsExpr GhcPs
b1 LHsExpr GhcPs
b2)
= do { (Located (HsExpr GhcRn)
p', FreeVars
fvP) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
p
; (Located (HsExpr GhcRn)
b1', FreeVars
fvB1) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
b1
; (Located (HsExpr GhcRn)
b2', FreeVars
fvB2) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
b2
; Maybe (Located Name)
mifteName <- RnM (Maybe (Located Name))
lookupReboundIf
; let subFVs :: FreeVars
subFVs = [FreeVars] -> FreeVars
plusFVs [FreeVars
fvP, FreeVars
fvB1, FreeVars
fvB2]
; (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return ((HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars))
-> (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a b. (a -> b) -> a -> b
$ case Maybe (Located Name)
mifteName of
Maybe (Located Name)
Nothing ->
(XIf GhcRn
-> LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn
forall p. XIf p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsIf NoExtField
XIf GhcRn
noExtField Located (HsExpr GhcRn)
LHsExpr GhcRn
p' Located (HsExpr GhcRn)
LHsExpr GhcRn
b1' Located (HsExpr GhcRn)
LHsExpr GhcRn
b2', FreeVars
subFVs)
Just Located Name
ifteName ->
let ifteExpr :: HsExpr GhcRn
ifteExpr = Located Name
-> LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn
rebindIf Located Name
ifteName Located (HsExpr GhcRn)
LHsExpr GhcRn
p' Located (HsExpr GhcRn)
LHsExpr GhcRn
b1' Located (HsExpr GhcRn)
LHsExpr GhcRn
b2'
in (HsExpr GhcRn
ifteExpr, [FreeVars] -> FreeVars
plusFVs [Name -> FreeVars
unitFV (Located Name -> Name
forall l e. GenLocated l e -> e
unLoc Located Name
ifteName), FreeVars
subFVs])
}
rnExpr (HsMultiIf XMultiIf GhcPs
x [LGRHS GhcPs (LHsExpr GhcPs)]
alts)
= do { ([Located (GRHS GhcRn (Located (HsExpr GhcRn)))]
alts', FreeVars
fvs) <- (Located (GRHS GhcPs (Located (HsExpr GhcPs)))
-> RnM (Located (GRHS GhcRn (Located (HsExpr GhcRn))), FreeVars))
-> [Located (GRHS GhcPs (Located (HsExpr GhcPs)))]
-> RnM ([Located (GRHS GhcRn (Located (HsExpr GhcRn)))], FreeVars)
forall a b. (a -> RnM (b, FreeVars)) -> [a] -> RnM ([b], FreeVars)
mapFvRn (HsMatchContext GhcRn
-> (Located (HsExpr GhcPs)
-> IOEnv
(Env TcGblEnv TcLclEnv) (Located (HsExpr GhcRn), FreeVars))
-> LGRHS GhcPs (Located (HsExpr GhcPs))
-> RnM (LGRHS GhcRn (Located (HsExpr GhcRn)), FreeVars)
forall (body :: * -> *).
HsMatchContext GhcRn
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> LGRHS GhcPs (Located (body GhcPs))
-> RnM (LGRHS GhcRn (Located (body GhcRn)), FreeVars)
rnGRHS HsMatchContext GhcRn
forall p. HsMatchContext p
IfAlt Located (HsExpr GhcPs)
-> IOEnv (Env TcGblEnv TcLclEnv) (Located (HsExpr GhcRn), FreeVars)
LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr) [Located (GRHS GhcPs (Located (HsExpr GhcPs)))]
[LGRHS GhcPs (LHsExpr GhcPs)]
alts
; (HsExpr GhcRn, FreeVars) -> TcM (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 [Located (GRHS GhcRn (Located (HsExpr GhcRn)))]
[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 {
; (SyntaxExprRn
from_list_name, FreeVars
fvs') <- Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupSyntax Name
fromListName
; (HsExpr GhcRn, FreeVars) -> TcM (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 (SyntaxExprRn -> Maybe SyntaxExprRn
forall a. a -> Maybe a
Just SyntaxExprRn
from_list_name) ArithSeqInfo GhcRn
new_seq
, FreeVars
fvs FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs') }
else
(HsExpr GhcRn, FreeVars) -> TcM (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")
(Located (HsExpr 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) -> TcM (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' Located (HsExpr GhcRn)
LHsExpr GhcRn
expr', FreeVars
fvExpr)
rnExpr (HsProc XProc GhcPs
x LPat GhcPs
pat LHsCmdTop GhcPs
body)
= TcM (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a. TcM a -> TcM a
newArrowScope (TcM (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars))
-> TcM (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall a b. (a -> b) -> a -> b
$
HsMatchContext GhcRn
-> LPat GhcPs
-> (LPat GhcRn -> TcM (HsExpr GhcRn, FreeVars))
-> TcM (HsExpr GhcRn, FreeVars)
forall a.
HsMatchContext GhcRn
-> LPat GhcPs
-> (LPat GhcRn -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
rnPat HsMatchContext GhcRn
forall p. HsMatchContext p
ProcExpr LPat GhcPs
pat ((LPat GhcRn -> TcM (HsExpr GhcRn, FreeVars))
-> TcM (HsExpr GhcRn, FreeVars))
-> (LPat GhcRn -> TcM (HsExpr GhcRn, FreeVars))
-> TcM (HsExpr GhcRn, FreeVars)
forall a b. (a -> b) -> a -> b
$ \ LPat GhcRn
pat' -> do
{ (Located (HsCmdTop GhcRn)
body',FreeVars
fvBody) <- LHsCmdTop GhcPs -> RnM (LHsCmdTop GhcRn, FreeVars)
rnCmdTop LHsCmdTop GhcPs
body
; (HsExpr GhcRn, FreeVars) -> TcM (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' Located (HsCmdTop GhcRn)
LHsCmdTop GhcRn
body', FreeVars
fvBody) }
rnExpr HsExpr GhcPs
other = String -> MsgDoc -> TcM (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 -> TcM (HsExpr GhcRn, FreeVars)
rnSection section :: HsExpr GhcPs
section@(SectionR XSectionR GhcPs
x LHsExpr GhcPs
op LHsExpr GhcPs
expr)
= do { (Located (HsExpr GhcRn)
op', FreeVars
fvs_op) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
op
; (Located (HsExpr 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 Located (HsExpr GhcRn)
LHsExpr GhcRn
op' Located (HsExpr GhcRn)
LHsExpr GhcRn
expr'
; (HsExpr GhcRn, FreeVars) -> TcM (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 Located (HsExpr GhcRn)
LHsExpr GhcRn
op' Located (HsExpr GhcRn)
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 { (Located (HsExpr GhcRn)
expr', FreeVars
fvs_expr) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
expr
; (Located (HsExpr 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 Located (HsExpr GhcRn)
LHsExpr GhcRn
op' Located (HsExpr GhcRn)
LHsExpr GhcRn
expr'
; (HsExpr GhcRn, FreeVars) -> TcM (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 Located (HsExpr GhcRn)
LHsExpr GhcRn
expr' Located (HsExpr GhcRn)
LHsExpr GhcRn
op', FreeVars
fvs_op FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs_expr) }
rnSection HsExpr GhcPs
other = String -> MsgDoc -> TcM (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 [] = ([Located (HsCmdTop GhcRn)], FreeVars)
-> IOEnv
(Env TcGblEnv TcLclEnv) ([Located (HsCmdTop GhcRn)], FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], FreeVars
emptyFVs)
rnCmdArgs (LHsCmdTop GhcPs
arg:[LHsCmdTop GhcPs]
args)
= do { (Located (HsCmdTop GhcRn)
arg',FreeVars
fvArg) <- LHsCmdTop GhcPs -> RnM (LHsCmdTop GhcRn, FreeVars)
rnCmdTop LHsCmdTop GhcPs
arg
; ([Located (HsCmdTop GhcRn)]
args',FreeVars
fvArgs) <- [LHsCmdTop GhcPs] -> RnM ([LHsCmdTop GhcRn], FreeVars)
rnCmdArgs [LHsCmdTop GhcPs]
args
; ([Located (HsCmdTop GhcRn)], FreeVars)
-> IOEnv
(Env TcGblEnv TcLclEnv) ([Located (HsCmdTop GhcRn)], FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (Located (HsCmdTop GhcRn)
arg'Located (HsCmdTop GhcRn)
-> [Located (HsCmdTop GhcRn)] -> [Located (HsCmdTop GhcRn)]
forall a. a -> [a] -> [a]
:[Located (HsCmdTop 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 = (HsCmdTop GhcPs -> TcM (HsCmdTop GhcRn, FreeVars))
-> Located (HsCmdTop GhcPs)
-> IOEnv
(Env TcGblEnv TcLclEnv) (Located (HsCmdTop GhcRn), FreeVars)
forall a b c. (a -> TcM (b, c)) -> Located a -> TcM (Located b, c)
wrapLocFstM HsCmdTop GhcPs -> TcM (HsCmdTop GhcRn, FreeVars)
rnCmdTop'
where
rnCmdTop' :: HsCmdTop GhcPs -> RnM (HsCmdTop GhcRn, FreeVars)
rnCmdTop' :: HsCmdTop GhcPs -> TcM (HsCmdTop GhcRn, FreeVars)
rnCmdTop' (HsCmdTop XCmdTop GhcPs
_ LHsCmd GhcPs
cmd)
= do { (GenLocated SrcSpan (HsCmd 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 (GenLocated SrcSpan (HsCmd GhcRn) -> HsCmd GhcRn
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpan (HsCmd GhcRn)
cmd'))
; ([HsExpr GhcRn]
cmd_names', FreeVars
cmd_fvs) <- [Name] -> RnM ([HsExpr GhcRn], FreeVars)
lookupSyntaxNames [Name]
cmd_names
; (HsCmdTop GhcRn, FreeVars) -> TcM (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') GenLocated SrcSpan (HsCmd GhcRn)
LHsCmd GhcRn
cmd',
FreeVars
fvCmd FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
cmd_fvs) }
rnLCmd :: LHsCmd GhcPs -> RnM (LHsCmd GhcRn, FreeVars)
rnLCmd :: LHsCmd GhcPs -> RnM (LHsCmd GhcRn, FreeVars)
rnLCmd = (HsCmd GhcPs -> TcM (HsCmd GhcRn, FreeVars))
-> Located (HsCmd GhcPs)
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpan (HsCmd GhcRn), FreeVars)
forall a b c. (a -> TcM (b, c)) -> Located a -> TcM (Located b, c)
wrapLocFstM HsCmd GhcPs -> TcM (HsCmd GhcRn, FreeVars)
rnCmd
rnCmd :: HsCmd GhcPs -> RnM (HsCmd GhcRn, FreeVars)
rnCmd :: HsCmd GhcPs -> TcM (HsCmd GhcRn, FreeVars)
rnCmd (HsCmdArrApp XCmdArrApp GhcPs
x LHsExpr GhcPs
arrow LHsExpr GhcPs
arg HsArrAppType
ho Bool
rtl)
= do { (Located (HsExpr GhcRn)
arrow',FreeVars
fvArrow) <- IOEnv (Env TcGblEnv TcLclEnv) (Located (HsExpr GhcRn), FreeVars)
-> IOEnv (Env TcGblEnv TcLclEnv) (Located (HsExpr GhcRn), FreeVars)
select_arrow_scope (LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
arrow)
; (Located (HsExpr GhcRn)
arg',FreeVars
fvArg) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
arg
; (HsCmd GhcRn, FreeVars) -> TcM (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 Located (HsExpr GhcRn)
LHsExpr GhcRn
arrow' Located (HsExpr GhcRn)
LHsExpr GhcRn
arg' HsArrAppType
ho Bool
rtl,
FreeVars
fvArrow FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvArg) }
where
select_arrow_scope :: IOEnv (Env TcGblEnv TcLclEnv) (Located (HsExpr GhcRn), FreeVars)
-> IOEnv (Env TcGblEnv TcLclEnv) (Located (HsExpr GhcRn), FreeVars)
select_arrow_scope IOEnv (Env TcGblEnv TcLclEnv) (Located (HsExpr GhcRn), FreeVars)
tc = case HsArrAppType
ho of
HsArrAppType
HsHigherOrderApp -> IOEnv (Env TcGblEnv TcLclEnv) (Located (HsExpr GhcRn), FreeVars)
tc
HsArrAppType
HsFirstOrderApp -> IOEnv (Env TcGblEnv TcLclEnv) (Located (HsExpr GhcRn), FreeVars)
-> IOEnv (Env TcGblEnv TcLclEnv) (Located (HsExpr GhcRn), FreeVars)
forall a. TcM a -> TcM a
escapeArrowScope IOEnv (Env TcGblEnv TcLclEnv) (Located (HsExpr GhcRn), FreeVars)
tc
rnCmd (HsCmdArrForm XCmdArrForm GhcPs
_ LHsExpr GhcPs
op LexicalFixity
_ (Just Fixity
_) [LHsCmdTop GhcPs
arg1, LHsCmdTop GhcPs
arg2])
= do { (Located (HsExpr GhcRn)
op',FreeVars
fv_op) <- IOEnv (Env TcGblEnv TcLclEnv) (Located (HsExpr GhcRn), FreeVars)
-> IOEnv (Env TcGblEnv TcLclEnv) (Located (HsExpr 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 _ op_name)) = Located (HsExpr GhcRn)
op'
; (Located (HsCmdTop GhcRn)
arg1',FreeVars
fv_arg1) <- LHsCmdTop GhcPs -> RnM (LHsCmdTop GhcRn, FreeVars)
rnCmdTop LHsCmdTop GhcPs
arg1
; (Located (HsCmdTop 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
op_name
; HsCmd GhcRn
final_e <- LHsCmdTop GhcRn
-> LHsExpr GhcRn -> Fixity -> LHsCmdTop GhcRn -> RnM (HsCmd GhcRn)
mkOpFormRn Located (HsCmdTop GhcRn)
LHsCmdTop GhcRn
arg1' Located (HsExpr GhcRn)
LHsExpr GhcRn
op' Fixity
fixity Located (HsCmdTop GhcRn)
LHsCmdTop GhcRn
arg2'
; (HsCmd GhcRn, FreeVars) -> TcM (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 { (Located (HsExpr GhcRn)
op',FreeVars
fvOp) <- IOEnv (Env TcGblEnv TcLclEnv) (Located (HsExpr GhcRn), FreeVars)
-> IOEnv (Env TcGblEnv TcLclEnv) (Located (HsExpr GhcRn), FreeVars)
forall a. TcM a -> TcM a
escapeArrowScope (LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
op)
; ([Located (HsCmdTop GhcRn)]
cmds',FreeVars
fvCmds) <- [LHsCmdTop GhcPs] -> RnM ([LHsCmdTop GhcRn], FreeVars)
rnCmdArgs [LHsCmdTop GhcPs]
cmds
; (HsCmd GhcRn, FreeVars) -> TcM (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 Located (HsExpr GhcRn)
LHsExpr GhcRn
op' LexicalFixity
f Maybe Fixity
fixity [Located (HsCmdTop GhcRn)]
[LHsCmdTop GhcRn]
cmds', FreeVars
fvOp FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvCmds) }
rnCmd (HsCmdApp XCmdApp GhcPs
x LHsCmd GhcPs
fun LHsExpr GhcPs
arg)
= do { (GenLocated SrcSpan (HsCmd GhcRn)
fun',FreeVars
fvFun) <- LHsCmd GhcPs -> RnM (LHsCmd GhcRn, FreeVars)
rnLCmd LHsCmd GhcPs
fun
; (Located (HsExpr GhcRn)
arg',FreeVars
fvArg) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
arg
; (HsCmd GhcRn, FreeVars) -> TcM (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 GenLocated SrcSpan (HsCmd GhcRn)
LHsCmd GhcRn
fun' Located (HsExpr GhcRn)
LHsExpr GhcRn
arg', FreeVars
fvFun FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvArg) }
rnCmd (HsCmdLam XCmdLam GhcPs
x MatchGroup GhcPs (LHsCmd GhcPs)
matches)
= do { (MatchGroup GhcRn (GenLocated SrcSpan (HsCmd GhcRn))
matches', FreeVars
fvMatch) <- HsMatchContext GhcRn
-> (Located (HsCmd GhcPs)
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpan (HsCmd GhcRn), FreeVars))
-> MatchGroup GhcPs (Located (HsCmd GhcPs))
-> RnM
(MatchGroup GhcRn (GenLocated SrcSpan (HsCmd GhcRn)), FreeVars)
forall (body :: * -> *).
Outputable (body GhcPs) =>
HsMatchContext GhcRn
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> MatchGroup GhcPs (Located (body GhcPs))
-> RnM (MatchGroup GhcRn (Located (body GhcRn)), FreeVars)
rnMatchGroup HsMatchContext GhcRn
forall p. HsMatchContext p
LambdaExpr Located (HsCmd GhcPs)
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpan (HsCmd GhcRn), FreeVars)
LHsCmd GhcPs -> RnM (LHsCmd GhcRn, FreeVars)
rnLCmd MatchGroup GhcPs (Located (HsCmd GhcPs))
MatchGroup GhcPs (LHsCmd GhcPs)
matches
; (HsCmd GhcRn, FreeVars) -> TcM (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 (GenLocated SrcSpan (HsCmd GhcRn))
MatchGroup GhcRn (LHsCmd GhcRn)
matches', FreeVars
fvMatch) }
rnCmd (HsCmdPar XCmdPar GhcPs
x LHsCmd GhcPs
e)
= do { (GenLocated SrcSpan (HsCmd GhcRn)
e', FreeVars
fvs_e) <- LHsCmd GhcPs -> RnM (LHsCmd GhcRn, FreeVars)
rnLCmd LHsCmd GhcPs
e
; (HsCmd GhcRn, FreeVars) -> TcM (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 GenLocated SrcSpan (HsCmd GhcRn)
LHsCmd GhcRn
e', FreeVars
fvs_e) }
rnCmd (HsCmdCase XCmdCase GhcPs
x LHsExpr GhcPs
expr MatchGroup GhcPs (LHsCmd GhcPs)
matches)
= do { (Located (HsExpr GhcRn)
new_expr, FreeVars
e_fvs) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
expr
; (MatchGroup GhcRn (GenLocated SrcSpan (HsCmd GhcRn))
new_matches, FreeVars
ms_fvs) <- HsMatchContext GhcRn
-> (Located (HsCmd GhcPs)
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpan (HsCmd GhcRn), FreeVars))
-> MatchGroup GhcPs (Located (HsCmd GhcPs))
-> RnM
(MatchGroup GhcRn (GenLocated SrcSpan (HsCmd GhcRn)), FreeVars)
forall (body :: * -> *).
Outputable (body GhcPs) =>
HsMatchContext GhcRn
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> MatchGroup GhcPs (Located (body GhcPs))
-> RnM (MatchGroup GhcRn (Located (body GhcRn)), FreeVars)
rnMatchGroup HsMatchContext GhcRn
forall p. HsMatchContext p
CaseAlt Located (HsCmd GhcPs)
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpan (HsCmd GhcRn), FreeVars)
LHsCmd GhcPs -> RnM (LHsCmd GhcRn, FreeVars)
rnLCmd MatchGroup GhcPs (Located (HsCmd GhcPs))
MatchGroup GhcPs (LHsCmd GhcPs)
matches
; (HsCmd GhcRn, FreeVars) -> TcM (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 Located (HsExpr GhcRn)
LHsExpr GhcRn
new_expr MatchGroup GhcRn (GenLocated SrcSpan (HsCmd GhcRn))
MatchGroup GhcRn (LHsCmd GhcRn)
new_matches, FreeVars
e_fvs FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
ms_fvs) }
rnCmd (HsCmdLamCase XCmdLamCase GhcPs
x MatchGroup GhcPs (LHsCmd GhcPs)
matches)
= do { (MatchGroup GhcRn (GenLocated SrcSpan (HsCmd GhcRn))
new_matches, FreeVars
ms_fvs) <- HsMatchContext GhcRn
-> (Located (HsCmd GhcPs)
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpan (HsCmd GhcRn), FreeVars))
-> MatchGroup GhcPs (Located (HsCmd GhcPs))
-> RnM
(MatchGroup GhcRn (GenLocated SrcSpan (HsCmd GhcRn)), FreeVars)
forall (body :: * -> *).
Outputable (body GhcPs) =>
HsMatchContext GhcRn
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> MatchGroup GhcPs (Located (body GhcPs))
-> RnM (MatchGroup GhcRn (Located (body GhcRn)), FreeVars)
rnMatchGroup HsMatchContext GhcRn
forall p. HsMatchContext p
CaseAlt Located (HsCmd GhcPs)
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpan (HsCmd GhcRn), FreeVars)
LHsCmd GhcPs -> RnM (LHsCmd GhcRn, FreeVars)
rnLCmd MatchGroup GhcPs (Located (HsCmd GhcPs))
MatchGroup GhcPs (LHsCmd GhcPs)
matches
; (HsCmd GhcRn, FreeVars) -> TcM (HsCmd GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdLamCase GhcRn -> MatchGroup GhcRn (LHsCmd GhcRn) -> HsCmd GhcRn
forall id. XCmdLamCase id -> MatchGroup id (LHsCmd id) -> HsCmd id
HsCmdLamCase XCmdLamCase GhcPs
XCmdLamCase GhcRn
x MatchGroup GhcRn (GenLocated SrcSpan (HsCmd GhcRn))
MatchGroup GhcRn (LHsCmd GhcRn)
new_matches, FreeVars
ms_fvs) }
rnCmd (HsCmdIf XCmdIf GhcPs
x SyntaxExpr GhcPs
_ LHsExpr GhcPs
p LHsCmd GhcPs
b1 LHsCmd GhcPs
b2)
= do { (Located (HsExpr GhcRn)
p', FreeVars
fvP) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
p
; (GenLocated SrcSpan (HsCmd GhcRn)
b1', FreeVars
fvB1) <- LHsCmd GhcPs -> RnM (LHsCmd GhcRn, FreeVars)
rnLCmd LHsCmd GhcPs
b1
; (GenLocated SrcSpan (HsCmd GhcRn)
b2', FreeVars
fvB2) <- LHsCmd GhcPs -> RnM (LHsCmd GhcRn, FreeVars)
rnLCmd LHsCmd GhcPs
b2
; (SyntaxExprRn
mb_ite, FreeVars
fvITE) <- Bool -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupIfThenElse Bool
True
; (HsCmd GhcRn, FreeVars) -> TcM (HsCmd GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XCmdIf GhcRn
-> SyntaxExpr GhcRn
-> LHsExpr GhcRn
-> LHsCmd GhcRn
-> LHsCmd GhcRn
-> HsCmd GhcRn
forall id.
XCmdIf id
-> SyntaxExpr id
-> LHsExpr id
-> LHsCmd id
-> LHsCmd id
-> HsCmd id
HsCmdIf XCmdIf GhcPs
XCmdIf GhcRn
x SyntaxExprRn
SyntaxExpr GhcRn
mb_ite Located (HsExpr GhcRn)
LHsExpr GhcRn
p' GenLocated SrcSpan (HsCmd GhcRn)
LHsCmd GhcRn
b1' GenLocated SrcSpan (HsCmd GhcRn)
LHsCmd GhcRn
b2', [FreeVars] -> FreeVars
plusFVs [FreeVars
fvITE, FreeVars
fvP, FreeVars
fvB1, FreeVars
fvB2])}
rnCmd (HsCmdLet XCmdLet GhcPs
x (L l binds) LHsCmd GhcPs
cmd)
= HsLocalBinds GhcPs
-> (HsLocalBinds GhcRn -> FreeVars -> TcM (HsCmd GhcRn, FreeVars))
-> TcM (HsCmd GhcRn, FreeVars)
forall result.
HsLocalBinds GhcPs
-> (HsLocalBinds GhcRn -> FreeVars -> RnM (result, FreeVars))
-> RnM (result, FreeVars)
rnLocalBindsAndThen HsLocalBinds GhcPs
binds ((HsLocalBinds GhcRn -> FreeVars -> TcM (HsCmd GhcRn, FreeVars))
-> TcM (HsCmd GhcRn, FreeVars))
-> (HsLocalBinds GhcRn -> FreeVars -> TcM (HsCmd GhcRn, FreeVars))
-> TcM (HsCmd GhcRn, FreeVars)
forall a b. (a -> b) -> a -> b
$ \ HsLocalBinds GhcRn
binds' FreeVars
_ -> do
{ (GenLocated SrcSpan (HsCmd GhcRn)
cmd',FreeVars
fvExpr) <- LHsCmd GhcPs -> RnM (LHsCmd GhcRn, FreeVars)
rnLCmd LHsCmd GhcPs
cmd
; (HsCmd GhcRn, FreeVars) -> TcM (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 -> GenLocated SrcSpan (HsLocalBinds GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpan
l HsLocalBinds GhcRn
binds') GenLocated SrcSpan (HsCmd GhcRn)
LHsCmd GhcRn
cmd', FreeVars
fvExpr) }
rnCmd (HsCmdDo XCmdDo GhcPs
x (L l stmts))
= do { (([Located (StmtLR GhcRn GhcRn (GenLocated SrcSpan (HsCmd GhcRn)))]
stmts', ()
_), FreeVars
fvs) <-
HsStmtContext GhcRn
-> (Located (HsCmd GhcPs)
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpan (HsCmd GhcRn), FreeVars))
-> [LStmt GhcPs (Located (HsCmd GhcPs))]
-> ([Name] -> RnM ((), FreeVars))
-> RnM
(([LStmt GhcRn (GenLocated SrcSpan (HsCmd GhcRn))], ()), FreeVars)
forall (body :: * -> *) thing.
Outputable (body GhcPs) =>
HsStmtContext GhcRn
-> (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 GhcRn
forall p. HsStmtContext p
ArrowExpr Located (HsCmd GhcPs)
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpan (HsCmd GhcRn), FreeVars)
LHsCmd GhcPs -> RnM (LHsCmd GhcRn, FreeVars)
rnLCmd [Located (StmtLR GhcPs GhcPs (Located (HsCmd GhcPs)))]
[LStmt GhcPs (Located (HsCmd GhcPs))]
stmts (\ [Name]
_ -> ((), FreeVars) -> RnM ((), FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return ((), FreeVars
emptyFVs))
; (HsCmd GhcRn, FreeVars) -> TcM (HsCmd GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return ( XCmdDo GhcRn -> XRec GhcRn [CmdLStmt GhcRn] -> HsCmd GhcRn
forall id. XCmdDo id -> XRec id [CmdLStmt id] -> HsCmd id
HsCmdDo XCmdDo GhcPs
XCmdDo GhcRn
x (SrcSpan
-> [Located
(StmtLR GhcRn GhcRn (GenLocated SrcSpan (HsCmd GhcRn)))]
-> GenLocated
SrcSpan
[Located (StmtLR GhcRn GhcRn (GenLocated SrcSpan (HsCmd GhcRn)))]
forall l e. l -> e -> GenLocated l e
L SrcSpan
l [Located (StmtLR GhcRn GhcRn (GenLocated SrcSpan (HsCmd GhcRn)))]
stmts'), FreeVars
fvs ) }
type CmdNeeds = FreeVars
methodNamesLCmd :: LHsCmd GhcRn -> CmdNeeds
methodNamesLCmd :: LHsCmd GhcRn -> FreeVars
methodNamesLCmd = HsCmd GhcRn -> FreeVars
methodNamesCmd (HsCmd GhcRn -> FreeVars)
-> (GenLocated SrcSpan (HsCmd GhcRn) -> HsCmd GhcRn)
-> GenLocated SrcSpan (HsCmd GhcRn)
-> FreeVars
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpan (HsCmd GhcRn) -> HsCmd GhcRn
forall l e. GenLocated l e -> e
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 (HsCmdPar XCmdPar GhcRn
_ LHsCmd GhcRn
c) = LHsCmd GhcRn -> FreeVars
methodNamesLCmd LHsCmd GhcRn
c
methodNamesCmd (HsCmdIf XCmdIf GhcRn
_ 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 _ stmts)) = [Located (StmtLR GhcRn GhcRn (LHsCmd GhcRn))] -> FreeVars
methodNamesStmts [Located (StmtLR GhcRn GhcRn (GenLocated SrcSpan (HsCmd GhcRn)))]
[Located (StmtLR GhcRn 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 (HsCmdLamCase XCmdLamCase GhcRn
_ MatchGroup GhcRn (LHsCmd GhcRn)
matches)
= MatchGroup GhcRn (LHsCmd GhcRn) -> FreeVars
methodNamesMatch MatchGroup GhcRn (LHsCmd GhcRn)
matches FreeVars -> Name -> FreeVars
`addOneFV` Name
choiceAName
methodNamesMatch :: MatchGroup GhcRn (LHsCmd GhcRn) -> FreeVars
methodNamesMatch :: MatchGroup GhcRn (LHsCmd GhcRn) -> FreeVars
methodNamesMatch (MG { mg_alts :: forall p body. MatchGroup p body -> XRec p [LMatch p body]
mg_alts = L _ ms })
= [FreeVars] -> FreeVars
plusFVs ((GenLocated
SrcSpan (Match GhcRn (GenLocated SrcSpan (HsCmd GhcRn)))
-> FreeVars)
-> [GenLocated
SrcSpan (Match GhcRn (GenLocated SrcSpan (HsCmd GhcRn)))]
-> [FreeVars]
forall a b. (a -> b) -> [a] -> [b]
map GenLocated SrcSpan (Match GhcRn (GenLocated SrcSpan (HsCmd GhcRn)))
-> FreeVars
forall l.
GenLocated l (Match GhcRn (GenLocated SrcSpan (HsCmd GhcRn)))
-> FreeVars
do_one [GenLocated
SrcSpan (Match GhcRn (GenLocated SrcSpan (HsCmd GhcRn)))]
ms)
where
do_one :: GenLocated l (Match GhcRn (GenLocated SrcSpan (HsCmd GhcRn)))
-> FreeVars
do_one (L l
_ (Match { m_grhss :: forall p body. Match p body -> GRHSs p body
m_grhss = GRHSs GhcRn (GenLocated SrcSpan (HsCmd GhcRn))
grhss })) = GRHSs GhcRn (LHsCmd GhcRn) -> FreeVars
methodNamesGRHSs GRHSs GhcRn (GenLocated SrcSpan (HsCmd GhcRn))
GRHSs GhcRn (LHsCmd GhcRn)
grhss
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 ((Located (GRHS GhcRn (GenLocated SrcSpan (HsCmd GhcRn)))
-> FreeVars)
-> [Located (GRHS GhcRn (GenLocated SrcSpan (HsCmd GhcRn)))]
-> [FreeVars]
forall a b. (a -> b) -> [a] -> [b]
map Located (GRHS GhcRn (GenLocated SrcSpan (HsCmd GhcRn))) -> FreeVars
Located (GRHS GhcRn (LHsCmd GhcRn)) -> FreeVars
methodNamesGRHS [Located (GRHS GhcRn (GenLocated SrcSpan (HsCmd GhcRn)))]
[LGRHS GhcRn (LHsCmd GhcRn)]
grhss)
methodNamesGRHS :: Located (GRHS GhcRn (LHsCmd GhcRn)) -> CmdNeeds
methodNamesGRHS :: Located (GRHS GhcRn (LHsCmd GhcRn)) -> FreeVars
methodNamesGRHS (L SrcSpan
_ (GRHS XCGRHS GhcRn (LHsCmd GhcRn)
_ [ExprLStmt GhcRn]
_ LHsCmd GhcRn
rhs)) = LHsCmd GhcRn -> FreeVars
methodNamesLCmd LHsCmd GhcRn
rhs
methodNamesStmts :: [Located (StmtLR GhcRn GhcRn (LHsCmd GhcRn))] -> FreeVars
methodNamesStmts :: [Located (StmtLR GhcRn GhcRn (LHsCmd GhcRn))] -> FreeVars
methodNamesStmts [Located (StmtLR GhcRn GhcRn (LHsCmd GhcRn))]
stmts = [FreeVars] -> FreeVars
plusFVs ((Located (StmtLR GhcRn GhcRn (GenLocated SrcSpan (HsCmd GhcRn)))
-> FreeVars)
-> [Located
(StmtLR GhcRn GhcRn (GenLocated SrcSpan (HsCmd GhcRn)))]
-> [FreeVars]
forall a b. (a -> b) -> [a] -> [b]
map Located (StmtLR GhcRn GhcRn (GenLocated SrcSpan (HsCmd GhcRn)))
-> FreeVars
Located (StmtLR GhcRn GhcRn (LHsCmd GhcRn)) -> FreeVars
methodNamesLStmt [Located (StmtLR GhcRn GhcRn (GenLocated SrcSpan (HsCmd GhcRn)))]
[Located (StmtLR GhcRn GhcRn (LHsCmd GhcRn))]
stmts)
methodNamesLStmt :: Located (StmtLR GhcRn GhcRn (LHsCmd GhcRn)) -> FreeVars
methodNamesLStmt :: Located (StmtLR GhcRn GhcRn (LHsCmd GhcRn)) -> FreeVars
methodNamesLStmt = StmtLR GhcRn GhcRn (GenLocated SrcSpan (HsCmd GhcRn)) -> FreeVars
StmtLR GhcRn GhcRn (LHsCmd GhcRn) -> FreeVars
methodNamesStmt (StmtLR GhcRn GhcRn (GenLocated SrcSpan (HsCmd GhcRn)) -> FreeVars)
-> (Located (StmtLR GhcRn GhcRn (GenLocated SrcSpan (HsCmd GhcRn)))
-> StmtLR GhcRn GhcRn (GenLocated SrcSpan (HsCmd GhcRn)))
-> Located (StmtLR GhcRn GhcRn (GenLocated SrcSpan (HsCmd GhcRn)))
-> FreeVars
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Located (StmtLR GhcRn GhcRn (GenLocated SrcSpan (HsCmd GhcRn)))
-> StmtLR GhcRn GhcRn (GenLocated SrcSpan (HsCmd GhcRn))
forall l e. GenLocated l e -> e
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 Maybe 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) = 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 = [CmdLStmt GhcRn]
stmts }) =
[Located (StmtLR GhcRn GhcRn (LHsCmd GhcRn))] -> FreeVars
methodNamesStmts [Located (StmtLR GhcRn GhcRn (LHsCmd GhcRn))]
[CmdLStmt GhcRn]
stmts FreeVars -> Name -> FreeVars
`addOneFV` Name
loopAName
methodNamesStmt (LetStmt {}) = FreeVars
emptyFVs
methodNamesStmt (ParStmt {}) = FreeVars
emptyFVs
methodNamesStmt (TransStmt {}) = FreeVars
emptyFVs
methodNamesStmt ApplicativeStmt{} = FreeVars
emptyFVs
rnArithSeq :: ArithSeqInfo GhcPs -> RnM (ArithSeqInfo GhcRn, FreeVars)
rnArithSeq :: ArithSeqInfo GhcPs -> RnM (ArithSeqInfo GhcRn, FreeVars)
rnArithSeq (From LHsExpr GhcPs
expr)
= do { (Located (HsExpr 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 Located (HsExpr GhcRn)
LHsExpr GhcRn
expr', FreeVars
fvExpr) }
rnArithSeq (FromThen LHsExpr GhcPs
expr1 LHsExpr GhcPs
expr2)
= do { (Located (HsExpr GhcRn)
expr1', FreeVars
fvExpr1) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
expr1
; (Located (HsExpr 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 Located (HsExpr GhcRn)
LHsExpr GhcRn
expr1' Located (HsExpr GhcRn)
LHsExpr GhcRn
expr2', FreeVars
fvExpr1 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvExpr2) }
rnArithSeq (FromTo LHsExpr GhcPs
expr1 LHsExpr GhcPs
expr2)
= do { (Located (HsExpr GhcRn)
expr1', FreeVars
fvExpr1) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
expr1
; (Located (HsExpr 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 Located (HsExpr GhcRn)
LHsExpr GhcRn
expr1' Located (HsExpr GhcRn)
LHsExpr GhcRn
expr2', FreeVars
fvExpr1 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvExpr2) }
rnArithSeq (FromThenTo LHsExpr GhcPs
expr1 LHsExpr GhcPs
expr2 LHsExpr GhcPs
expr3)
= do { (Located (HsExpr GhcRn)
expr1', FreeVars
fvExpr1) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
expr1
; (Located (HsExpr GhcRn)
expr2', FreeVars
fvExpr2) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
expr2
; (Located (HsExpr 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 Located (HsExpr GhcRn)
LHsExpr GhcRn
expr1' Located (HsExpr GhcRn)
LHsExpr GhcRn
expr2' Located (HsExpr GhcRn)
LHsExpr GhcRn
expr3',
[FreeVars] -> FreeVars
plusFVs [FreeVars
fvExpr1, FreeVars
fvExpr2, FreeVars
fvExpr3]) }
rnStmts :: Outputable (body GhcPs)
=> HsStmtContext GhcRn
-> (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 GhcRn
-> (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 GhcRn
ctxt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody = HsStmtContext GhcRn
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> (HsStmtContext GhcRn
-> [(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 GhcRn
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> (HsStmtContext GhcRn
-> [(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 GhcRn
ctxt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody HsStmtContext GhcRn
-> [(LStmt GhcRn (Located (body GhcRn)), FreeVars)]
-> RnM ([LStmt GhcRn (Located (body GhcRn))], FreeVars)
forall (body :: * -> *).
HsStmtContext GhcRn
-> [(LStmt GhcRn (Located (body GhcRn)), FreeVars)]
-> RnM ([LStmt GhcRn (Located (body GhcRn))], FreeVars)
noPostProcessStmts
rnStmtsWithPostProcessing
:: Outputable (body GhcPs)
=> HsStmtContext GhcRn
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> (HsStmtContext GhcRn
-> [(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 GhcRn
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> (HsStmtContext GhcRn
-> [(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 GhcRn
ctxt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody HsStmtContext GhcRn
-> [(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 { (([(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))), FreeVars)]
stmts', thing
thing), FreeVars
fvs) <-
HsStmtContext GhcRn
-> (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 GhcRn
-> (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 GhcRn
ctxt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody [LStmt GhcPs (Located (body GhcPs))]
stmts [Name] -> RnM (thing, FreeVars)
thing_inside
; ([Located (StmtLR GhcRn GhcRn (Located (body GhcRn)))]
pp_stmts, FreeVars
fvs') <- HsStmtContext GhcRn
-> [(LStmt GhcRn (Located (body GhcRn)), FreeVars)]
-> RnM ([LStmt GhcRn (Located (body GhcRn))], FreeVars)
ppStmts HsStmtContext GhcRn
ctxt [(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))), FreeVars)]
[(LStmt GhcRn (Located (body GhcRn)), FreeVars)]
stmts'
; (([Located (StmtLR GhcRn GhcRn (Located (body GhcRn)))], thing),
FreeVars)
-> IOEnv
(Env TcGblEnv TcLclEnv)
(([Located (StmtLR GhcRn GhcRn (Located (body GhcRn)))], thing),
FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (([Located (StmtLR GhcRn GhcRn (Located (body GhcRn)))]
pp_stmts, thing
thing), FreeVars
fvs FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs')
}
postProcessStmtsForApplicativeDo
:: HsStmtContext GhcRn
-> [(ExprLStmt GhcRn, FreeVars)]
-> RnM ([ExprLStmt GhcRn], FreeVars)
postProcessStmtsForApplicativeDo :: HsStmtContext GhcRn
-> [(ExprLStmt GhcRn, FreeVars)]
-> RnM ([ExprLStmt GhcRn], FreeVars)
postProcessStmtsForApplicativeDo HsStmtContext GhcRn
ctxt [(ExprLStmt 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 | DoExpr{} <- HsStmtContext GhcRn
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" ([(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
-> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
[(ExprLStmt GhcRn, FreeVars)]
stmts)
; HsStmtContext GhcRn
-> [(ExprLStmt GhcRn, FreeVars)]
-> RnM ([ExprLStmt GhcRn], FreeVars)
rearrangeForApplicativeDo HsStmtContext GhcRn
ctxt [(ExprLStmt GhcRn, FreeVars)]
stmts }
else HsStmtContext GhcRn
-> [(LStmt GhcRn (Located (HsExpr GhcRn)), FreeVars)]
-> RnM ([LStmt GhcRn (Located (HsExpr GhcRn))], FreeVars)
forall (body :: * -> *).
HsStmtContext GhcRn
-> [(LStmt GhcRn (Located (body GhcRn)), FreeVars)]
-> RnM ([LStmt GhcRn (Located (body GhcRn))], FreeVars)
noPostProcessStmts HsStmtContext GhcRn
ctxt [(LStmt GhcRn (Located (HsExpr GhcRn)), FreeVars)]
[(ExprLStmt GhcRn, FreeVars)]
stmts }
noPostProcessStmts
:: HsStmtContext GhcRn
-> [(LStmt GhcRn (Located (body GhcRn)), FreeVars)]
-> RnM ([LStmt GhcRn (Located (body GhcRn))], FreeVars)
noPostProcessStmts :: HsStmtContext GhcRn
-> [(LStmt GhcRn (Located (body GhcRn)), FreeVars)]
-> RnM ([LStmt GhcRn (Located (body GhcRn))], FreeVars)
noPostProcessStmts HsStmtContext GhcRn
_ [(LStmt GhcRn (Located (body GhcRn)), FreeVars)]
stmts = ([Located (StmtLR GhcRn GhcRn (Located (body GhcRn)))], FreeVars)
-> IOEnv
(Env TcGblEnv TcLclEnv)
([Located (StmtLR GhcRn GhcRn (Located (body GhcRn)))], FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (((Located (StmtLR GhcRn GhcRn (Located (body GhcRn))), FreeVars)
-> Located (StmtLR GhcRn GhcRn (Located (body GhcRn))))
-> [(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)]
-> [Located (StmtLR GhcRn GhcRn (Located (body GhcRn)))]
forall a b. (a -> b) -> [a] -> [b]
map (Located (StmtLR GhcRn GhcRn (Located (body GhcRn))), FreeVars)
-> Located (StmtLR GhcRn GhcRn (Located (body GhcRn)))
forall a b. (a, b) -> a
fst [(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))), FreeVars)]
[(LStmt GhcRn (Located (body GhcRn)), FreeVars)]
stmts, FreeVars
emptyNameSet)
rnStmtsWithFreeVars :: Outputable (body GhcPs)
=> HsStmtContext GhcRn
-> (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 GhcRn
-> (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 GhcRn
ctxt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
_ [] [Name] -> RnM (thing, FreeVars)
thing_inside
= do { HsStmtContext GhcRn -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkEmptyStmts HsStmtContext GhcRn
ctxt
; (thing
thing, FreeVars
fvs) <- [Name] -> RnM (thing, FreeVars)
thing_inside []
; (([(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
thing),
FreeVars)
-> IOEnv
(Env TcGblEnv TcLclEnv)
(([(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
thing),
FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (([], thing
thing), FreeVars
fvs) }
rnStmtsWithFreeVars mDoExpr :: HsStmtContext GhcRn
mDoExpr@MDoExpr{} Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody [LStmt GhcPs (Located (body GhcPs))]
stmts [Name] -> RnM (thing, FreeVars)
thing_inside
=
do { (([(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))), FreeVars)]
stmts1, ([(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))), FreeVars)]
stmts2, thing
thing)), FreeVars
fvs)
<- HsStmtContext GhcRn
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> LStmt GhcPs (Located (body GhcPs))
-> ([Name]
-> IOEnv
(Env TcGblEnv TcLclEnv)
(([(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
thing),
FreeVars))
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)],
([(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))), FreeVars)],
thing)),
FreeVars)
forall (body :: * -> *) thing.
Outputable (body GhcPs) =>
HsStmtContext GhcRn
-> (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 GhcRn
mDoExpr Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody (StmtLR GhcPs GhcPs (Located (body GhcPs))
-> Located (StmtLR GhcPs GhcPs (Located (body GhcPs)))
forall e. e -> Located e
noLoc (StmtLR GhcPs GhcPs (Located (body GhcPs))
-> Located (StmtLR GhcPs GhcPs (Located (body GhcPs))))
-> StmtLR GhcPs GhcPs (Located (body GhcPs))
-> Located (StmtLR GhcPs 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 [Located (StmtLR GhcPs GhcPs (Located (body GhcPs)))]
[LStmt GhcPs (Located (body GhcPs))]
all_but_last) (([Name]
-> IOEnv
(Env TcGblEnv TcLclEnv)
(([(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
thing),
FreeVars))
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)],
([(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))), FreeVars)],
thing)),
FreeVars))
-> ([Name]
-> IOEnv
(Env TcGblEnv TcLclEnv)
(([(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
thing),
FreeVars))
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)],
([(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))), FreeVars)],
thing)),
FreeVars)
forall a b. (a -> b) -> a -> b
$ \ [Name]
_ ->
do { Located (StmtLR GhcPs GhcPs (Located (body GhcPs)))
last_stmt' <- HsStmtContext GhcRn
-> LStmt GhcPs (Located (body GhcPs))
-> RnM (LStmt GhcPs (Located (body GhcPs)))
forall (body :: * -> *).
Outputable (body GhcPs) =>
HsStmtContext GhcRn
-> LStmt GhcPs (Located (body GhcPs))
-> RnM (LStmt GhcPs (Located (body GhcPs)))
checkLastStmt HsStmtContext GhcRn
mDoExpr Located (StmtLR GhcPs GhcPs (Located (body GhcPs)))
LStmt GhcPs (Located (body GhcPs))
last_stmt
; HsStmtContext GhcRn
-> (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 GhcRn
-> (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 GhcRn
mDoExpr Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody Located (StmtLR GhcPs GhcPs (Located (body GhcPs)))
LStmt GhcPs (Located (body GhcPs))
last_stmt' [Name] -> RnM (thing, FreeVars)
thing_inside }
; (([(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
thing),
FreeVars)
-> IOEnv
(Env TcGblEnv TcLclEnv)
(([(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
thing),
FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return ((([(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))), FreeVars)]
stmts1 [(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))), FreeVars)]
-> [(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)]
-> [(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)]
forall a. [a] -> [a] -> [a]
++ [(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))), FreeVars)]
stmts2), thing
thing), FreeVars
fvs) }
where
Just ([Located (StmtLR GhcPs GhcPs (Located (body GhcPs)))]
all_but_last, Located (StmtLR GhcPs GhcPs (Located (body GhcPs)))
last_stmt) = [Located (StmtLR GhcPs GhcPs (Located (body GhcPs)))]
-> Maybe
([Located (StmtLR GhcPs GhcPs (Located (body GhcPs)))],
Located (StmtLR GhcPs GhcPs (Located (body GhcPs))))
forall a. [a] -> Maybe ([a], a)
snocView [Located (StmtLR GhcPs GhcPs (Located (body GhcPs)))]
[LStmt GhcPs (Located (body GhcPs))]
stmts
rnStmtsWithFreeVars HsStmtContext GhcRn
ctxt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody (lstmt :: LStmt GhcPs (Located (body GhcPs))
lstmt@(L loc _) : [LStmt GhcPs (Located (body GhcPs))]
lstmts) [Name] -> RnM (thing, FreeVars)
thing_inside
| [Located (StmtLR GhcPs GhcPs (Located (body GhcPs)))] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Located (StmtLR GhcPs GhcPs (Located (body GhcPs)))]
[LStmt GhcPs (Located (body GhcPs))]
lstmts
= SrcSpan
-> IOEnv
(Env TcGblEnv TcLclEnv)
(([(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
thing),
FreeVars)
-> IOEnv
(Env TcGblEnv TcLclEnv)
(([(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
thing),
FreeVars)
forall a. SrcSpan -> TcRn a -> TcRn a
setSrcSpan SrcSpan
loc (IOEnv
(Env TcGblEnv TcLclEnv)
(([(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
thing),
FreeVars)
-> IOEnv
(Env TcGblEnv TcLclEnv)
(([(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
thing),
FreeVars))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(([(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
thing),
FreeVars)
-> IOEnv
(Env TcGblEnv TcLclEnv)
(([(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
thing),
FreeVars)
forall a b. (a -> b) -> a -> b
$
do { Located (StmtLR GhcPs GhcPs (Located (body GhcPs)))
lstmt' <- HsStmtContext GhcRn
-> LStmt GhcPs (Located (body GhcPs))
-> RnM (LStmt GhcPs (Located (body GhcPs)))
forall (body :: * -> *).
Outputable (body GhcPs) =>
HsStmtContext GhcRn
-> LStmt GhcPs (Located (body GhcPs))
-> RnM (LStmt GhcPs (Located (body GhcPs)))
checkLastStmt HsStmtContext GhcRn
ctxt LStmt GhcPs (Located (body GhcPs))
lstmt
; HsStmtContext GhcRn
-> (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 GhcRn
-> (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 GhcRn
ctxt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody Located (StmtLR GhcPs GhcPs (Located (body GhcPs)))
LStmt GhcPs (Located (body GhcPs))
lstmt' [Name] -> RnM (thing, FreeVars)
thing_inside }
| Bool
otherwise
= do { (([(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))), FreeVars)]
stmts1, ([(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))), FreeVars)]
stmts2, thing
thing)), FreeVars
fvs)
<- SrcSpan
-> IOEnv
(Env TcGblEnv TcLclEnv)
(([(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
([(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))), FreeVars)],
thing)),
FreeVars)
-> IOEnv
(Env TcGblEnv TcLclEnv)
(([(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
([(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))), FreeVars)],
thing)),
FreeVars)
forall a. SrcSpan -> TcRn a -> TcRn a
setSrcSpan SrcSpan
loc (IOEnv
(Env TcGblEnv TcLclEnv)
(([(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
([(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))), FreeVars)],
thing)),
FreeVars)
-> IOEnv
(Env TcGblEnv TcLclEnv)
(([(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
([(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))), FreeVars)],
thing)),
FreeVars))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(([(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
([(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))), FreeVars)],
thing)),
FreeVars)
-> IOEnv
(Env TcGblEnv TcLclEnv)
(([(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
([(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))), FreeVars)],
thing)),
FreeVars)
forall a b. (a -> b) -> a -> b
$
do { HsStmtContext GhcRn
-> LStmt GhcPs (Located (body GhcPs))
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (body :: * -> *).
HsStmtContext GhcRn
-> LStmt GhcPs (Located (body GhcPs))
-> IOEnv (Env TcGblEnv TcLclEnv) ()
checkStmt HsStmtContext GhcRn
ctxt LStmt GhcPs (Located (body GhcPs))
lstmt
; HsStmtContext GhcRn
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> LStmt GhcPs (Located (body GhcPs))
-> ([Name]
-> IOEnv
(Env TcGblEnv TcLclEnv)
(([(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
thing),
FreeVars))
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)],
([(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))), FreeVars)],
thing)),
FreeVars)
forall (body :: * -> *) thing.
Outputable (body GhcPs) =>
HsStmtContext GhcRn
-> (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 GhcRn
ctxt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody LStmt GhcPs (Located (body GhcPs))
lstmt (([Name]
-> IOEnv
(Env TcGblEnv TcLclEnv)
(([(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
thing),
FreeVars))
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)],
([(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))), FreeVars)],
thing)),
FreeVars))
-> ([Name]
-> IOEnv
(Env TcGblEnv TcLclEnv)
(([(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
thing),
FreeVars))
-> RnM
(([(LStmt GhcRn (Located (body GhcRn)), FreeVars)],
([(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))), FreeVars)],
thing)),
FreeVars)
forall a b. (a -> b) -> a -> b
$ \ [Name]
bndrs1 ->
HsStmtContext GhcRn
-> (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 GhcRn
-> (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 GhcRn
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) }
; (([(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
thing),
FreeVars)
-> IOEnv
(Env TcGblEnv TcLclEnv)
(([(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
thing),
FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return ((([(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))), FreeVars)]
stmts1 [(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))), FreeVars)]
-> [(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)]
-> [(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)]
forall a. [a] -> [a] -> [a]
++ [(Located (StmtLR GhcRn GhcRn (Located (body GhcRn))), FreeVars)]
stmts2), thing
thing), FreeVars
fvs) }
rnStmt :: Outputable (body GhcPs)
=> HsStmtContext GhcRn
-> (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 GhcRn
-> (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 GhcRn
ctxt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody (L loc (LastStmt _ body noret _)) [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
; (SyntaxExprRn
ret_op, FreeVars
fvs1) <- if HsStmtContext GhcRn -> Bool
forall id. HsStmtContext id -> Bool
isMonadCompContext HsStmtContext GhcRn
ctxt
then HsStmtContext GhcRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupStmtName HsStmtContext GhcRn
ctxt Name
returnMName
else (SyntaxExprRn, FreeVars)
-> IOEnv (Env TcGblEnv TcLclEnv) (SyntaxExprRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (SyntaxExprRn
forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr, FreeVars
emptyFVs)
; (thing
thing, FreeVars
fvs3) <- [Name] -> RnM (thing, FreeVars)
thing_inside []
; (([(GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
thing),
FreeVars)
-> IOEnv
(Env TcGblEnv TcLclEnv)
(([(GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
thing),
FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (([(SrcSpan
-> StmtLR GhcRn GhcRn (Located (body GhcRn))
-> GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn)))
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc (XLastStmt GhcRn GhcRn (Located (body GhcRn))
-> Located (body GhcRn)
-> Maybe Bool
-> SyntaxExpr GhcRn
-> StmtLR GhcRn GhcRn (Located (body GhcRn))
forall idL idR body.
XLastStmt idL idR body
-> body -> Maybe Bool -> SyntaxExpr idR -> StmtLR idL idR body
LastStmt NoExtField
XLastStmt GhcRn GhcRn (Located (body GhcRn))
noExtField Located (body GhcRn)
body' Maybe Bool
noret SyntaxExprRn
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 GhcRn
ctxt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody (L loc (BodyStmt _ body _ _)) [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
; (SyntaxExprRn
then_op, FreeVars
fvs1) <- HsStmtContext GhcRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupQualifiedDoStmtName HsStmtContext GhcRn
ctxt Name
thenMName
; (SyntaxExprRn
guard_op, FreeVars
fvs2) <- if HsStmtContext GhcRn -> Bool
forall id. HsStmtContext id -> Bool
isComprehensionContext HsStmtContext GhcRn
ctxt
then HsStmtContext GhcRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupStmtName HsStmtContext GhcRn
ctxt Name
guardMName
else (SyntaxExprRn, FreeVars)
-> IOEnv (Env TcGblEnv TcLclEnv) (SyntaxExprRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (SyntaxExprRn
forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr, FreeVars
emptyFVs)
; (thing
thing, FreeVars
fvs3) <- [Name] -> RnM (thing, FreeVars)
thing_inside []
; (([(GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
thing),
FreeVars)
-> IOEnv
(Env TcGblEnv TcLclEnv)
(([(GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
thing),
FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return ( ([(SrcSpan
-> StmtLR GhcRn GhcRn (Located (body GhcRn))
-> GenLocated SrcSpan (StmtLR GhcRn 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 NoExtField
XBodyStmt GhcRn GhcRn (Located (body GhcRn))
noExtField Located (body GhcRn)
body' SyntaxExprRn
SyntaxExpr GhcRn
then_op SyntaxExprRn
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 GhcRn
ctxt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody (L loc (BindStmt _ pat body)) [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
; (SyntaxExprRn
bind_op, FreeVars
fvs1) <- HsStmtContext GhcRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupQualifiedDoStmtName HsStmtContext GhcRn
ctxt Name
bindMName
; (Maybe SyntaxExprRn
fail_op, FreeVars
fvs2) <- LPat GhcPs
-> HsStmtContext GhcRn -> RnM (Maybe (SyntaxExpr GhcRn), FreeVars)
monadFailOp LPat GhcPs
pat HsStmtContext GhcRn
ctxt
; HsMatchContext GhcRn
-> LPat GhcPs
-> (LPat GhcRn
-> IOEnv
(Env TcGblEnv TcLclEnv)
(([(GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
thing),
FreeVars))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(([(GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
thing),
FreeVars)
forall a.
HsMatchContext GhcRn
-> LPat GhcPs
-> (LPat GhcRn -> RnM (a, FreeVars))
-> RnM (a, FreeVars)
rnPat (HsStmtContext GhcRn -> HsMatchContext GhcRn
forall p. HsStmtContext p -> HsMatchContext p
StmtCtxt HsStmtContext GhcRn
ctxt) LPat GhcPs
pat ((LPat GhcRn
-> IOEnv
(Env TcGblEnv TcLclEnv)
(([(GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
thing),
FreeVars))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(([(GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
thing),
FreeVars))
-> (LPat GhcRn
-> IOEnv
(Env TcGblEnv TcLclEnv)
(([(GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
thing),
FreeVars))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(([(GenLocated SrcSpan (StmtLR GhcRn 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. CollectPass p => LPat p -> [IdP p]
collectPatBinders LPat GhcRn
pat')
; let xbsrn :: XBindStmtRn
xbsrn = XBindStmtRn :: SyntaxExpr GhcRn -> Maybe (SyntaxExpr GhcRn) -> XBindStmtRn
XBindStmtRn { xbsrn_bindOp :: SyntaxExpr GhcRn
xbsrn_bindOp = SyntaxExprRn
SyntaxExpr GhcRn
bind_op, xbsrn_failOp :: Maybe (SyntaxExpr GhcRn)
xbsrn_failOp = Maybe SyntaxExprRn
Maybe (SyntaxExpr GhcRn)
fail_op }
; (([(GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
thing),
FreeVars)
-> IOEnv
(Env TcGblEnv TcLclEnv)
(([(GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
thing),
FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (( [( SrcSpan
-> StmtLR GhcRn GhcRn (Located (body GhcRn))
-> GenLocated SrcSpan (StmtLR GhcRn 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)
-> StmtLR GhcRn GhcRn (Located (body GhcRn))
forall idL idR body.
XBindStmt idL idR body -> LPat idL -> body -> StmtLR idL idR body
BindStmt XBindStmtRn
XBindStmt GhcRn GhcRn (Located (body GhcRn))
xbsrn LPat GhcRn
pat' Located (body GhcRn)
body'), 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 GhcRn
_ Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
_ (L loc (LetStmt _ (L l binds))) [Name] -> RnM (thing, FreeVars)
thing_inside
= HsLocalBinds GhcPs
-> (HsLocalBinds GhcRn
-> FreeVars
-> IOEnv
(Env TcGblEnv TcLclEnv)
(([(GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
thing),
FreeVars))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(([(GenLocated SrcSpan (StmtLR GhcRn 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
-> IOEnv
(Env TcGblEnv TcLclEnv)
(([(GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
thing),
FreeVars))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(([(GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
thing),
FreeVars))
-> (HsLocalBinds GhcRn
-> FreeVars
-> IOEnv
(Env TcGblEnv TcLclEnv)
(([(GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
thing),
FreeVars))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(([(GenLocated SrcSpan (StmtLR GhcRn 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).
CollectPass (GhcPass idL) =>
HsLocalBindsLR (GhcPass idL) (GhcPass idR) -> [IdP (GhcPass idL)]
collectLocalBinders HsLocalBinds GhcRn
binds')
; (([(GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
thing),
FreeVars)
-> IOEnv
(Env TcGblEnv TcLclEnv)
(([(GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
thing),
FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return ( ([(SrcSpan
-> StmtLR GhcRn GhcRn (Located (body GhcRn))
-> GenLocated SrcSpan (StmtLR GhcRn 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 NoExtField
XLetStmt GhcRn GhcRn (Located (body GhcRn))
noExtField (SrcSpan
-> HsLocalBinds GhcRn -> GenLocated SrcSpan (HsLocalBinds GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpan
l HsLocalBinds GhcRn
binds')), FreeVars
bind_fvs)], thing
thing)
, FreeVars
fvs) }
rnStmt HsStmtContext GhcRn
ctxt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody (L loc (RecStmt { recS_stmts = rec_stmts })) [Name] -> RnM (thing, FreeVars)
thing_inside
= do { (SyntaxExprRn
return_op, FreeVars
fvs1) <- HsStmtContext GhcRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupQualifiedDoStmtName HsStmtContext GhcRn
ctxt Name
returnMName
; (SyntaxExprRn
mfix_op, FreeVars
fvs2) <- HsStmtContext GhcRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupQualifiedDoStmtName HsStmtContext GhcRn
ctxt Name
mfixName
; (SyntaxExprRn
bind_op, FreeVars
fvs3) <- HsStmtContext GhcRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupQualifiedDoStmtName HsStmtContext GhcRn
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 = SyntaxExprRn
SyntaxExpr GhcRn
return_op
, recS_mfix_fn :: SyntaxExpr GhcRn
recS_mfix_fn = SyntaxExprRn
SyntaxExpr GhcRn
mfix_op
, recS_bind_fn :: SyntaxExpr GhcRn
recS_bind_fn = SyntaxExprRn
SyntaxExpr GhcRn
bind_op }
; HsStmtContext GhcRn
-> (Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars))
-> [LStmt GhcPs (Located (body GhcPs))]
-> ([Segment (LStmt GhcRn (Located (body GhcRn)))]
-> IOEnv
(Env TcGblEnv TcLclEnv)
(([(GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
thing),
FreeVars))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(([(GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
thing),
FreeVars)
forall (body :: * -> *) a.
Outputable (body GhcPs) =>
HsStmtContext GhcRn
-> (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 HsStmtContext GhcRn
ctxt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody [LStmt GhcPs (Located (body GhcPs))]
rec_stmts (([Segment (LStmt GhcRn (Located (body GhcRn)))]
-> IOEnv
(Env TcGblEnv TcLclEnv)
(([(GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
thing),
FreeVars))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(([(GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
thing),
FreeVars))
-> ([Segment (LStmt GhcRn (Located (body GhcRn)))]
-> IOEnv
(Env TcGblEnv TcLclEnv)
(([(GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
thing),
FreeVars))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(([(GenLocated SrcSpan (StmtLR GhcRn 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
$
((FreeVars, FreeVars, FreeVars,
GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))))
-> FreeVars -> FreeVars)
-> FreeVars
-> [(FreeVars, FreeVars, FreeVars,
GenLocated SrcSpan (StmtLR GhcRn 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)
-> ((FreeVars, FreeVars, FreeVars,
GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))))
-> FreeVars)
-> (FreeVars, FreeVars, FreeVars,
GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))))
-> FreeVars
-> FreeVars
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (\(FreeVars
ds,FreeVars
_,FreeVars
_,GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn)))
_) -> FreeVars
ds))
FreeVars
emptyNameSet
[(FreeVars, FreeVars, FreeVars,
GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))))]
[Segment (LStmt GhcRn (Located (body GhcRn)))]
segs
; (thing
thing, FreeVars
fvs_later) <- [Name] -> RnM (thing, FreeVars)
thing_inside [Name]
bndrs
; let ([GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn)))]
rec_stmts', FreeVars
fvs) = SrcSpan
-> HsStmtContext GhcRn
-> StmtLR GhcRn GhcRn (Located (body GhcRn))
-> [Segment (LStmt GhcRn (Located (body GhcRn)))]
-> FreeVars
-> ([LStmt GhcRn (Located (body GhcRn))], FreeVars)
forall body.
SrcSpan
-> HsStmtContext GhcRn
-> Stmt GhcRn body
-> [Segment (LStmt GhcRn body)]
-> FreeVars
-> ([LStmt GhcRn body], FreeVars)
segmentRecStmts SrcSpan
loc HsStmtContext GhcRn
ctxt StmtLR GhcRn GhcRn (Located (body GhcRn))
empty_rec_stmt [Segment (LStmt GhcRn (Located (body GhcRn)))]
segs FreeVars
fvs_later
; (([(GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
thing),
FreeVars)
-> IOEnv
(Env TcGblEnv TcLclEnv)
(([(GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
thing),
FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return ( (([GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn)))]
-> [FreeVars]
-> [(GenLocated
SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)]
forall a b. [a] -> [b] -> [(a, b)]
zip [GenLocated SrcSpan (StmtLR GhcRn 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 GhcRn
ctxt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
_ (L loc (ParStmt _ segs _ _)) [Name] -> RnM (thing, FreeVars)
thing_inside
= do { (HsExpr GhcRn
mzip_op, FreeVars
fvs1) <- HsStmtContext GhcRn -> Name -> TcM (HsExpr GhcRn, FreeVars)
lookupStmtNamePoly HsStmtContext GhcRn
ctxt Name
mzipName
; (SyntaxExprRn
bind_op, FreeVars
fvs2) <- HsStmtContext GhcRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupStmtName HsStmtContext GhcRn
ctxt Name
bindMName
; (SyntaxExprRn
return_op, FreeVars
fvs3) <- HsStmtContext GhcRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupStmtName HsStmtContext GhcRn
ctxt Name
returnMName
; (([ParStmtBlock GhcRn GhcRn]
segs', thing
thing), FreeVars
fvs4) <- HsStmtContext GhcRn
-> SyntaxExpr GhcRn
-> [ParStmtBlock GhcPs GhcPs]
-> ([Name] -> RnM (thing, FreeVars))
-> RnM (([ParStmtBlock GhcRn GhcRn], thing), FreeVars)
forall thing.
HsStmtContext GhcRn
-> SyntaxExpr GhcRn
-> [ParStmtBlock GhcPs GhcPs]
-> ([Name] -> RnM (thing, FreeVars))
-> RnM (([ParStmtBlock GhcRn GhcRn], thing), FreeVars)
rnParallelStmts (HsStmtContext GhcRn -> HsStmtContext GhcRn
forall p. HsStmtContext p -> HsStmtContext p
ParStmtCtxt HsStmtContext GhcRn
ctxt) SyntaxExprRn
SyntaxExpr GhcRn
return_op [ParStmtBlock GhcPs GhcPs]
segs [Name] -> RnM (thing, FreeVars)
thing_inside
; (([(GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
thing),
FreeVars)
-> IOEnv
(Env TcGblEnv TcLclEnv)
(([(GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
thing),
FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (([(SrcSpan
-> StmtLR GhcRn GhcRn (Located (body GhcRn))
-> GenLocated SrcSpan (StmtLR GhcRn 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 NoExtField
XParStmt GhcRn GhcRn (Located (body GhcRn))
noExtField [ParStmtBlock GhcRn GhcRn]
segs' HsExpr GhcRn
mzip_op SyntaxExprRn
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 GhcRn
ctxt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
_ (L loc (TransStmt { trS_stmts = stmts, trS_by = by, trS_form = form
, trS_using = using })) [Name] -> RnM (thing, FreeVars)
thing_inside
= do {
(Located (HsExpr GhcRn)
using', FreeVars
fvs1) <- LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr LHsExpr GhcPs
using
; (([Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))]
stmts', (Maybe (Located (HsExpr GhcRn))
by', [Name]
used_bndrs, thing
thing)), FreeVars
fvs2)
<- HsStmtContext GhcRn
-> (Located (HsExpr GhcPs)
-> IOEnv
(Env TcGblEnv TcLclEnv) (Located (HsExpr GhcRn), FreeVars))
-> [LStmt GhcPs (Located (HsExpr GhcPs))]
-> ([Name]
-> RnM ((Maybe (Located (HsExpr GhcRn)), [Name], thing), FreeVars))
-> RnM
(([LStmt GhcRn (Located (HsExpr GhcRn))],
(Maybe (Located (HsExpr GhcRn)), [Name], thing)),
FreeVars)
forall (body :: * -> *) thing.
Outputable (body GhcPs) =>
HsStmtContext GhcRn
-> (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 GhcRn -> HsStmtContext GhcRn
forall p. HsStmtContext p -> HsStmtContext p
TransStmtCtxt HsStmtContext GhcRn
ctxt) Located (HsExpr GhcPs)
-> IOEnv (Env TcGblEnv TcLclEnv) (Located (HsExpr GhcRn), FreeVars)
LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr [LStmt GhcPs (Located (HsExpr GhcPs))]
[ExprLStmt GhcPs]
stmts (([Name]
-> RnM ((Maybe (Located (HsExpr GhcRn)), [Name], thing), FreeVars))
-> RnM
(([LStmt GhcRn (Located (HsExpr GhcRn))],
(Maybe (Located (HsExpr GhcRn)), [Name], thing)),
FreeVars))
-> ([Name]
-> RnM ((Maybe (Located (HsExpr GhcRn)), [Name], thing), FreeVars))
-> RnM
(([LStmt GhcRn (Located (HsExpr GhcRn))],
(Maybe (Located (HsExpr GhcRn)), [Name], thing)),
FreeVars)
forall a b. (a -> b) -> a -> b
$ \ [Name]
bndrs ->
do { (Maybe (Located (HsExpr GhcRn))
by', FreeVars
fvs_by) <- (Located (HsExpr GhcPs)
-> IOEnv
(Env TcGblEnv TcLclEnv) (Located (HsExpr GhcRn), FreeVars))
-> Maybe (Located (HsExpr GhcPs))
-> RnM (Maybe (Located (HsExpr GhcRn)), FreeVars)
forall a b.
(a -> RnM (b, FreeVars)) -> Maybe a -> RnM (Maybe b, FreeVars)
mapMaybeFvRn Located (HsExpr GhcPs)
-> IOEnv (Env TcGblEnv TcLclEnv) (Located (HsExpr GhcRn), FreeVars)
LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr Maybe (Located (HsExpr GhcPs))
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 (Located (HsExpr GhcRn)), [Name], thing), FreeVars)
-> RnM ((Maybe (Located (HsExpr GhcRn)), [Name], thing), FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return ((Maybe (Located (HsExpr GhcRn))
by', [Name]
used_bndrs, thing
thing), FreeVars
fvs) }
; (SyntaxExprRn
return_op, FreeVars
fvs3) <- HsStmtContext GhcRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupStmtName HsStmtContext GhcRn
ctxt Name
returnMName
; (SyntaxExprRn
bind_op, FreeVars
fvs4) <- HsStmtContext GhcRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupStmtName HsStmtContext GhcRn
ctxt Name
bindMName
; (HsExpr GhcRn
fmap_op, FreeVars
fvs5) <- case TransForm
form of
TransForm
ThenForm -> (HsExpr GhcRn, FreeVars) -> TcM (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 GhcRn -> Name -> TcM (HsExpr GhcRn, FreeVars)
lookupStmtNamePoly HsStmtContext GhcRn
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)
; (([(GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
thing),
FreeVars)
-> IOEnv
(Env TcGblEnv TcLclEnv)
(([(GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
thing),
FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (([(SrcSpan
-> StmtLR GhcRn GhcRn (Located (body GhcRn))
-> GenLocated SrcSpan (StmtLR GhcRn 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 = NoExtField
XTransStmt GhcRn GhcRn (Located (body GhcRn))
noExtField
, trS_stmts :: [ExprLStmt GhcRn]
trS_stmts = [Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))]
[ExprLStmt 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 (Located (HsExpr GhcRn))
Maybe (LHsExpr GhcRn)
by', trS_using :: LHsExpr GhcRn
trS_using = Located (HsExpr GhcRn)
LHsExpr GhcRn
using', trS_form :: TransForm
trS_form = TransForm
form
, trS_ret :: SyntaxExpr GhcRn
trS_ret = SyntaxExprRn
SyntaxExpr GhcRn
return_op, trS_bind :: SyntaxExpr GhcRn
trS_bind = SyntaxExprRn
SyntaxExpr GhcRn
bind_op
, trS_fmap :: HsExpr GhcRn
trS_fmap = HsExpr GhcRn
fmap_op }), FreeVars
fvs2)], thing
thing), FreeVars
all_fvs) }
rnStmt HsStmtContext GhcRn
_ Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
_ (L _ ApplicativeStmt{}) [Name] -> RnM (thing, FreeVars)
_ =
String
-> IOEnv
(Env TcGblEnv TcLclEnv)
(([(GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
thing),
FreeVars)
forall a. String -> a
panic String
"rnStmt: ApplicativeStmt"
rnParallelStmts :: forall thing. HsStmtContext GhcRn
-> SyntaxExpr GhcRn
-> [ParStmtBlock GhcPs GhcPs]
-> ([Name] -> RnM (thing, FreeVars))
-> RnM (([ParStmtBlock GhcRn GhcRn], thing), FreeVars)
rnParallelStmts :: HsStmtContext GhcRn
-> SyntaxExpr GhcRn
-> [ParStmtBlock GhcPs GhcPs]
-> ([Name] -> RnM (thing, FreeVars))
-> RnM (([ParStmtBlock GhcRn GhcRn], thing), FreeVars)
rnParallelStmts HsStmtContext GhcRn
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 { (([Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))]
stmts', ([Name]
used_bndrs, [ParStmtBlock GhcRn GhcRn]
segs', thing
thing)), FreeVars
fvs)
<- HsStmtContext GhcRn
-> (Located (HsExpr GhcPs)
-> IOEnv
(Env TcGblEnv TcLclEnv) (Located (HsExpr GhcRn), FreeVars))
-> [LStmt GhcPs (Located (HsExpr GhcPs))]
-> ([Name]
-> RnM (([Name], [ParStmtBlock GhcRn GhcRn], thing), FreeVars))
-> RnM
(([LStmt GhcRn (Located (HsExpr GhcRn))],
([Name], [ParStmtBlock GhcRn GhcRn], thing)),
FreeVars)
forall (body :: * -> *) thing.
Outputable (body GhcPs) =>
HsStmtContext GhcRn
-> (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 GhcRn
ctxt Located (HsExpr GhcPs)
-> IOEnv (Env TcGblEnv TcLclEnv) (Located (HsExpr GhcRn), FreeVars)
LHsExpr GhcPs -> RnM (LHsExpr GhcRn, FreeVars)
rnLExpr [LStmt GhcPs (Located (HsExpr GhcPs))]
[ExprLStmt GhcPs]
stmts (([Name]
-> RnM (([Name], [ParStmtBlock GhcRn GhcRn], thing), FreeVars))
-> RnM
(([LStmt GhcRn (Located (HsExpr GhcRn))],
([Name], [ParStmtBlock GhcRn GhcRn], thing)),
FreeVars))
-> ([Name]
-> RnM (([Name], [ParStmtBlock GhcRn GhcRn], thing), FreeVars))
-> RnM
(([LStmt GhcRn (Located (HsExpr 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
-> [ExprLStmt 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 [Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))]
[ExprLStmt 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) }
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)))
lookupQualifiedDoStmtName :: HsStmtContext GhcRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupQualifiedDoStmtName :: HsStmtContext GhcRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupQualifiedDoStmtName HsStmtContext GhcRn
ctxt Name
n
= case HsStmtContext GhcRn -> Maybe ModuleName
forall p. HsStmtContext p -> Maybe ModuleName
qualifiedDoModuleName_maybe HsStmtContext GhcRn
ctxt of
Maybe ModuleName
Nothing -> HsStmtContext GhcRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupStmtName HsStmtContext GhcRn
ctxt Name
n
Just ModuleName
modName ->
(Name -> SyntaxExprRn)
-> (Name, FreeVars) -> (SyntaxExprRn, FreeVars)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (HsExpr GhcRn -> SyntaxExprRn
mkSyntaxExpr (HsExpr GhcRn -> SyntaxExprRn)
-> (Name -> HsExpr GhcRn) -> Name -> SyntaxExprRn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> HsExpr GhcRn
forall (id :: Pass). IdP (GhcPass id) -> HsExpr (GhcPass id)
nl_HsVar) ((Name, FreeVars) -> (SyntaxExprRn, FreeVars))
-> IOEnv (Env TcGblEnv TcLclEnv) (Name, FreeVars)
-> IOEnv (Env TcGblEnv TcLclEnv) (SyntaxExprRn, FreeVars)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Name
-> ModuleName -> IOEnv (Env TcGblEnv TcLclEnv) (Name, FreeVars)
lookupNameWithQualifier Name
n ModuleName
modName
lookupStmtName :: HsStmtContext GhcRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupStmtName :: HsStmtContext GhcRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupStmtName HsStmtContext GhcRn
ctxt Name
n
| HsStmtContext GhcRn -> Bool
rebindableContext HsStmtContext GhcRn
ctxt
= Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupSyntax Name
n
| Bool
otherwise
= (SyntaxExprRn, FreeVars)
-> IOEnv (Env TcGblEnv TcLclEnv) (SyntaxExprRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (Name -> SyntaxExprRn
mkRnSyntaxExpr Name
n, FreeVars
emptyFVs)
lookupStmtNamePoly :: HsStmtContext GhcRn -> Name -> RnM (HsExpr GhcRn, FreeVars)
lookupStmtNamePoly :: HsStmtContext GhcRn -> Name -> TcM (HsExpr GhcRn, FreeVars)
lookupStmtNamePoly HsStmtContext GhcRn
ctxt Name
name
| HsStmtContext GhcRn -> Bool
rebindableContext HsStmtContext GhcRn
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) -> TcM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XVar GhcRn -> LIdP GhcRn -> HsExpr GhcRn
forall p. XVar p -> LIdP p -> HsExpr p
HsVar NoExtField
XVar GhcRn
noExtField (Name -> Located Name
forall e. e -> Located e
noLoc Name
fm), Name -> FreeVars
unitFV Name
fm) }
else TcM (HsExpr GhcRn, FreeVars)
not_rebindable }
| Bool
otherwise
= TcM (HsExpr GhcRn, FreeVars)
not_rebindable
where
not_rebindable :: TcM (HsExpr GhcRn, FreeVars)
not_rebindable = (HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (XVar GhcRn -> LIdP GhcRn -> HsExpr GhcRn
forall p. XVar p -> LIdP p -> HsExpr p
HsVar NoExtField
XVar GhcRn
noExtField (Name -> Located Name
forall e. e -> Located e
noLoc Name
name), FreeVars
emptyFVs)
rebindableContext :: HsStmtContext GhcRn -> Bool
rebindableContext :: HsStmtContext GhcRn -> Bool
rebindableContext HsStmtContext GhcRn
ctxt = case HsStmtContext GhcRn
ctxt of
HsStmtContext GhcRn
ListComp -> Bool
False
HsStmtContext GhcRn
ArrowExpr -> Bool
False
PatGuard {} -> Bool
False
DoExpr Maybe ModuleName
m -> Maybe ModuleName -> Bool
forall a. Maybe a -> Bool
isNothing Maybe ModuleName
m
MDoExpr Maybe ModuleName
m -> Maybe ModuleName -> Bool
forall a. Maybe a -> Bool
isNothing Maybe ModuleName
m
HsStmtContext GhcRn
MonadComp -> Bool
True
HsStmtContext GhcRn
GhciStmtCtxt -> Bool
True
ParStmtCtxt HsStmtContext GhcRn
c -> HsStmtContext GhcRn -> Bool
rebindableContext HsStmtContext GhcRn
c
TransStmtCtxt HsStmtContext GhcRn
c -> HsStmtContext GhcRn -> Bool
rebindableContext HsStmtContext GhcRn
c
type FwdRefs = NameSet
type Segment stmts = (Defs,
Uses,
FwdRefs,
stmts)
rnRecStmtsAndThen :: Outputable (body GhcPs) =>
HsStmtContext GhcRn
-> (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 :: HsStmtContext GhcRn
-> (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 HsStmtContext GhcRn
ctxt 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)
; [(Located (StmtLR 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.
CollectPass (GhcPass idL) =>
[LStmtLR (GhcPass idL) (GhcPass idR) body] -> [IdP (GhcPass idL)]
collectLStmtsBinders (((Located (StmtLR GhcRn GhcPs (Located (body GhcPs))), FreeVars)
-> Located (StmtLR GhcRn GhcPs (Located (body GhcPs))))
-> [(Located (StmtLR GhcRn GhcPs (Located (body GhcPs))),
FreeVars)]
-> [Located (StmtLR GhcRn GhcPs (Located (body GhcPs)))]
forall a b. (a -> b) -> [a] -> [b]
map (Located (StmtLR GhcRn GhcPs (Located (body GhcPs))), FreeVars)
-> Located (StmtLR GhcRn GhcPs (Located (body GhcPs)))
forall a b. (a, b) -> a
fst [(Located (StmtLR 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 (((Located (StmtLR GhcRn GhcPs (Located (body GhcPs))), FreeVars)
-> Located (StmtLR GhcRn GhcPs (Located (body GhcPs))))
-> [(Located (StmtLR GhcRn GhcPs (Located (body GhcPs))),
FreeVars)]
-> [Located (StmtLR GhcRn GhcPs (Located (body GhcPs)))]
forall a b. (a -> b) -> [a] -> [b]
map (Located (StmtLR GhcRn GhcPs (Located (body GhcPs))), FreeVars)
-> Located (StmtLR GhcRn GhcPs (Located (body GhcPs)))
forall a b. (a, b) -> a
fst [(Located (StmtLR 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 (Located (StmtLR GhcRn GhcRn (Located (body GhcRn))))]
segs <- HsStmtContext GhcRn
-> (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) =>
HsStmtContext GhcRn
-> (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 HsStmtContext GhcRn
ctxt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody [Name]
[IdP GhcRn]
bound_names [(Located (StmtLR GhcRn GhcPs (Located (body GhcPs))), FreeVars)]
[(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 (Located (StmtLR GhcRn GhcRn (Located (body GhcRn))))]
[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 =
(GenLocated SrcSpan (StmtLR GhcPs GhcPs body)
-> [GenLocated SrcSpan (FixitySig GhcPs)]
-> [GenLocated SrcSpan (FixitySig GhcPs)])
-> [GenLocated SrcSpan (FixitySig GhcPs)]
-> [GenLocated SrcSpan (StmtLR GhcPs GhcPs body)]
-> [GenLocated SrcSpan (FixitySig GhcPs)]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ GenLocated SrcSpan (StmtLR GhcPs GhcPs body)
s -> \[GenLocated SrcSpan (FixitySig GhcPs)]
acc -> case GenLocated SrcSpan (StmtLR GhcPs GhcPs body)
s of
(L SrcSpan
_ (LetStmt XLetStmt GhcPs GhcPs body
_ (L _ (HsValBinds _ (ValBinds _ _ sigs))))) ->
(GenLocated SrcSpan (Sig GhcPs)
-> [GenLocated SrcSpan (FixitySig GhcPs)]
-> [GenLocated SrcSpan (FixitySig GhcPs)])
-> [GenLocated SrcSpan (FixitySig GhcPs)]
-> [GenLocated SrcSpan (Sig GhcPs)]
-> [GenLocated SrcSpan (FixitySig GhcPs)]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ GenLocated SrcSpan (Sig GhcPs)
sig -> \ [GenLocated SrcSpan (FixitySig GhcPs)]
acc -> case GenLocated SrcSpan (Sig GhcPs)
sig of
(L SrcSpan
loc (FixSig XFixSig GhcPs
_ FixitySig GhcPs
s)) -> (SrcSpan -> FixitySig GhcPs -> GenLocated SrcSpan (FixitySig GhcPs)
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc FixitySig GhcPs
s) GenLocated SrcSpan (FixitySig GhcPs)
-> [GenLocated SrcSpan (FixitySig GhcPs)]
-> [GenLocated SrcSpan (FixitySig GhcPs)]
forall a. a -> [a] -> [a]
: [GenLocated SrcSpan (FixitySig GhcPs)]
acc
GenLocated SrcSpan (Sig GhcPs)
_ -> [GenLocated SrcSpan (FixitySig GhcPs)]
acc) [GenLocated SrcSpan (FixitySig GhcPs)]
acc [GenLocated SrcSpan (Sig GhcPs)]
[LSig GhcPs]
sigs
GenLocated SrcSpan (StmtLR GhcPs GhcPs body)
_ -> [GenLocated SrcSpan (FixitySig GhcPs)]
acc) [] [GenLocated SrcSpan (StmtLR GhcPs GhcPs body)]
[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 loc (BodyStmt _ body a b))
= [(GenLocated SrcSpan (StmtLR GhcRn GhcPs body), FreeVars)]
-> IOEnv
(Env TcGblEnv TcLclEnv)
[(GenLocated SrcSpan (StmtLR GhcRn GhcPs body), FreeVars)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(SrcSpan
-> StmtLR GhcRn GhcPs body
-> GenLocated SrcSpan (StmtLR 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 NoExtField
XBodyStmt GhcRn GhcPs body
noExtField body
body SyntaxExpr GhcPs
a SyntaxExpr GhcPs
b), FreeVars
emptyFVs)]
rn_rec_stmt_lhs MiniFixityEnv
_ (L loc (LastStmt _ body noret a))
= [(GenLocated SrcSpan (StmtLR GhcRn GhcPs body), FreeVars)]
-> IOEnv
(Env TcGblEnv TcLclEnv)
[(GenLocated SrcSpan (StmtLR GhcRn GhcPs body), FreeVars)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(SrcSpan
-> StmtLR GhcRn GhcPs body
-> GenLocated SrcSpan (StmtLR GhcRn GhcPs body)
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc (XLastStmt GhcRn GhcPs body
-> body
-> Maybe Bool
-> SyntaxExpr GhcPs
-> StmtLR GhcRn GhcPs body
forall idL idR body.
XLastStmt idL idR body
-> body -> Maybe Bool -> SyntaxExpr idR -> StmtLR idL idR body
LastStmt NoExtField
XLastStmt GhcRn GhcPs body
noExtField body
body Maybe Bool
noret SyntaxExpr GhcPs
a), FreeVars
emptyFVs)]
rn_rec_stmt_lhs MiniFixityEnv
fix_env (L loc (BindStmt _ pat body))
= 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
[(GenLocated SrcSpan (StmtLR GhcRn GhcPs body), FreeVars)]
-> IOEnv
(Env TcGblEnv TcLclEnv)
[(GenLocated SrcSpan (StmtLR GhcRn GhcPs body), FreeVars)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(SrcSpan
-> StmtLR GhcRn GhcPs body
-> GenLocated SrcSpan (StmtLR GhcRn GhcPs body)
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc (XBindStmt GhcRn GhcPs body
-> LPat GhcRn -> body -> StmtLR GhcRn GhcPs body
forall idL idR body.
XBindStmt idL idR body -> LPat idL -> body -> StmtLR idL idR body
BindStmt NoExtField
XBindStmt GhcRn GhcPs body
noExtField Located (Pat GhcRn)
LPat GhcRn
pat' body
body), FreeVars
fv_pat)]
rn_rec_stmt_lhs MiniFixityEnv
_ (L _ (LetStmt _ (L _ binds@(HsIPBinds {}))))
= MsgDoc
-> IOEnv
(Env TcGblEnv TcLclEnv)
[(GenLocated SrcSpan (StmtLR 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 loc (LetStmt _ (L l (HsValBinds x binds))))
= do ([Name]
_bound_names, HsValBindsLR GhcRn GhcPs
binds') <- MiniFixityEnv
-> HsValBinds GhcPs -> RnM ([Name], HsValBindsLR GhcRn GhcPs)
rnLocalValBindsLHS MiniFixityEnv
fix_env HsValBinds GhcPs
binds
[(GenLocated SrcSpan (StmtLR GhcRn GhcPs body), FreeVars)]
-> IOEnv
(Env TcGblEnv TcLclEnv)
[(GenLocated SrcSpan (StmtLR GhcRn GhcPs body), FreeVars)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(SrcSpan
-> StmtLR GhcRn GhcPs body
-> GenLocated SrcSpan (StmtLR 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 NoExtField
XLetStmt GhcRn GhcPs body
noExtField (SrcSpan
-> HsLocalBindsLR GhcRn GhcPs
-> GenLocated SrcSpan (HsLocalBindsLR 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 _ (RecStmt { recS_stmts = 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 _ (ParStmt {}))
= String
-> MsgDoc
-> IOEnv
(Env TcGblEnv TcLclEnv)
[(GenLocated SrcSpan (StmtLR GhcRn GhcPs body), FreeVars)]
forall a. HasCallStack => String -> MsgDoc -> a
pprPanic String
"rn_rec_stmt" (Located (StmtLR GhcPs GhcPs body) -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Located (StmtLR GhcPs GhcPs body)
LStmt GhcPs body
stmt)
rn_rec_stmt_lhs MiniFixityEnv
_ stmt :: LStmt GhcPs body
stmt@(L _ (TransStmt {}))
= String
-> MsgDoc
-> IOEnv
(Env TcGblEnv TcLclEnv)
[(GenLocated SrcSpan (StmtLR GhcRn GhcPs body), FreeVars)]
forall a. HasCallStack => String -> MsgDoc -> a
pprPanic String
"rn_rec_stmt" (Located (StmtLR GhcPs GhcPs body) -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Located (StmtLR GhcPs GhcPs body)
LStmt GhcPs body
stmt)
rn_rec_stmt_lhs MiniFixityEnv
_ stmt :: LStmt GhcPs body
stmt@(L _ (ApplicativeStmt {}))
= String
-> MsgDoc
-> IOEnv
(Env TcGblEnv TcLclEnv)
[(GenLocated SrcSpan (StmtLR GhcRn GhcPs body), FreeVars)]
forall a. HasCallStack => String -> MsgDoc -> a
pprPanic String
"rn_rec_stmt" (Located (StmtLR GhcPs GhcPs body) -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Located (StmtLR GhcPs GhcPs body)
LStmt GhcPs body
stmt)
rn_rec_stmt_lhs MiniFixityEnv
_ (L _ (LetStmt _ (L _ (EmptyLocalBinds _))))
= String
-> IOEnv
(Env TcGblEnv TcLclEnv)
[(GenLocated SrcSpan (StmtLR GhcRn GhcPs body), FreeVars)]
forall a. String -> a
panic String
"rn_rec_stmt LetStmt EmptyLocalBinds"
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 { [(Located (StmtLR GhcRn GhcPs body), FreeVars)]
ls <- (Located (StmtLR GhcPs GhcPs body)
-> IOEnv
(Env TcGblEnv TcLclEnv)
[(Located (StmtLR GhcRn GhcPs body), FreeVars)])
-> [Located (StmtLR GhcPs GhcPs body)]
-> IOEnv
(Env TcGblEnv TcLclEnv)
[(Located (StmtLR 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) [Located (StmtLR GhcPs GhcPs body)]
[LStmt GhcPs body]
stmts
; let boundNames :: [IdP GhcRn]
boundNames = [LStmtLR GhcRn GhcPs body] -> [IdP GhcRn]
forall (idL :: Pass) (idR :: Pass) body.
CollectPass (GhcPass idL) =>
[LStmtLR (GhcPass idL) (GhcPass idR) body] -> [IdP (GhcPass idL)]
collectLStmtsBinders (((Located (StmtLR GhcRn GhcPs body), FreeVars)
-> Located (StmtLR GhcRn GhcPs body))
-> [(Located (StmtLR GhcRn GhcPs body), FreeVars)]
-> [Located (StmtLR GhcRn GhcPs body)]
forall a b. (a -> b) -> [a] -> [b]
map (Located (StmtLR GhcRn GhcPs body), FreeVars)
-> Located (StmtLR GhcRn GhcPs body)
forall a b. (a, b) -> a
fst [(Located (StmtLR GhcRn GhcPs body), FreeVars)]
ls)
; [Name] -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkDupNames [Name]
[IdP GhcRn]
boundNames
; [(Located (StmtLR GhcRn GhcPs body), FreeVars)]
-> IOEnv
(Env TcGblEnv TcLclEnv)
[(Located (StmtLR GhcRn GhcPs body), FreeVars)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Located (StmtLR GhcRn GhcPs body), FreeVars)]
ls }
rn_rec_stmt :: (Outputable (body GhcPs)) =>
HsStmtContext GhcRn
-> (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 :: HsStmtContext GhcRn
-> (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 HsStmtContext GhcRn
ctxt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody [Name]
_ (L loc (LastStmt _ body noret _), FreeVars
_)
= do { (Located (body GhcRn)
body', FreeVars
fv_expr) <- Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody Located (body GhcPs)
body
; (SyntaxExprRn
ret_op, FreeVars
fvs1) <- HsStmtContext GhcRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
forall p.
HsStmtContext p -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupQualifiedDo HsStmtContext GhcRn
ctxt Name
returnMName
; [(FreeVars, FreeVars, FreeVars,
GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))))]
-> IOEnv
(Env TcGblEnv TcLclEnv)
[(FreeVars, FreeVars, FreeVars,
GenLocated SrcSpan (StmtLR GhcRn 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))
-> GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn)))
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc (XLastStmt GhcRn GhcRn (Located (body GhcRn))
-> Located (body GhcRn)
-> Maybe Bool
-> SyntaxExpr GhcRn
-> StmtLR GhcRn GhcRn (Located (body GhcRn))
forall idL idR body.
XLastStmt idL idR body
-> body -> Maybe Bool -> SyntaxExpr idR -> StmtLR idL idR body
LastStmt NoExtField
XLastStmt GhcRn GhcRn (Located (body GhcRn))
noExtField Located (body GhcRn)
body' Maybe Bool
noret SyntaxExprRn
SyntaxExpr GhcRn
ret_op))] }
rn_rec_stmt HsStmtContext GhcRn
ctxt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody [Name]
_ (L loc (BodyStmt _ body _ _), FreeVars
_)
= do { (Located (body GhcRn)
body', FreeVars
fvs) <- Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody Located (body GhcPs)
body
; (SyntaxExprRn
then_op, FreeVars
fvs1) <- HsStmtContext GhcRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
forall p.
HsStmtContext p -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupQualifiedDo HsStmtContext GhcRn
ctxt Name
thenMName
; [(FreeVars, FreeVars, FreeVars,
GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))))]
-> IOEnv
(Env TcGblEnv TcLclEnv)
[(FreeVars, FreeVars, FreeVars,
GenLocated SrcSpan (StmtLR GhcRn 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))
-> GenLocated SrcSpan (StmtLR GhcRn 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 NoExtField
XBodyStmt GhcRn GhcRn (Located (body GhcRn))
noExtField Located (body GhcRn)
body' SyntaxExprRn
SyntaxExpr GhcRn
then_op SyntaxExpr GhcRn
forall (p :: Pass). IsPass p => SyntaxExpr (GhcPass p)
noSyntaxExpr))] }
rn_rec_stmt HsStmtContext GhcRn
ctxt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody [Name]
_ (L loc (BindStmt _ pat' body), FreeVars
fv_pat)
= do { (Located (body GhcRn)
body', FreeVars
fv_expr) <- Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody Located (body GhcPs)
body
; (SyntaxExprRn
bind_op, FreeVars
fvs1) <- HsStmtContext GhcRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
forall p.
HsStmtContext p -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupQualifiedDo HsStmtContext GhcRn
ctxt Name
bindMName
; (Maybe SyntaxExprRn
fail_op, FreeVars
fvs2) <- HsStmtContext GhcRn -> RnM (Maybe (SyntaxExpr GhcRn), FreeVars)
forall p.
HsStmtContext p -> RnM (Maybe (SyntaxExpr GhcRn), FreeVars)
getMonadFailOp HsStmtContext GhcRn
ctxt
; let bndrs :: FreeVars
bndrs = [Name] -> FreeVars
mkNameSet (LPat GhcRn -> [IdP GhcRn]
forall p. CollectPass p => LPat p -> [IdP 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
; let xbsrn :: XBindStmtRn
xbsrn = XBindStmtRn :: SyntaxExpr GhcRn -> Maybe (SyntaxExpr GhcRn) -> XBindStmtRn
XBindStmtRn { xbsrn_bindOp :: SyntaxExpr GhcRn
xbsrn_bindOp = SyntaxExprRn
SyntaxExpr GhcRn
bind_op, xbsrn_failOp :: Maybe (SyntaxExpr GhcRn)
xbsrn_failOp = Maybe SyntaxExprRn
Maybe (SyntaxExpr GhcRn)
fail_op }
; [(FreeVars, FreeVars, FreeVars,
GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))))]
-> IOEnv
(Env TcGblEnv TcLclEnv)
[(FreeVars, FreeVars, FreeVars,
GenLocated SrcSpan (StmtLR GhcRn 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))
-> GenLocated SrcSpan (StmtLR GhcRn 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)
-> StmtLR GhcRn GhcRn (Located (body GhcRn))
forall idL idR body.
XBindStmt idL idR body -> LPat idL -> body -> StmtLR idL idR body
BindStmt XBindStmtRn
XBindStmt GhcRn GhcRn (Located (body GhcRn))
xbsrn LPat GhcRn
pat' Located (body GhcRn)
body'))] }
rn_rec_stmt HsStmtContext GhcRn
_ Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
_ [Name]
_ (L _ (LetStmt _ (L _ binds@(HsIPBinds {}))), FreeVars
_)
= MsgDoc
-> IOEnv
(Env TcGblEnv TcLclEnv)
[(FreeVars, FreeVars, FreeVars,
GenLocated SrcSpan (StmtLR GhcRn 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 HsStmtContext GhcRn
_ Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
_ [Name]
all_bndrs (L loc (LetStmt _ (L l (HsValBinds x 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
; [(FreeVars, FreeVars, FreeVars,
GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))))]
-> IOEnv
(Env TcGblEnv TcLclEnv)
[(FreeVars, FreeVars, FreeVars,
GenLocated SrcSpan (StmtLR GhcRn 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))
-> GenLocated SrcSpan (StmtLR GhcRn 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 NoExtField
XLetStmt GhcRn GhcRn (Located (body GhcRn))
noExtField (SrcSpan
-> HsLocalBinds GhcRn -> GenLocated SrcSpan (HsLocalBinds 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 HsStmtContext GhcRn
_ Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
_ [Name]
_ stmt :: (LStmtLR GhcRn GhcPs (Located (body GhcPs)), FreeVars)
stmt@(L _ (RecStmt {}), FreeVars
_)
= String
-> MsgDoc
-> IOEnv
(Env TcGblEnv TcLclEnv)
[(FreeVars, FreeVars, FreeVars,
GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))))]
forall a. HasCallStack => String -> MsgDoc -> a
pprPanic String
"rn_rec_stmt: RecStmt" ((Located (StmtLR GhcRn GhcPs (Located (body GhcPs))), FreeVars)
-> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (Located (StmtLR GhcRn GhcPs (Located (body GhcPs))), FreeVars)
(LStmtLR GhcRn GhcPs (Located (body GhcPs)), FreeVars)
stmt)
rn_rec_stmt HsStmtContext GhcRn
_ Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
_ [Name]
_ stmt :: (LStmtLR GhcRn GhcPs (Located (body GhcPs)), FreeVars)
stmt@(L _ (ParStmt {}), FreeVars
_)
= String
-> MsgDoc
-> IOEnv
(Env TcGblEnv TcLclEnv)
[(FreeVars, FreeVars, FreeVars,
GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))))]
forall a. HasCallStack => String -> MsgDoc -> a
pprPanic String
"rn_rec_stmt: ParStmt" ((Located (StmtLR GhcRn GhcPs (Located (body GhcPs))), FreeVars)
-> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (Located (StmtLR GhcRn GhcPs (Located (body GhcPs))), FreeVars)
(LStmtLR GhcRn GhcPs (Located (body GhcPs)), FreeVars)
stmt)
rn_rec_stmt HsStmtContext GhcRn
_ Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
_ [Name]
_ stmt :: (LStmtLR GhcRn GhcPs (Located (body GhcPs)), FreeVars)
stmt@(L _ (TransStmt {}), FreeVars
_)
= String
-> MsgDoc
-> IOEnv
(Env TcGblEnv TcLclEnv)
[(FreeVars, FreeVars, FreeVars,
GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))))]
forall a. HasCallStack => String -> MsgDoc -> a
pprPanic String
"rn_rec_stmt: TransStmt" ((Located (StmtLR GhcRn GhcPs (Located (body GhcPs))), FreeVars)
-> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (Located (StmtLR GhcRn GhcPs (Located (body GhcPs))), FreeVars)
(LStmtLR GhcRn GhcPs (Located (body GhcPs)), FreeVars)
stmt)
rn_rec_stmt HsStmtContext GhcRn
_ Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
_ [Name]
_ (L _ (LetStmt _ (L _ (EmptyLocalBinds _))), FreeVars
_)
= String
-> IOEnv
(Env TcGblEnv TcLclEnv)
[(FreeVars, FreeVars, FreeVars,
GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))))]
forall a. String -> a
panic String
"rn_rec_stmt: LetStmt EmptyLocalBinds"
rn_rec_stmt HsStmtContext GhcRn
_ Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
_ [Name]
_ stmt :: (LStmtLR GhcRn GhcPs (Located (body GhcPs)), FreeVars)
stmt@(L _ (ApplicativeStmt {}), FreeVars
_)
= String
-> MsgDoc
-> IOEnv
(Env TcGblEnv TcLclEnv)
[(FreeVars, FreeVars, FreeVars,
GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))))]
forall a. HasCallStack => String -> MsgDoc -> a
pprPanic String
"rn_rec_stmt: ApplicativeStmt" ((Located (StmtLR GhcRn GhcPs (Located (body GhcPs))), FreeVars)
-> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr (Located (StmtLR GhcRn GhcPs (Located (body GhcPs))), FreeVars)
(LStmtLR GhcRn GhcPs (Located (body GhcPs)), FreeVars)
stmt)
rn_rec_stmts :: Outputable (body GhcPs) =>
HsStmtContext GhcRn
-> (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 :: HsStmtContext GhcRn
-> (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 HsStmtContext GhcRn
ctxt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody [Name]
bndrs [(LStmtLR GhcRn GhcPs (Located (body GhcPs)), FreeVars)]
stmts
= do { [[Segment (Located (StmtLR GhcRn GhcRn (Located (body GhcRn))))]]
segs_s <- ((Located (StmtLR GhcRn GhcPs (Located (body GhcPs))), FreeVars)
-> IOEnv
(Env TcGblEnv TcLclEnv)
[Segment (Located (StmtLR GhcRn GhcRn (Located (body GhcRn))))])
-> [(Located (StmtLR GhcRn GhcPs (Located (body GhcPs))),
FreeVars)]
-> IOEnv
(Env TcGblEnv TcLclEnv)
[[Segment (Located (StmtLR GhcRn GhcRn (Located (body GhcRn))))]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (HsStmtContext GhcRn
-> (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) =>
HsStmtContext GhcRn
-> (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 HsStmtContext GhcRn
ctxt Located (body GhcPs) -> RnM (Located (body GhcRn), FreeVars)
rnBody [Name]
bndrs) [(Located (StmtLR GhcRn GhcPs (Located (body GhcPs))), FreeVars)]
[(LStmtLR GhcRn GhcPs (Located (body GhcPs)), FreeVars)]
stmts
; [Segment (Located (StmtLR GhcRn GhcRn (Located (body GhcRn))))]
-> IOEnv
(Env TcGblEnv TcLclEnv)
[Segment (Located (StmtLR GhcRn GhcRn (Located (body GhcRn))))]
forall (m :: * -> *) a. Monad m => a -> m a
return ([[Segment (Located (StmtLR GhcRn GhcRn (Located (body GhcRn))))]]
-> [Segment (Located (StmtLR GhcRn GhcRn (Located (body GhcRn))))]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Segment (Located (StmtLR GhcRn GhcRn (Located (body GhcRn))))]]
segs_s) }
segmentRecStmts :: SrcSpan -> HsStmtContext GhcRn
-> Stmt GhcRn body
-> [Segment (LStmt GhcRn body)] -> FreeVars
-> ([LStmt GhcRn body], FreeVars)
segmentRecStmts :: SrcSpan
-> HsStmtContext GhcRn
-> Stmt GhcRn body
-> [Segment (LStmt GhcRn body)]
-> FreeVars
-> ([LStmt GhcRn body], FreeVars)
segmentRecStmts SrcSpan
loc HsStmtContext GhcRn
ctxt Stmt GhcRn body
empty_rec_stmt [Segment (LStmt GhcRn body)]
segs FreeVars
fvs_later
| [Segment (Located (Stmt GhcRn body))] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Segment (Located (Stmt GhcRn body))]
[Segment (LStmt GhcRn body)]
segs
= ([], FreeVars
fvs_later)
| MDoExpr Maybe ModuleName
_ <- HsStmtContext GhcRn
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 -> Located (Stmt GhcRn body)
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc (Stmt GhcRn body -> Located (Stmt GhcRn body))
-> Stmt GhcRn body -> Located (Stmt GhcRn body)
forall a b. (a -> b) -> a -> b
$
Stmt GhcRn body
empty_rec_stmt { recS_stmts :: [LStmt GhcRn body]
recS_stmts = [Located (Stmt GhcRn body)]
[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]
_, [Located (Stmt GhcRn body)]
ss) = [Segment (Located (Stmt GhcRn body))]
-> ([FreeVars], [FreeVars], [FreeVars],
[Located (Stmt GhcRn body)])
forall a b c d. [(a, b, c, d)] -> ([a], [b], [c], [d])
unzip4 [Segment (Located (Stmt GhcRn body))]
[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 (Located (Stmt GhcRn body))]
segs_w_fwd_refs = [Segment (Located (Stmt GhcRn body))]
-> [Segment (Located (Stmt GhcRn body))]
forall a. [Segment a] -> [Segment a]
addFwdRefs [Segment (Located (Stmt GhcRn body))]
[Segment (LStmt GhcRn body)]
segs
grouped_segs :: [Segment [LStmt GhcRn body]]
grouped_segs = HsStmtContext GhcRn
-> [Segment (LStmt GhcRn body)] -> [Segment [LStmt GhcRn body]]
forall body.
HsStmtContext GhcRn
-> [Segment (LStmt GhcRn body)] -> [Segment [LStmt GhcRn body]]
glomSegments HsStmtContext GhcRn
ctxt [Segment (Located (Stmt GhcRn body))]
[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 GhcRn
-> [Segment (LStmt GhcRn body)]
-> [Segment [LStmt GhcRn body]]
glomSegments :: HsStmtContext GhcRn
-> [Segment (LStmt GhcRn body)] -> [Segment [LStmt GhcRn body]]
glomSegments HsStmtContext GhcRn
_ [] = []
glomSegments HsStmtContext GhcRn
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, [Located (StmtLR GhcRn GhcRn body)]
seg_stmts) (FreeVars, FreeVars, FreeVars, [Located (StmtLR GhcRn GhcRn body)])
-> [(FreeVars, FreeVars, FreeVars,
[Located (StmtLR GhcRn GhcRn body)])]
-> [(FreeVars, FreeVars, FreeVars,
[Located (StmtLR GhcRn GhcRn body)])]
forall a. a -> [a] -> [a]
: [(FreeVars, FreeVars, FreeVars,
[Located (StmtLR GhcRn GhcRn body)])]
others
where
segs' :: [Segment [LStmt GhcRn body]]
segs' = HsStmtContext GhcRn
-> [Segment (LStmt GhcRn body)] -> [Segment [LStmt GhcRn body]]
forall body.
HsStmtContext GhcRn
-> [Segment (LStmt GhcRn body)] -> [Segment [LStmt GhcRn body]]
glomSegments HsStmtContext GhcRn
ctxt [Segment (LStmt GhcRn body)]
segs
([(FreeVars, FreeVars, FreeVars,
[Located (StmtLR GhcRn GhcRn body)])]
extras, [(FreeVars, FreeVars, FreeVars,
[Located (StmtLR GhcRn GhcRn body)])]
others) = FreeVars
-> [(FreeVars, FreeVars, FreeVars,
[Located (StmtLR GhcRn GhcRn body)])]
-> ([(FreeVars, FreeVars, FreeVars,
[Located (StmtLR GhcRn GhcRn body)])],
[(FreeVars, FreeVars, FreeVars,
[Located (StmtLR GhcRn GhcRn body)])])
forall a. FreeVars -> [Segment a] -> ([Segment a], [Segment a])
grab FreeVars
uses [(FreeVars, FreeVars, FreeVars,
[Located (StmtLR GhcRn GhcRn body)])]
[Segment [LStmt GhcRn body]]
segs'
([FreeVars]
ds, [FreeVars]
us, [FreeVars]
fs, [[Located (StmtLR GhcRn GhcRn body)]]
ss) = [(FreeVars, FreeVars, FreeVars,
[Located (StmtLR GhcRn GhcRn body)])]
-> ([FreeVars], [FreeVars], [FreeVars],
[[Located (StmtLR GhcRn GhcRn body)]])
forall a b c d. [(a, b, c, d)] -> ([a], [b], [c], [d])
unzip4 [(FreeVars, FreeVars, FreeVars,
[Located (StmtLR GhcRn 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 :: [Located (StmtLR GhcRn GhcRn body)]
seg_stmts = Located (StmtLR GhcRn GhcRn body)
LStmt GhcRn body
stmt Located (StmtLR GhcRn GhcRn body)
-> [Located (StmtLR GhcRn GhcRn body)]
-> [Located (StmtLR GhcRn GhcRn body)]
forall a. a -> [a] -> [a]
: [[Located (StmtLR GhcRn GhcRn body)]]
-> [Located (StmtLR GhcRn GhcRn body)]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Located (StmtLR GhcRn 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
_) = FreeVars -> FreeVars -> Bool
disjointNameSet 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) )
(Located (Stmt GhcRn body)
new_stmt Located (Stmt GhcRn body)
-> [Located (Stmt GhcRn body)] -> [Located (Stmt GhcRn body)]
forall a. a -> [a] -> [a]
: [Located (Stmt GhcRn body)]
later_stmts, FreeVars
later_uses FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
uses)
where
([Located (Stmt 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 :: Located (Stmt GhcRn body)
new_stmt | Bool
non_rec = [Located (Stmt GhcRn body)] -> Located (Stmt GhcRn body)
forall a. [a] -> a
head [Located (Stmt GhcRn body)]
[LStmt GhcRn body]
ss
| Bool
otherwise = SrcSpan -> Stmt GhcRn body -> Located (Stmt GhcRn body)
forall l e. l -> e -> GenLocated l e
L (Located (Stmt GhcRn body) -> SrcSpan
forall l e. GenLocated l e -> l
getLoc ([Located (Stmt GhcRn body)] -> Located (Stmt GhcRn body)
forall a. [a] -> a
head [Located (Stmt GhcRn body)]
[LStmt GhcRn body]
ss)) 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 = [Located (Stmt GhcRn body)] -> Bool
forall a. [a] -> Bool
isSingleton [Located (Stmt GhcRn body)]
[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 GhcRn
-> [(ExprLStmt GhcRn, FreeVars)]
-> RnM ([ExprLStmt GhcRn], FreeVars)
rearrangeForApplicativeDo :: HsStmtContext GhcRn
-> [(ExprLStmt GhcRn, FreeVars)]
-> RnM ([ExprLStmt GhcRn], FreeVars)
rearrangeForApplicativeDo HsStmtContext GhcRn
_ [] = ([Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))], FreeVars)
-> IOEnv
(Env TcGblEnv TcLclEnv)
([Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))], FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return ([], FreeVars
emptyNameSet)
rearrangeForApplicativeDo HsStmtContext GhcRn
_ [(ExprLStmt GhcRn
one,FreeVars
_)] = ([Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))], FreeVars)
-> IOEnv
(Env TcGblEnv TcLclEnv)
([Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))], FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))
ExprLStmt GhcRn
one], FreeVars
emptyNameSet)
rearrangeForApplicativeDo HsStmtContext GhcRn
ctxt [(ExprLStmt 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 :: StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
stmt_tree | Bool
optimal_ado = [(ExprLStmt GhcRn, FreeVars)] -> ExprStmtTree
mkStmtTreeOptimal [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
[(ExprLStmt GhcRn, FreeVars)]
stmts
| Bool
otherwise = [(ExprLStmt GhcRn, FreeVars)] -> ExprStmtTree
mkStmtTreeHeuristic [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
[(ExprLStmt GhcRn, FreeVars)]
stmts
String -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
traceRn String
"rearrangeForADo" (StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
-> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
stmt_tree)
(Name
return_name, FreeVars
_) <- HsStmtContext GhcRn
-> Name -> IOEnv (Env TcGblEnv TcLclEnv) (Name, FreeVars)
forall p.
HsStmtContext p
-> Name -> IOEnv (Env TcGblEnv TcLclEnv) (Name, FreeVars)
lookupQualifiedDoName HsStmtContext GhcRn
ctxt Name
returnMName
(Name
pure_name, FreeVars
_) <- HsStmtContext GhcRn
-> Name -> IOEnv (Env TcGblEnv TcLclEnv) (Name, FreeVars)
forall p.
HsStmtContext p
-> Name -> IOEnv (Env TcGblEnv TcLclEnv) (Name, FreeVars)
lookupQualifiedDoName HsStmtContext GhcRn
ctxt 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 GhcRn
-> ExprStmtTree
-> [ExprLStmt GhcRn]
-> FreeVars
-> RnM ([ExprLStmt GhcRn], FreeVars)
stmtTreeToStmts MonadNames
monad_names HsStmtContext GhcRn
ctxt StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
ExprStmtTree
stmt_tree [Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))
ExprLStmt GhcRn
last] FreeVars
last_fvs
where
([(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
stmts,(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))
last,FreeVars
last_fvs)) = [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
-> ([(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)],
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars))
forall a. [a] -> ([a], a)
findLast [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
[(ExprLStmt 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 :: [(ExprLStmt GhcRn, FreeVars)] -> ExprStmtTree
mkStmtTreeHeuristic [(ExprLStmt GhcRn, FreeVars)
one] = (Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
-> StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
forall a. a -> StmtTree a
StmtTreeOne (Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
(ExprLStmt GhcRn, FreeVars)
one
mkStmtTreeHeuristic [(ExprLStmt GhcRn, FreeVars)]
stmts =
case [(ExprLStmt GhcRn, FreeVars)] -> [[(ExprLStmt GhcRn, FreeVars)]]
segments [(ExprLStmt GhcRn, FreeVars)]
stmts of
[[(ExprLStmt GhcRn, FreeVars)]
one] -> [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
-> StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
split [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
[(ExprLStmt GhcRn, FreeVars)]
one
[[(ExprLStmt GhcRn, FreeVars)]]
segs -> [StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
-> StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
forall a. [StmtTree a] -> StmtTree a
StmtTreeApplicative (([(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)]
-> StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars))
-> [[(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)]]
-> [StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
forall a b. (a -> b) -> [a] -> [b]
map [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
-> StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
split [[(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)]]
[[(ExprLStmt GhcRn, FreeVars)]]
segs)
where
split :: [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
-> StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
split [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
one] = (Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
-> StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
forall a. a -> StmtTree a
StmtTreeOne (Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
one
split [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
stmts =
StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
-> StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
-> StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
forall a. StmtTree a -> StmtTree a -> StmtTree a
StmtTreeBind ([(ExprLStmt GhcRn, FreeVars)] -> ExprStmtTree
mkStmtTreeHeuristic [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
[(ExprLStmt GhcRn, FreeVars)]
before) ([(ExprLStmt GhcRn, FreeVars)] -> ExprStmtTree
mkStmtTreeHeuristic [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
[(ExprLStmt GhcRn, FreeVars)]
after)
where ([(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
before, [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
after) = [(ExprLStmt GhcRn, FreeVars)]
-> ([(ExprLStmt GhcRn, FreeVars)], [(ExprLStmt GhcRn, FreeVars)])
splitSegment [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
[(ExprLStmt GhcRn, FreeVars)]
stmts
mkStmtTreeOptimal :: [(ExprLStmt GhcRn, FreeVars)] -> ExprStmtTree
mkStmtTreeOptimal :: [(ExprLStmt GhcRn, FreeVars)] -> ExprStmtTree
mkStmtTreeOptimal [(ExprLStmt GhcRn, FreeVars)]
stmts =
ASSERT(not (null stmts))
(StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars),
Int)
-> StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
forall a b. (a, b) -> a
fst (Array
(Int, Int)
(StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars),
Int)
Array (Int, Int) (ExprStmtTree, Int)
arr Array
(Int, Int)
(StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars),
Int)
-> (Int, Int)
-> (StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars),
Int)
forall i e. Ix i => Array i e -> i -> e
! (Int
0,Int
n))
where
n :: Int
n = [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
-> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
[(ExprLStmt GhcRn, FreeVars)]
stmts Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
stmt_arr :: Array
Int
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
stmt_arr = (Int, Int)
-> [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)]
-> Array
Int
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Int
0,Int
n) [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
[(ExprLStmt GhcRn, FreeVars)]
stmts
arr :: Array (Int,Int) (ExprStmtTree, Cost)
arr :: Array (Int, Int) (ExprStmtTree, Int)
arr = ((Int, Int), (Int, Int))
-> [((Int, Int),
(StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars),
Int))]
-> Array
(Int, Int)
(StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars),
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
-> (StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars),
Int)
tree Int
lo Int
hi)
| Int
lo <- [Int
0..Int
n]
, Int
hi <- [Int
lo..Int
n] ]
tree :: Int
-> Int
-> (StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars),
Int)
tree Int
lo Int
hi
| Int
hi Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lo = ((Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
-> StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
forall a. a -> StmtTree a
StmtTreeOne (Array
Int
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
stmt_arr Array
Int
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
-> Int
-> (Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)
forall i e. Ix i => Array i e -> i -> e
! Int
lo), Int
1)
| Bool
otherwise =
case [(ExprLStmt GhcRn, FreeVars)] -> [[(ExprLStmt GhcRn, FreeVars)]]
segments [ Array
Int
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
stmt_arr Array
Int
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
-> Int
-> (Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)
forall i e. Ix i => Array i e -> i -> e
! Int
i | Int
i <- [Int
lo..Int
hi] ] of
[] -> String
-> (StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars),
Int)
forall a. String -> a
panic String
"mkStmtTree"
[[(ExprLStmt GhcRn, FreeVars)]
_one] -> Int -> Int -> (ExprStmtTree, Int)
split Int
lo Int
hi
[[(ExprLStmt GhcRn, FreeVars)]]
segs -> ([StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
-> StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
forall a. [StmtTree a] -> StmtTree a
StmtTreeApplicative [StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
trees, [Int] -> Int
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Int]
costs)
where
bounds :: [(Int, Int)]
bounds = ((Int, Int)
-> [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)]
-> (Int, Int))
-> (Int, Int)
-> [[(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)]]
-> [(Int, Int)]
forall b a. (b -> a -> b) -> b -> [a] -> [b]
scanl (\(Int
_,Int
hi) [(Located (StmtLR GhcRn GhcRn (Located (HsExpr 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
+ [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
-> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
a)) (Int
0,Int
loInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1) [[(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)]]
[[(ExprLStmt GhcRn, FreeVars)]]
segs
([StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
trees,[Int]
costs) = [(StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars),
Int)]
-> ([StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)],
[Int])
forall a b. [(a, b)] -> ([a], [b])
unzip (((Int, Int)
-> (StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars),
Int))
-> [(Int, Int)]
-> [(StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars),
Int)]
forall a b. (a -> b) -> [a] -> [b]
map ((Int
-> Int
-> (StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars),
Int))
-> (Int, Int)
-> (StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars),
Int)
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Int
-> Int
-> (StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars),
Int)
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 = ((Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
-> StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
forall a. a -> StmtTree a
StmtTreeOne (Array
Int
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
stmt_arr Array
Int
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
-> Int
-> (Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)
forall i e. Ix i => Array i e -> i -> e
! Int
lo), Int
1)
| Bool
otherwise = (StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
-> StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
-> StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
forall a. StmtTree a -> StmtTree a -> StmtTree a
StmtTreeBind StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
before StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
after, Int
c1Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
c2)
where
((StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
before,Int
c1),(StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
after,Int
c2))
| Int
hi Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
lo Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1
= (((Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
-> StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
forall a. a -> StmtTree a
StmtTreeOne (Array
Int
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
stmt_arr Array
Int
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
-> Int
-> (Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)
forall i e. Ix i => Array i e -> i -> e
! Int
lo), Int
1),
((Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
-> StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
forall a. a -> StmtTree a
StmtTreeOne (Array
Int
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
stmt_arr Array
Int
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
-> Int
-> (Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)
forall i e. Ix i => Array i e -> i -> e
! Int
hi), Int
1))
| Int
left_cost Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
right_cost
= ((StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
left,Int
left_cost), ((Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
-> StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
forall a. a -> StmtTree a
StmtTreeOne (Array
Int
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
stmt_arr Array
Int
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
-> Int
-> (Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)
forall i e. Ix i => Array i e -> i -> e
! Int
hi), Int
1))
| Int
left_cost Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
right_cost
= (((Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
-> StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
forall a. a -> StmtTree a
StmtTreeOne (Array
Int
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
stmt_arr Array
Int
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
-> Int
-> (Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)
forall i e. Ix i => Array i e -> i -> e
! Int
lo), Int
1), (StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
right,Int
right_cost))
| Bool
otherwise = (((StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars),
Int),
(StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars),
Int))
-> ((StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars),
Int),
(StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars),
Int))
-> Ordering)
-> [((StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars),
Int),
(StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars),
Int))]
-> ((StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars),
Int),
(StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars),
Int))
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy ((((StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars),
Int),
(StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars),
Int))
-> Int)
-> ((StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars),
Int),
(StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars),
Int))
-> ((StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars),
Int),
(StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars),
Int))
-> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing ((StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars),
Int),
(StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars),
Int))
-> Int
forall a a a. Num a => ((a, a), (a, a)) -> a
cost) [((StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars),
Int),
(StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars),
Int))]
alternatives
where
(StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
left, Int
left_cost) = Array
(Int, Int)
(StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars),
Int)
Array (Int, Int) (ExprStmtTree, Int)
arr Array
(Int, Int)
(StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars),
Int)
-> (Int, Int)
-> (StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars),
Int)
forall i e. Ix i => Array i e -> i -> e
! (Int
lo,Int
hiInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1)
(StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
right, Int
right_cost) = Array
(Int, Int)
(StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars),
Int)
Array (Int, Int) (ExprStmtTree, Int)
arr Array
(Int, Int)
(StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars),
Int)
-> (Int, Int)
-> (StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars),
Int)
forall i e. Ix i => Array i e -> i -> e
! (Int
loInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1,Int
hi)
cost :: ((a, a), (a, a)) -> a
cost ((a
_,a
c1),(a
_,a
c2)) = a
c1 a -> a -> a
forall a. Num a => a -> a -> a
+ a
c2
alternatives :: [((StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars),
Int),
(StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars),
Int))]
alternatives = [ (Array
(Int, Int)
(StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars),
Int)
Array (Int, Int) (ExprStmtTree, Int)
arr Array
(Int, Int)
(StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars),
Int)
-> (Int, Int)
-> (StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars),
Int)
forall i e. Ix i => Array i e -> i -> e
! (Int
lo,Int
k), Array
(Int, Int)
(StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars),
Int)
Array (Int, Int) (ExprStmtTree, Int)
arr Array
(Int, Int)
(StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars),
Int)
-> (Int, Int)
-> (StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars),
Int)
forall i e. Ix i => Array i e -> i -> e
! (Int
kInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1,Int
hi))
| Int
k <- [Int
lo .. Int
hiInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1] ]
stmtTreeToStmts
:: MonadNames
-> HsStmtContext GhcRn
-> ExprStmtTree
-> [ExprLStmt GhcRn]
-> FreeVars
-> RnM ( [ExprLStmt GhcRn]
, FreeVars )
stmtTreeToStmts :: MonadNames
-> HsStmtContext GhcRn
-> ExprStmtTree
-> [ExprLStmt GhcRn]
-> FreeVars
-> RnM ([ExprLStmt GhcRn], FreeVars)
stmtTreeToStmts MonadNames
monad_names HsStmtContext GhcRn
ctxt (StmtTreeOne (L _ (BindStmt xbs pat rhs), FreeVars
_))
[ExprLStmt GhcRn]
tail FreeVars
_tail_fvs
| Bool -> Bool
not (LPat GhcRn -> Bool
forall (p :: Pass). LPat (GhcPass p) -> Bool
isStrictPattern LPat GhcRn
pat), (Bool
False,[ExprLStmt GhcRn]
tail') <- MonadNames -> [ExprLStmt GhcRn] -> (Bool, [ExprLStmt GhcRn])
needJoin MonadNames
monad_names [ExprLStmt GhcRn]
tail
= HsStmtContext GhcRn
-> [ApplicativeArg GhcRn]
-> Bool
-> [ExprLStmt GhcRn]
-> RnM ([ExprLStmt GhcRn], FreeVars)
mkApplicativeStmt HsStmtContext GhcRn
ctxt [ApplicativeArgOne :: forall idL.
XApplicativeArgOne idL
-> LPat idL -> LHsExpr idL -> Bool -> ApplicativeArg idL
ApplicativeArgOne
{ xarg_app_arg_one :: XApplicativeArgOne GhcRn
xarg_app_arg_one = XBindStmtRn -> Maybe (SyntaxExpr GhcRn)
xbsrn_failOp XBindStmtRn
XBindStmt GhcRn GhcRn (Located (HsExpr GhcRn))
xbs
, app_arg_pattern :: LPat GhcRn
app_arg_pattern = LPat GhcRn
pat
, arg_expr :: LHsExpr GhcRn
arg_expr = Located (HsExpr GhcRn)
LHsExpr GhcRn
rhs
, is_body_stmt :: Bool
is_body_stmt = Bool
False
}]
Bool
False [ExprLStmt GhcRn]
tail'
stmtTreeToStmts MonadNames
monad_names HsStmtContext GhcRn
ctxt (StmtTreeOne (L _ (BodyStmt _ rhs _ _),FreeVars
_))
[ExprLStmt GhcRn]
tail FreeVars
_tail_fvs
| (Bool
False,[ExprLStmt GhcRn]
tail') <- MonadNames -> [ExprLStmt GhcRn] -> (Bool, [ExprLStmt GhcRn])
needJoin MonadNames
monad_names [ExprLStmt GhcRn]
tail
= HsStmtContext GhcRn
-> [ApplicativeArg GhcRn]
-> Bool
-> [ExprLStmt GhcRn]
-> RnM ([ExprLStmt GhcRn], FreeVars)
mkApplicativeStmt HsStmtContext GhcRn
ctxt
[ApplicativeArgOne :: forall idL.
XApplicativeArgOne idL
-> LPat idL -> LHsExpr idL -> Bool -> ApplicativeArg idL
ApplicativeArgOne
{ xarg_app_arg_one :: XApplicativeArgOne GhcRn
xarg_app_arg_one = XApplicativeArgOne GhcRn
forall a. Maybe a
Nothing
, app_arg_pattern :: LPat GhcRn
app_arg_pattern = LPat GhcRn
nlWildPatName
, arg_expr :: LHsExpr GhcRn
arg_expr = Located (HsExpr GhcRn)
LHsExpr GhcRn
rhs
, is_body_stmt :: Bool
is_body_stmt = Bool
True
}] Bool
False [ExprLStmt GhcRn]
tail'
stmtTreeToStmts MonadNames
_monad_names HsStmtContext GhcRn
_ctxt (StmtTreeOne (ExprLStmt GhcRn
s,FreeVars
_)) [ExprLStmt GhcRn]
tail FreeVars
_tail_fvs =
([Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))], FreeVars)
-> IOEnv
(Env TcGblEnv TcLclEnv)
([Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))], FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))
ExprLStmt GhcRn
s Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))
-> [Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))]
-> [Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))]
forall a. a -> [a] -> [a]
: [Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))]
[ExprLStmt GhcRn]
tail, FreeVars
emptyNameSet)
stmtTreeToStmts MonadNames
monad_names HsStmtContext GhcRn
ctxt (StmtTreeBind ExprStmtTree
before ExprStmtTree
after) [ExprLStmt GhcRn]
tail FreeVars
tail_fvs = do
([Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))]
stmts1, FreeVars
fvs1) <- MonadNames
-> HsStmtContext GhcRn
-> ExprStmtTree
-> [ExprLStmt GhcRn]
-> FreeVars
-> RnM ([ExprLStmt GhcRn], FreeVars)
stmtTreeToStmts MonadNames
monad_names HsStmtContext GhcRn
ctxt ExprStmtTree
after [ExprLStmt GhcRn]
tail FreeVars
tail_fvs
let tail1_fvs :: FreeVars
tail1_fvs = [FreeVars] -> FreeVars
unionNameSets (FreeVars
tail_fvs FreeVars -> [FreeVars] -> [FreeVars]
forall a. a -> [a] -> [a]
: ((Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
-> FreeVars)
-> [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)]
-> [FreeVars]
forall a b. (a -> b) -> [a] -> [b]
map (Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
-> FreeVars
forall a b. (a, b) -> b
snd (StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
-> [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)]
forall a. StmtTree a -> [a]
flattenStmtTree StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
ExprStmtTree
after))
([Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))]
stmts2, FreeVars
fvs2) <- MonadNames
-> HsStmtContext GhcRn
-> ExprStmtTree
-> [ExprLStmt GhcRn]
-> FreeVars
-> RnM ([ExprLStmt GhcRn], FreeVars)
stmtTreeToStmts MonadNames
monad_names HsStmtContext GhcRn
ctxt ExprStmtTree
before [Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))]
[ExprLStmt GhcRn]
stmts1 FreeVars
tail1_fvs
([Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))], FreeVars)
-> IOEnv
(Env TcGblEnv TcLclEnv)
([Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))], FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))]
stmts2, FreeVars
fvs1 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs2)
stmtTreeToStmts MonadNames
monad_names HsStmtContext GhcRn
ctxt (StmtTreeApplicative [ExprStmtTree]
trees) [ExprLStmt GhcRn]
tail FreeVars
tail_fvs = do
[(ApplicativeArg GhcRn, FreeVars)]
pairs <- (StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
-> IOEnv (Env TcGblEnv TcLclEnv) (ApplicativeArg GhcRn, FreeVars))
-> [StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
-> IOEnv (Env TcGblEnv TcLclEnv) [(ApplicativeArg GhcRn, FreeVars)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (HsStmtContext GhcRn
-> FreeVars
-> StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
-> IOEnv (Env TcGblEnv TcLclEnv) (ApplicativeArg GhcRn, FreeVars)
stmtTreeArg HsStmtContext GhcRn
ctxt FreeVars
tail_fvs) [StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
[ExprStmtTree]
trees
let ([ApplicativeArg GhcRn]
stmts', [FreeVars]
fvss) = [(ApplicativeArg GhcRn, FreeVars)]
-> ([ApplicativeArg GhcRn], [FreeVars])
forall a b. [(a, b)] -> ([a], [b])
unzip [(ApplicativeArg GhcRn, FreeVars)]
pairs
let (Bool
need_join, [Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))]
tail') =
if (ApplicativeArg GhcRn -> Bool) -> [ApplicativeArg GhcRn] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ApplicativeArg GhcRn -> Bool
hasRefutablePattern [ApplicativeArg GhcRn]
stmts'
then (Bool
True, [Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))]
[ExprLStmt GhcRn]
tail)
else MonadNames -> [ExprLStmt GhcRn] -> (Bool, [ExprLStmt GhcRn])
needJoin MonadNames
monad_names [ExprLStmt GhcRn]
tail
([Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))]
stmts, FreeVars
fvs) <- HsStmtContext GhcRn
-> [ApplicativeArg GhcRn]
-> Bool
-> [ExprLStmt GhcRn]
-> RnM ([ExprLStmt GhcRn], FreeVars)
mkApplicativeStmt HsStmtContext GhcRn
ctxt [ApplicativeArg GhcRn]
stmts' Bool
need_join [Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))]
[ExprLStmt GhcRn]
tail'
([Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))], FreeVars)
-> IOEnv
(Env TcGblEnv TcLclEnv)
([Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))], FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return ([Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))]
stmts, [FreeVars] -> FreeVars
unionNameSets (FreeVars
fvsFreeVars -> [FreeVars] -> [FreeVars]
forall a. a -> [a] -> [a]
:[FreeVars]
fvss))
where
stmtTreeArg :: HsStmtContext GhcRn
-> FreeVars
-> StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
-> IOEnv (Env TcGblEnv TcLclEnv) (ApplicativeArg GhcRn, FreeVars)
stmtTreeArg HsStmtContext GhcRn
_ctxt FreeVars
_tail_fvs (StmtTreeOne (L SrcSpan
_ (BindStmt XBindStmt GhcRn GhcRn (Located (HsExpr GhcRn))
xbs LPat GhcRn
pat Located (HsExpr GhcRn)
exp), FreeVars
_))
= (ApplicativeArg GhcRn, FreeVars)
-> IOEnv (Env TcGblEnv TcLclEnv) (ApplicativeArg GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (ApplicativeArgOne :: forall idL.
XApplicativeArgOne idL
-> LPat idL -> LHsExpr idL -> Bool -> ApplicativeArg idL
ApplicativeArgOne
{ xarg_app_arg_one :: XApplicativeArgOne GhcRn
xarg_app_arg_one = XBindStmtRn -> Maybe (SyntaxExpr GhcRn)
xbsrn_failOp XBindStmtRn
XBindStmt GhcRn GhcRn (Located (HsExpr GhcRn))
xbs
, app_arg_pattern :: LPat GhcRn
app_arg_pattern = LPat GhcRn
pat
, arg_expr :: LHsExpr GhcRn
arg_expr = Located (HsExpr GhcRn)
LHsExpr GhcRn
exp
, is_body_stmt :: Bool
is_body_stmt = Bool
False
}, FreeVars
emptyFVs)
stmtTreeArg HsStmtContext GhcRn
_ctxt FreeVars
_tail_fvs (StmtTreeOne (L SrcSpan
_ (BodyStmt XBodyStmt GhcRn GhcRn (Located (HsExpr GhcRn))
_ Located (HsExpr GhcRn)
exp SyntaxExpr GhcRn
_ SyntaxExpr GhcRn
_), FreeVars
_)) =
(ApplicativeArg GhcRn, FreeVars)
-> IOEnv (Env TcGblEnv TcLclEnv) (ApplicativeArg GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (ApplicativeArgOne :: forall idL.
XApplicativeArgOne idL
-> LPat idL -> LHsExpr idL -> Bool -> ApplicativeArg idL
ApplicativeArgOne
{ xarg_app_arg_one :: XApplicativeArgOne GhcRn
xarg_app_arg_one = XApplicativeArgOne GhcRn
forall a. Maybe a
Nothing
, app_arg_pattern :: LPat GhcRn
app_arg_pattern = LPat GhcRn
nlWildPatName
, arg_expr :: LHsExpr GhcRn
arg_expr = Located (HsExpr GhcRn)
LHsExpr GhcRn
exp
, is_body_stmt :: Bool
is_body_stmt = Bool
True
}, FreeVars
emptyFVs)
stmtTreeArg HsStmtContext GhcRn
ctxt FreeVars
tail_fvs StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
tree = do
let stmts :: [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
stmts = StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
-> [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)]
forall a. StmtTree a -> [a]
flattenStmtTree StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
tree
pvarset :: FreeVars
pvarset = [Name] -> FreeVars
mkNameSet (((Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
-> [Name])
-> [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)]
-> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)) -> [Name]
forall (idL :: Pass) (idR :: Pass) body.
CollectPass (GhcPass idL) =>
StmtLR (GhcPass idL) (GhcPass idR) body -> [IdP (GhcPass idL)]
collectStmtBinders(StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)) -> [Name])
-> ((Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)
-> StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))
-> (Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)
-> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))
-> StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))
forall l e. GenLocated l e -> e
unLoc(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))
-> StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))
-> ((Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)
-> Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))))
-> (Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)
-> StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
-> Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))
forall a b. (a, b) -> a
fst) [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
stmts)
FreeVars -> FreeVars -> FreeVars
`intersectNameSet` FreeVars
tail_fvs
pvars :: [Name]
pvars = FreeVars -> [Name]
nameSetElemsStable FreeVars
pvarset
pat :: LPat GhcRn
pat = [IdP GhcRn] -> LPat GhcRn
mkBigLHsVarPatTup [Name]
[IdP GhcRn]
pvars
tup :: LHsExpr GhcRn
tup = [IdP GhcRn] -> LHsExpr GhcRn
forall (id :: Pass). [IdP (GhcPass id)] -> LHsExpr (GhcPass id)
mkBigLHsVarTup [Name]
[IdP GhcRn]
pvars
([Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))]
stmts',FreeVars
fvs2) <- MonadNames
-> HsStmtContext GhcRn
-> ExprStmtTree
-> [ExprLStmt GhcRn]
-> FreeVars
-> RnM ([ExprLStmt GhcRn], FreeVars)
stmtTreeToStmts MonadNames
monad_names HsStmtContext GhcRn
ctxt StmtTree
(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
ExprStmtTree
tree [] FreeVars
pvarset
(HsExpr GhcRn
mb_ret, FreeVars
fvs1) <-
if | L SrcSpan
_ ApplicativeStmt{} <- [Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))]
-> Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))
forall a. [a] -> a
last [Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))]
stmts' ->
(HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (Located (HsExpr GhcRn) -> HsExpr GhcRn
forall l e. GenLocated l e -> e
unLoc Located (HsExpr GhcRn)
LHsExpr GhcRn
tup, FreeVars
emptyNameSet)
| Bool
otherwise -> do
(HsExpr GhcRn
ret, FreeVars
_) <- HsStmtContext GhcRn -> Name -> TcM (HsExpr GhcRn, FreeVars)
forall p. HsStmtContext p -> Name -> TcM (HsExpr GhcRn, FreeVars)
lookupQualifiedDoExpr HsStmtContext GhcRn
ctxt Name
returnMName
let expr :: HsExpr GhcRn
expr = XApp GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn
forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsApp NoExtField
XApp GhcRn
noExtField (HsExpr GhcRn -> Located (HsExpr GhcRn)
forall e. e -> Located e
noLoc HsExpr GhcRn
ret) LHsExpr GhcRn
tup
(HsExpr GhcRn, FreeVars) -> TcM (HsExpr GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (HsExpr GhcRn
expr, FreeVars
emptyFVs)
(ApplicativeArg GhcRn, FreeVars)
-> IOEnv (Env TcGblEnv TcLclEnv) (ApplicativeArg GhcRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return ( ApplicativeArgMany :: forall idL.
XApplicativeArgMany idL
-> [ExprLStmt idL]
-> HsExpr idL
-> LPat idL
-> HsStmtContext GhcRn
-> ApplicativeArg idL
ApplicativeArgMany
{ xarg_app_arg_many :: XApplicativeArgMany GhcRn
xarg_app_arg_many = XApplicativeArgMany GhcRn
NoExtField
noExtField
, app_stmts :: [ExprLStmt GhcRn]
app_stmts = [Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))]
[ExprLStmt GhcRn]
stmts'
, final_expr :: HsExpr GhcRn
final_expr = HsExpr GhcRn
mb_ret
, bv_pattern :: LPat GhcRn
bv_pattern = LPat GhcRn
pat
, stmt_context :: HsStmtContext GhcRn
stmt_context = HsStmtContext GhcRn
ctxt
}
, FreeVars
fvs1 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs2)
segments
:: [(ExprLStmt GhcRn, FreeVars)]
-> [[(ExprLStmt GhcRn, FreeVars)]]
segments :: [(ExprLStmt GhcRn, FreeVars)] -> [[(ExprLStmt GhcRn, FreeVars)]]
segments [(ExprLStmt GhcRn, FreeVars)]
stmts = (([(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)],
Bool)
-> [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)])
-> [([(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)],
Bool)]
-> [[(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)]]
forall a b. (a -> b) -> [a] -> [b]
map ([(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)],
Bool)
-> [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)]
forall a b. (a, b) -> a
fst ([([(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)],
Bool)]
-> [[(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)]])
-> [([(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)],
Bool)]
-> [[(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)]]
forall a b. (a -> b) -> a -> b
$ [[(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)]]
-> [([(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)],
Bool)]
forall (a :: Pass) b b.
[[(Located (StmtLR (GhcPass a) (GhcPass a) b), b)]]
-> [([(Located (StmtLR (GhcPass a) (GhcPass a) b), b)], Bool)]
merge ([[(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)]]
-> [([(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)],
Bool)])
-> [[(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)]]
-> [([(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)],
Bool)]
forall a b. (a -> b) -> a -> b
$ [[(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)]]
-> [[(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)]]
forall a. [a] -> [a]
reverse ([[(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)]]
-> [[(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)]])
-> [[(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)]]
-> [[(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)]]
forall a b. (a -> b) -> a -> b
$ ([(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)]
-> [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)])
-> [[(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)]]
-> [[(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)]]
forall a b. (a -> b) -> [a] -> [b]
map [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
-> [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)]
forall a. [a] -> [a]
reverse ([[(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)]]
-> [[(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)]])
-> [[(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)]]
-> [[(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)]]
forall a b. (a -> b) -> a -> b
$ [(ExprLStmt GhcRn, FreeVars)] -> [[(ExprLStmt GhcRn, FreeVars)]]
walk ([(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
-> [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)]
forall a. [a] -> [a]
reverse [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
[(ExprLStmt GhcRn, FreeVars)]
stmts)
where
allvars :: FreeVars
allvars = [Name] -> FreeVars
mkNameSet (((Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
-> [Name])
-> [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)]
-> [Name]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)) -> [Name]
forall (idL :: Pass) (idR :: Pass) body.
CollectPass (GhcPass idL) =>
StmtLR (GhcPass idL) (GhcPass idR) body -> [IdP (GhcPass idL)]
collectStmtBinders(StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)) -> [Name])
-> ((Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)
-> StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))
-> (Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)
-> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))
-> StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))
forall l e. GenLocated l e -> e
unLoc(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))
-> StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))
-> ((Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)
-> Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))))
-> (Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)
-> StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
-> Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))
forall a b. (a, b) -> a
fst) [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
[(ExprLStmt GhcRn, FreeVars)]
stmts)
merge :: [[(Located (StmtLR (GhcPass a) (GhcPass a) b), b)]]
-> [([(Located (StmtLR (GhcPass a) (GhcPass a) b), b)], Bool)]
merge [] = []
merge ([(Located (StmtLR (GhcPass a) (GhcPass a) b), b)]
seg : [[(Located (StmtLR (GhcPass a) (GhcPass a) b), b)]]
segs)
= case [([(Located (StmtLR (GhcPass a) (GhcPass a) b), b)], Bool)]
rest of
[] -> [([(Located (StmtLR (GhcPass a) (GhcPass a) b), b)]
seg,Bool
all_lets)]
(([(Located (StmtLR (GhcPass a) (GhcPass a) b), b)]
s,Bool
s_lets):[([(Located (StmtLR (GhcPass a) (GhcPass a) b), b)], Bool)]
ss) | Bool
all_lets Bool -> Bool -> Bool
|| Bool
s_lets
-> ([(Located (StmtLR (GhcPass a) (GhcPass a) b), b)]
seg [(Located (StmtLR (GhcPass a) (GhcPass a) b), b)]
-> [(Located (StmtLR (GhcPass a) (GhcPass a) b), b)]
-> [(Located (StmtLR (GhcPass a) (GhcPass a) b), b)]
forall a. [a] -> [a] -> [a]
++ [(Located (StmtLR (GhcPass a) (GhcPass a) b), b)]
s, Bool
all_lets Bool -> Bool -> Bool
&& Bool
s_lets) ([(Located (StmtLR (GhcPass a) (GhcPass a) b), b)], Bool)
-> [([(Located (StmtLR (GhcPass a) (GhcPass a) b), b)], Bool)]
-> [([(Located (StmtLR (GhcPass a) (GhcPass a) b), b)], Bool)]
forall a. a -> [a] -> [a]
: [([(Located (StmtLR (GhcPass a) (GhcPass a) b), b)], Bool)]
ss
[([(Located (StmtLR (GhcPass a) (GhcPass a) b), b)], Bool)]
_otherwise -> ([(Located (StmtLR (GhcPass a) (GhcPass a) b), b)]
seg,Bool
all_lets) ([(Located (StmtLR (GhcPass a) (GhcPass a) b), b)], Bool)
-> [([(Located (StmtLR (GhcPass a) (GhcPass a) b), b)], Bool)]
-> [([(Located (StmtLR (GhcPass a) (GhcPass a) b), b)], Bool)]
forall a. a -> [a] -> [a]
: [([(Located (StmtLR (GhcPass a) (GhcPass a) b), b)], Bool)]
rest
where
rest :: [([(Located (StmtLR (GhcPass a) (GhcPass a) b), b)], Bool)]
rest = [[(Located (StmtLR (GhcPass a) (GhcPass a) b), b)]]
-> [([(Located (StmtLR (GhcPass a) (GhcPass a) b), b)], Bool)]
merge [[(Located (StmtLR (GhcPass a) (GhcPass a) b), b)]]
segs
all_lets :: Bool
all_lets = ((Located (StmtLR (GhcPass a) (GhcPass a) b), b) -> Bool)
-> [(Located (StmtLR (GhcPass a) (GhcPass a) b), b)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Located (StmtLR (GhcPass a) (GhcPass a) b) -> Bool
forall (a :: Pass) b. LStmt (GhcPass a) b -> Bool
isLetStmt (Located (StmtLR (GhcPass a) (GhcPass a) b) -> Bool)
-> ((Located (StmtLR (GhcPass a) (GhcPass a) b), b)
-> Located (StmtLR (GhcPass a) (GhcPass a) b))
-> (Located (StmtLR (GhcPass a) (GhcPass a) b), b)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Located (StmtLR (GhcPass a) (GhcPass a) b), b)
-> Located (StmtLR (GhcPass a) (GhcPass a) b)
forall a b. (a, b) -> a
fst) [(Located (StmtLR (GhcPass a) (GhcPass a) b), b)]
seg
walk :: [(ExprLStmt GhcRn, FreeVars)] -> [[(ExprLStmt GhcRn, FreeVars)]]
walk :: [(ExprLStmt GhcRn, FreeVars)] -> [[(ExprLStmt GhcRn, FreeVars)]]
walk [] = []
walk ((ExprLStmt GhcRn
stmt,FreeVars
fvs) : [(ExprLStmt GhcRn, FreeVars)]
stmts) = ((Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))
ExprLStmt GhcRn
stmt,FreeVars
fvs) (Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
-> [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)]
-> [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)]
forall a. a -> [a] -> [a]
: [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
seg) [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
-> [[(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)]]
-> [[(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)]]
forall a. a -> [a] -> [a]
: [(ExprLStmt GhcRn, FreeVars)] -> [[(ExprLStmt GhcRn, FreeVars)]]
walk [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
[(ExprLStmt GhcRn, FreeVars)]
rest
where ([(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
seg,[(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
rest) = FreeVars
-> [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)]
-> ([(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)],
[(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)])
chunter FreeVars
fvs' [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
[(ExprLStmt GhcRn, FreeVars)]
stmts
(FreeVars
_, FreeVars
fvs') = Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))
-> FreeVars -> (FreeVars, FreeVars)
stmtRefs Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))
ExprLStmt GhcRn
stmt FreeVars
fvs
chunter :: FreeVars
-> [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)]
-> ([(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)],
[(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)])
chunter FreeVars
_ [] = ([], [])
chunter FreeVars
vars ((Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))
stmt,FreeVars
fvs) : [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
rest)
| Bool -> Bool
not (FreeVars -> Bool
isEmptyNameSet FreeVars
vars)
Bool -> Bool -> Bool
|| ExprLStmt GhcRn -> Bool
isStrictPatternBind Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))
ExprLStmt GhcRn
stmt
= ((Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))
stmt,FreeVars
fvs) (Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)
-> [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)]
-> [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)]
forall a. a -> [a] -> [a]
: [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
chunk, [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
rest')
where ([(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
chunk,[(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
rest') = FreeVars
-> [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)]
-> ([(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)],
[(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)])
chunter FreeVars
vars' [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
rest
(FreeVars
pvars, FreeVars
evars) = Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))
-> FreeVars -> (FreeVars, FreeVars)
stmtRefs Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))
stmt FreeVars
fvs
vars' :: FreeVars
vars' = (FreeVars
vars FreeVars -> FreeVars -> FreeVars
`minusNameSet` FreeVars
pvars) FreeVars -> FreeVars -> FreeVars
`unionNameSet` FreeVars
evars
chunter FreeVars
_ [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
rest = ([], [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
rest)
stmtRefs :: Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))
-> FreeVars -> (FreeVars, FreeVars)
stmtRefs Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))
stmt FreeVars
fvs
| LStmt GhcRn (Located (HsExpr GhcRn)) -> Bool
forall (a :: Pass) b. LStmt (GhcPass a) b -> Bool
isLetStmt Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))
LStmt GhcRn (Located (HsExpr GhcRn))
stmt = (FreeVars
pvars, FreeVars
fvs' FreeVars -> FreeVars -> FreeVars
`minusNameSet` FreeVars
pvars)
| Bool
otherwise = (FreeVars
pvars, FreeVars
fvs')
where fvs' :: FreeVars
fvs' = FreeVars
fvs FreeVars -> FreeVars -> FreeVars
`intersectNameSet` FreeVars
allvars
pvars :: FreeVars
pvars = [Name] -> FreeVars
mkNameSet (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)) -> [IdP GhcRn]
forall (idL :: Pass) (idR :: Pass) body.
CollectPass (GhcPass idL) =>
StmtLR (GhcPass idL) (GhcPass idR) body -> [IdP (GhcPass idL)]
collectStmtBinders (Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))
-> StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))
forall l e. GenLocated l e -> e
unLoc Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))
stmt))
isStrictPatternBind :: ExprLStmt GhcRn -> Bool
isStrictPatternBind :: ExprLStmt GhcRn -> Bool
isStrictPatternBind (L _ (BindStmt _ pat _)) = LPat GhcRn -> Bool
forall (p :: Pass). LPat (GhcPass p) -> Bool
isStrictPattern LPat GhcRn
pat
isStrictPatternBind ExprLStmt GhcRn
_ = Bool
False
isStrictPattern :: LPat (GhcPass p) -> Bool
isStrictPattern :: LPat (GhcPass p) -> Bool
isStrictPattern LPat (GhcPass p)
lpat =
case GenLocated SrcSpan (Pat (GhcPass p)) -> Pat (GhcPass p)
forall l e. GenLocated l e -> e
unLoc GenLocated SrcSpan (Pat (GhcPass p))
LPat (GhcPass p)
lpat of
WildPat{} -> Bool
False
VarPat{} -> Bool
False
LazyPat{} -> Bool
False
AsPat XAsPat (GhcPass p)
_ LIdP (GhcPass p)
_ LPat (GhcPass p)
p -> LPat (GhcPass p) -> Bool
forall (p :: Pass). LPat (GhcPass p) -> Bool
isStrictPattern LPat (GhcPass p)
p
ParPat XParPat (GhcPass p)
_ LPat (GhcPass p)
p -> LPat (GhcPass p) -> Bool
forall (p :: Pass). LPat (GhcPass p) -> Bool
isStrictPattern LPat (GhcPass p)
p
ViewPat XViewPat (GhcPass p)
_ LHsExpr (GhcPass p)
_ LPat (GhcPass p)
p -> LPat (GhcPass p) -> Bool
forall (p :: Pass). LPat (GhcPass p) -> Bool
isStrictPattern LPat (GhcPass p)
p
SigPat XSigPat (GhcPass p)
_ LPat (GhcPass p)
p HsPatSigType (NoGhcTc (GhcPass p))
_ -> LPat (GhcPass p) -> Bool
forall (p :: Pass). LPat (GhcPass p) -> Bool
isStrictPattern LPat (GhcPass p)
p
BangPat{} -> Bool
True
ListPat{} -> Bool
True
TuplePat{} -> Bool
True
SumPat{} -> Bool
True
ConPat{} -> Bool
True
LitPat{} -> Bool
True
NPat{} -> Bool
True
NPlusKPat{} -> Bool
True
SplicePat{} -> Bool
True
XPat{} -> String -> Bool
forall a. String -> a
panic String
"isStrictPattern: XPat"
hasRefutablePattern :: ApplicativeArg GhcRn -> Bool
hasRefutablePattern :: ApplicativeArg GhcRn -> Bool
hasRefutablePattern (ApplicativeArgOne { app_arg_pattern :: forall idL. ApplicativeArg idL -> LPat idL
app_arg_pattern = LPat GhcRn
pat
, is_body_stmt :: forall idL. ApplicativeArg idL -> Bool
is_body_stmt = Bool
False}) = Bool -> Bool
not (LPat GhcRn -> Bool
forall (p :: Pass). OutputableBndrId p => LPat (GhcPass p) -> Bool
isIrrefutableHsPat LPat GhcRn
pat)
hasRefutablePattern ApplicativeArg GhcRn
_ = Bool
False
isLetStmt :: LStmt (GhcPass a) b -> Bool
isLetStmt :: LStmt (GhcPass a) b -> Bool
isLetStmt (L _ LetStmt{}) = Bool
True
isLetStmt LStmt (GhcPass a) b
_ = Bool
False
splitSegment
:: [(ExprLStmt GhcRn, FreeVars)]
-> ( [(ExprLStmt GhcRn, FreeVars)]
, [(ExprLStmt GhcRn, FreeVars)] )
splitSegment :: [(ExprLStmt GhcRn, FreeVars)]
-> ([(ExprLStmt GhcRn, FreeVars)], [(ExprLStmt GhcRn, FreeVars)])
splitSegment [(ExprLStmt GhcRn, FreeVars)
one,(ExprLStmt GhcRn, FreeVars)
two] = ([(ExprLStmt GhcRn, FreeVars)
one],[(ExprLStmt GhcRn, FreeVars)
two])
splitSegment [(ExprLStmt GhcRn, FreeVars)]
stmts
| Just ([(LStmt GhcRn (Located (HsExpr GhcRn)), FreeVars)]
lets,[(LStmt GhcRn (Located (HsExpr GhcRn)), FreeVars)]
binds,[(LStmt GhcRn (Located (HsExpr GhcRn)), FreeVars)]
rest) <- [(LStmt GhcRn (Located (HsExpr GhcRn)), FreeVars)]
-> Maybe
([(LStmt GhcRn (Located (HsExpr GhcRn)), FreeVars)],
[(LStmt GhcRn (Located (HsExpr GhcRn)), FreeVars)],
[(LStmt GhcRn (Located (HsExpr GhcRn)), FreeVars)])
forall (body :: * -> *).
[(LStmt GhcRn (Located (body GhcRn)), FreeVars)]
-> Maybe
([(LStmt GhcRn (Located (body GhcRn)), FreeVars)],
[(LStmt GhcRn (Located (body GhcRn)), FreeVars)],
[(LStmt GhcRn (Located (body GhcRn)), FreeVars)])
slurpIndependentStmts [(LStmt GhcRn (Located (HsExpr GhcRn)), FreeVars)]
[(ExprLStmt GhcRn, FreeVars)]
stmts
= if Bool -> Bool
not ([(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
-> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
[(LStmt GhcRn (Located (HsExpr GhcRn)), FreeVars)]
lets)
then ([(LStmt GhcRn (Located (HsExpr GhcRn)), FreeVars)]
[(ExprLStmt GhcRn, FreeVars)]
lets, [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
[(LStmt GhcRn (Located (HsExpr GhcRn)), FreeVars)]
binds[(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
-> [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)]
-> [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)]
forall a. [a] -> [a] -> [a]
++[(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
[(LStmt GhcRn (Located (HsExpr GhcRn)), FreeVars)]
rest)
else ([(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
[(LStmt GhcRn (Located (HsExpr GhcRn)), FreeVars)]
lets[(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
-> [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)]
-> [(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))),
FreeVars)]
forall a. [a] -> [a] -> [a]
++[(Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))), FreeVars)]
[(LStmt GhcRn (Located (HsExpr GhcRn)), FreeVars)]
binds, [(LStmt GhcRn (Located (HsExpr GhcRn)), FreeVars)]
[(ExprLStmt GhcRn, FreeVars)]
rest)
| Bool
otherwise
= case [(ExprLStmt GhcRn, FreeVars)]
stmts of
((ExprLStmt GhcRn, FreeVars)
x:[(ExprLStmt GhcRn, FreeVars)]
xs) -> ([(ExprLStmt GhcRn, FreeVars)
x],[(ExprLStmt GhcRn, FreeVars)]
xs)
[(ExprLStmt GhcRn, FreeVars)]
_other -> ([(ExprLStmt GhcRn, FreeVars)]
stmts,[])
slurpIndependentStmts
:: [(LStmt GhcRn (Located (body GhcRn)), FreeVars)]
-> Maybe ( [(LStmt GhcRn (Located (body GhcRn)), FreeVars)]
, [(LStmt GhcRn (Located (body GhcRn)), FreeVars)]
, [(LStmt GhcRn (Located (body GhcRn)), FreeVars)] )
slurpIndependentStmts :: [(LStmt GhcRn (Located (body GhcRn)), FreeVars)]
-> Maybe
([(LStmt GhcRn (Located (body GhcRn)), FreeVars)],
[(LStmt GhcRn (Located (body GhcRn)), FreeVars)],
[(LStmt GhcRn (Located (body GhcRn)), FreeVars)])
slurpIndependentStmts [(LStmt GhcRn (Located (body GhcRn)), FreeVars)]
stmts = [(GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)]
-> [(GenLocated
SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)]
-> FreeVars
-> [(GenLocated
SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)]
-> Maybe
([(GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
[(GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)],
[(GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)])
forall (p :: Pass) idR body idR body l.
(IsPass p,
XBindStmt (GhcPass p) idR body ~ XBindStmt (GhcPass p) idR body,
IdGhcP p ~ Name,
XLetStmt (GhcPass p) idR body ~ XLetStmt (GhcPass p) idR body) =>
[(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
-> [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
-> FreeVars
-> [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
-> Maybe
([(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)],
[(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)],
[(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)])
go [] [] FreeVars
emptyNameSet [(GenLocated SrcSpan (StmtLR GhcRn GhcRn (Located (body GhcRn))),
FreeVars)]
[(LStmt GhcRn (Located (body GhcRn)), FreeVars)]
stmts
where
go :: [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
-> [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
-> FreeVars
-> [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
-> Maybe
([(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)],
[(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)],
[(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)])
go [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
lets [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
indep FreeVars
bndrs ((L l
loc (BindStmt XBindStmt (GhcPass p) idR body
xbs LPat (GhcPass p)
pat body
body), FreeVars
fvs): [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
rest)
| FreeVars -> FreeVars -> Bool
disjointNameSet FreeVars
bndrs FreeVars
fvs Bool -> Bool -> Bool
&& Bool -> Bool
not (LPat (GhcPass p) -> Bool
forall (p :: Pass). LPat (GhcPass p) -> Bool
isStrictPattern LPat (GhcPass p)
pat)
= [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
-> [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
-> FreeVars
-> [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
-> Maybe
([(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)],
[(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)],
[(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)])
go [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
lets ((l
-> StmtLR (GhcPass p) idR body
-> GenLocated l (StmtLR (GhcPass p) idR body)
forall l e. l -> e -> GenLocated l e
L l
loc (XBindStmt (GhcPass p) idR body
-> LPat (GhcPass p) -> body -> StmtLR (GhcPass p) idR body
forall idL idR body.
XBindStmt idL idR body -> LPat idL -> body -> StmtLR idL idR body
BindStmt XBindStmt (GhcPass p) idR body
XBindStmt (GhcPass p) idR body
xbs LPat (GhcPass p)
pat body
body), FreeVars
fvs) (GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)
-> [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
-> [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
forall a. a -> [a] -> [a]
: [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
indep)
FreeVars
bndrs' [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
rest
where bndrs' :: FreeVars
bndrs' = FreeVars
bndrs FreeVars -> FreeVars -> FreeVars
`unionNameSet` [Name] -> FreeVars
mkNameSet (LPat (GhcPass p) -> [IdP (GhcPass p)]
forall p. CollectPass p => LPat p -> [IdP p]
collectPatBinders LPat (GhcPass p)
pat)
go [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
lets [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
indep FreeVars
bndrs ((L l
loc (LetStmt XLetStmt (GhcPass p) idR body
noExtField LHsLocalBindsLR (GhcPass p) idR
binds), FreeVars
fvs) : [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
rest)
| FreeVars -> FreeVars -> Bool
disjointNameSet FreeVars
bndrs FreeVars
fvs
= [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
-> [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
-> FreeVars
-> [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
-> Maybe
([(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)],
[(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)],
[(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)])
go ((l
-> StmtLR (GhcPass p) idR body
-> GenLocated l (StmtLR (GhcPass p) idR body)
forall l e. l -> e -> GenLocated l e
L l
loc (XLetStmt (GhcPass p) idR body
-> LHsLocalBindsLR (GhcPass p) idR -> StmtLR (GhcPass p) idR body
forall idL idR body.
XLetStmt idL idR body
-> LHsLocalBindsLR idL idR -> StmtLR idL idR body
LetStmt XLetStmt (GhcPass p) idR body
XLetStmt (GhcPass p) idR body
noExtField LHsLocalBindsLR (GhcPass p) idR
binds), FreeVars
fvs) (GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)
-> [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
-> [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
forall a. a -> [a] -> [a]
: [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
lets) [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
indep FreeVars
bndrs [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
rest
go [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
_ [] FreeVars
_ [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
_ = Maybe
([(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)],
[(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)],
[(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)])
forall a. Maybe a
Nothing
go [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
_ [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)
_] FreeVars
_ [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
_ = Maybe
([(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)],
[(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)],
[(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)])
forall a. Maybe a
Nothing
go [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
lets [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
indep FreeVars
_ [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
stmts = ([(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)],
[(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)],
[(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)])
-> Maybe
([(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)],
[(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)],
[(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)])
forall a. a -> Maybe a
Just ([(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
-> [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
forall a. [a] -> [a]
reverse [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
lets, [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
-> [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
forall a. [a] -> [a]
reverse [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
indep, [(GenLocated l (StmtLR (GhcPass p) idR body), FreeVars)]
stmts)
mkApplicativeStmt
:: HsStmtContext GhcRn
-> [ApplicativeArg GhcRn]
-> Bool
-> [ExprLStmt GhcRn]
-> RnM ([ExprLStmt GhcRn], FreeVars)
mkApplicativeStmt :: HsStmtContext GhcRn
-> [ApplicativeArg GhcRn]
-> Bool
-> [ExprLStmt GhcRn]
-> RnM ([ExprLStmt GhcRn], FreeVars)
mkApplicativeStmt HsStmtContext GhcRn
ctxt [ApplicativeArg GhcRn]
args Bool
need_join [ExprLStmt GhcRn]
body_stmts
= do { (SyntaxExprRn
fmap_op, FreeVars
fvs1) <- HsStmtContext GhcRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupQualifiedDoStmtName HsStmtContext GhcRn
ctxt Name
fmapName
; (SyntaxExprRn
ap_op, FreeVars
fvs2) <- HsStmtContext GhcRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupQualifiedDoStmtName HsStmtContext GhcRn
ctxt Name
apAName
; (Maybe SyntaxExprRn
mb_join, FreeVars
fvs3) <-
if Bool
need_join then
do { (SyntaxExprRn
join_op, FreeVars
fvs) <- HsStmtContext GhcRn -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupQualifiedDoStmtName HsStmtContext GhcRn
ctxt Name
joinMName
; (Maybe SyntaxExprRn, FreeVars)
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (SyntaxExprRn -> Maybe SyntaxExprRn
forall a. a -> Maybe a
Just SyntaxExprRn
join_op, FreeVars
fvs) }
else
(Maybe SyntaxExprRn, FreeVars)
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe SyntaxExprRn
forall a. Maybe a
Nothing, FreeVars
emptyNameSet)
; let applicative_stmt :: Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))
applicative_stmt = StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))
-> Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))
forall e. e -> Located e
noLoc (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))
-> Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))))
-> StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))
-> Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))
forall a b. (a -> b) -> a -> b
$ XApplicativeStmt GhcRn GhcRn (Located (HsExpr GhcRn))
-> [(SyntaxExpr GhcRn, ApplicativeArg GhcRn)]
-> Maybe (SyntaxExpr GhcRn)
-> StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))
forall idL idR body.
XApplicativeStmt idL idR body
-> [(SyntaxExpr idR, ApplicativeArg idL)]
-> Maybe (SyntaxExpr idR)
-> StmtLR idL idR body
ApplicativeStmt NoExtField
XApplicativeStmt GhcRn GhcRn (Located (HsExpr GhcRn))
noExtField
([SyntaxExprRn]
-> [ApplicativeArg GhcRn] -> [(SyntaxExprRn, ApplicativeArg GhcRn)]
forall a b. [a] -> [b] -> [(a, b)]
zip (SyntaxExprRn
fmap_op SyntaxExprRn -> [SyntaxExprRn] -> [SyntaxExprRn]
forall a. a -> [a] -> [a]
: SyntaxExprRn -> [SyntaxExprRn]
forall a. a -> [a]
repeat SyntaxExprRn
ap_op) [ApplicativeArg GhcRn]
args)
Maybe SyntaxExprRn
Maybe (SyntaxExpr GhcRn)
mb_join
; ([Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))], FreeVars)
-> IOEnv
(Env TcGblEnv TcLclEnv)
([Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))], FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return ( Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))
applicative_stmt Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))
-> [Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))]
-> [Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))]
forall a. a -> [a] -> [a]
: [Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))]
[ExprLStmt GhcRn]
body_stmts
, FreeVars
fvs1 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs2 FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fvs3) }
needJoin :: MonadNames
-> [ExprLStmt GhcRn]
-> (Bool, [ExprLStmt GhcRn])
needJoin :: MonadNames -> [ExprLStmt GhcRn] -> (Bool, [ExprLStmt GhcRn])
needJoin MonadNames
_monad_names [] = (Bool
False, [])
needJoin MonadNames
monad_names [L loc (LastStmt _ e _ t)]
| Just (LHsExpr GhcRn
arg, Bool
wasDollar) <- MonadNames -> LHsExpr GhcRn -> Maybe (LHsExpr GhcRn, Bool)
isReturnApp MonadNames
monad_names Located (HsExpr GhcRn)
LHsExpr GhcRn
e =
(Bool
False, [SrcSpan
-> StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))
-> Located (StmtLR GhcRn GhcRn (Located (HsExpr GhcRn)))
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc (XLastStmt GhcRn GhcRn (Located (HsExpr GhcRn))
-> Located (HsExpr GhcRn)
-> Maybe Bool
-> SyntaxExpr GhcRn
-> StmtLR GhcRn GhcRn (Located (HsExpr GhcRn))
forall idL idR body.
XLastStmt idL idR body
-> body -> Maybe Bool -> SyntaxExpr idR -> StmtLR idL idR body
LastStmt NoExtField
XLastStmt GhcRn GhcRn (Located (HsExpr GhcRn))
noExtField Located (HsExpr GhcRn)
LHsExpr GhcRn
arg (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
wasDollar) SyntaxExpr GhcRn
t)])
needJoin MonadNames
_monad_names [ExprLStmt GhcRn]
stmts = (Bool
True, [ExprLStmt GhcRn]
stmts)
isReturnApp :: MonadNames
-> LHsExpr GhcRn
-> Maybe (LHsExpr GhcRn, Bool)
isReturnApp :: MonadNames -> LHsExpr GhcRn -> Maybe (LHsExpr GhcRn, Bool)
isReturnApp MonadNames
monad_names (L _ (HsPar _ expr)) = MonadNames -> LHsExpr GhcRn -> Maybe (LHsExpr GhcRn, Bool)
isReturnApp MonadNames
monad_names LHsExpr GhcRn
expr
isReturnApp MonadNames
monad_names (L _ e) = case HsExpr GhcRn
e of
OpApp XOpApp GhcRn
_ LHsExpr GhcRn
l LHsExpr GhcRn
op LHsExpr GhcRn
r | Located (HsExpr GhcRn) -> Bool
is_return Located (HsExpr GhcRn)
LHsExpr GhcRn
l, Located (HsExpr GhcRn) -> Bool
is_dollar Located (HsExpr GhcRn)
LHsExpr GhcRn
op -> (Located (HsExpr GhcRn), Bool)
-> Maybe (Located (HsExpr GhcRn), Bool)
forall a. a -> Maybe a
Just (Located (HsExpr GhcRn)
LHsExpr GhcRn
r, Bool
True)
HsApp XApp GhcRn
_ LHsExpr GhcRn
f LHsExpr GhcRn
arg | Located (HsExpr GhcRn) -> Bool
is_return Located (HsExpr GhcRn)
LHsExpr GhcRn
f -> (Located (HsExpr GhcRn), Bool)
-> Maybe (Located (HsExpr GhcRn), Bool)
forall a. a -> Maybe a
Just (Located (HsExpr GhcRn)
LHsExpr GhcRn
arg, Bool
False)
HsExpr GhcRn
_otherwise -> Maybe (LHsExpr GhcRn, Bool)
forall a. Maybe a
Nothing
where
is_var :: (t -> Bool) -> GenLocated l (HsExpr p) -> Bool
is_var t -> Bool
f (L l
_ (HsPar XPar p
_ LHsExpr p
e)) = (t -> Bool) -> GenLocated l (HsExpr p) -> Bool
is_var t -> Bool
f GenLocated l (HsExpr p)
LHsExpr p
e
is_var t -> Bool
f (L l
_ (HsAppType XAppTypeE p
_ LHsExpr p
e LHsWcType (NoGhcTc p)
_)) = (t -> Bool) -> GenLocated l (HsExpr p) -> Bool
is_var t -> Bool
f GenLocated l (HsExpr p)
LHsExpr p
e
is_var t -> Bool
f (L l
_ (HsVar XVar p
_ (L _ r))) = t -> Bool
f t
r
is_var t -> Bool
_ GenLocated l (HsExpr p)
_ = Bool
False
is_return :: Located (HsExpr GhcRn) -> Bool
is_return = (Name -> Bool) -> Located (HsExpr GhcRn) -> Bool
forall p l t l.
(LIdP p ~ GenLocated l t, LHsExpr p ~ GenLocated l (HsExpr p)) =>
(t -> Bool) -> GenLocated l (HsExpr p) -> Bool
is_var (\Name
n -> Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== MonadNames -> Name
return_name MonadNames
monad_names
Bool -> Bool -> Bool
|| Name
n Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== MonadNames -> Name
pure_name MonadNames
monad_names)
is_dollar :: Located (HsExpr GhcRn) -> Bool
is_dollar = (Name -> Bool) -> Located (HsExpr GhcRn) -> Bool
forall p l t l.
(LIdP p ~ GenLocated l t, LHsExpr p ~ GenLocated l (HsExpr p)) =>
(t -> Bool) -> GenLocated l (HsExpr p) -> Bool
is_var (Name -> Unique -> Bool
forall a. Uniquable a => a -> Unique -> Bool
`hasKey` Unique
dollarIdKey)
checkEmptyStmts :: HsStmtContext GhcRn -> RnM ()
checkEmptyStmts :: HsStmtContext GhcRn -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkEmptyStmts HsStmtContext GhcRn
ctxt
= Bool
-> IOEnv (Env TcGblEnv TcLclEnv) ()
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (HsStmtContext GhcRn -> Bool
forall id. HsStmtContext id -> Bool
okEmpty HsStmtContext GhcRn
ctxt) (MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (HsStmtContext GhcRn -> MsgDoc
emptyErr HsStmtContext GhcRn
ctxt))
okEmpty :: HsStmtContext a -> Bool
okEmpty :: HsStmtContext a -> Bool
okEmpty (PatGuard {}) = Bool
True
okEmpty HsStmtContext a
_ = Bool
False
emptyErr :: HsStmtContext GhcRn -> SDoc
emptyErr :: HsStmtContext GhcRn -> MsgDoc
emptyErr (ParStmtCtxt {}) = String -> MsgDoc
text String
"Empty statement group in parallel comprehension"
emptyErr (TransStmtCtxt {}) = String -> MsgDoc
text String
"Empty statement group preceding 'group' or 'then'"
emptyErr HsStmtContext GhcRn
ctxt = String -> MsgDoc
text String
"Empty" MsgDoc -> MsgDoc -> MsgDoc
<+> HsStmtContext GhcRn -> MsgDoc
forall p.
(Outputable (IdP p), UnXRec p) =>
HsStmtContext p -> MsgDoc
pprStmtContext HsStmtContext GhcRn
ctxt
checkLastStmt :: Outputable (body GhcPs) => HsStmtContext GhcRn
-> LStmt GhcPs (Located (body GhcPs))
-> RnM (LStmt GhcPs (Located (body GhcPs)))
checkLastStmt :: HsStmtContext GhcRn
-> LStmt GhcPs (Located (body GhcPs))
-> RnM (LStmt GhcPs (Located (body GhcPs)))
checkLastStmt HsStmtContext GhcRn
ctxt lstmt :: LStmt GhcPs (Located (body GhcPs))
lstmt@(L loc stmt)
= case HsStmtContext GhcRn
ctxt of
HsStmtContext GhcRn
ListComp -> IOEnv
(Env TcGblEnv TcLclEnv)
(Located (StmtLR GhcPs GhcPs (Located (body GhcPs))))
RnM (LStmt GhcPs (Located (body GhcPs)))
check_comp
HsStmtContext GhcRn
MonadComp -> IOEnv
(Env TcGblEnv TcLclEnv)
(Located (StmtLR GhcPs GhcPs (Located (body GhcPs))))
RnM (LStmt GhcPs (Located (body GhcPs)))
check_comp
HsStmtContext GhcRn
ArrowExpr -> IOEnv
(Env TcGblEnv TcLclEnv)
(Located (StmtLR GhcPs GhcPs (Located (body GhcPs))))
RnM (LStmt GhcPs (Located (body GhcPs)))
check_do
DoExpr{} -> IOEnv
(Env TcGblEnv TcLclEnv)
(Located (StmtLR GhcPs GhcPs (Located (body GhcPs))))
RnM (LStmt GhcPs (Located (body GhcPs)))
check_do
MDoExpr{} -> IOEnv
(Env TcGblEnv TcLclEnv)
(Located (StmtLR GhcPs GhcPs (Located (body GhcPs))))
RnM (LStmt GhcPs (Located (body GhcPs)))
check_do
HsStmtContext GhcRn
_ -> IOEnv
(Env TcGblEnv TcLclEnv)
(Located (StmtLR GhcPs GhcPs (Located (body GhcPs))))
RnM (LStmt GhcPs (Located (body GhcPs)))
check_other
where
check_do :: IOEnv
(Env TcGblEnv TcLclEnv)
(Located (StmtLR GhcPs GhcPs (Located (body GhcPs))))
check_do
= case StmtLR GhcPs GhcPs (Located (body GhcPs))
stmt of
BodyStmt XBodyStmt GhcPs GhcPs (Located (body GhcPs))
_ Located (body GhcPs)
e SyntaxExpr GhcPs
_ SyntaxExpr GhcPs
_ -> Located (StmtLR GhcPs GhcPs (Located (body GhcPs)))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(Located (StmtLR GhcPs GhcPs (Located (body GhcPs))))
forall (m :: * -> *) a. Monad m => a -> m a
return (SrcSpan
-> StmtLR GhcPs GhcPs (Located (body GhcPs))
-> Located (StmtLR GhcPs GhcPs (Located (body GhcPs)))
forall l e. l -> e -> GenLocated l e
L SrcSpan
loc (Located (body GhcPs) -> StmtLR GhcPs GhcPs (Located (body GhcPs))
forall (idR :: Pass) (bodyR :: * -> *) (idL :: Pass).
IsPass idR =>
Located (bodyR (GhcPass idR))
-> StmtLR
(GhcPass idL) (GhcPass idR) (Located (bodyR (GhcPass idR)))
mkLastStmt Located (body GhcPs)
e))
LastStmt {} -> Located (StmtLR GhcPs GhcPs (Located (body GhcPs)))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(Located (StmtLR GhcPs GhcPs (Located (body GhcPs))))
forall (m :: * -> *) a. Monad m => a -> m a
return Located (StmtLR GhcPs GhcPs (Located (body GhcPs)))
LStmt GhcPs (Located (body GhcPs))
lstmt
StmtLR GhcPs GhcPs (Located (body GhcPs))
_ -> do { MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (MsgDoc -> Int -> MsgDoc -> MsgDoc
hang MsgDoc
last_error Int
2 (StmtLR GhcPs GhcPs (Located (body GhcPs)) -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr StmtLR GhcPs GhcPs (Located (body GhcPs))
stmt)); Located (StmtLR GhcPs GhcPs (Located (body GhcPs)))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(Located (StmtLR GhcPs GhcPs (Located (body GhcPs))))
forall (m :: * -> *) a. Monad m => a -> m a
return Located (StmtLR GhcPs GhcPs (Located (body GhcPs)))
LStmt GhcPs (Located (body GhcPs))
lstmt }
last_error :: MsgDoc
last_error = (String -> MsgDoc
text String
"The last statement in" MsgDoc -> MsgDoc -> MsgDoc
<+> HsStmtContext GhcRn -> MsgDoc
forall p.
(Outputable (IdP p), UnXRec p) =>
HsStmtContext p -> MsgDoc
pprAStmtContext HsStmtContext GhcRn
ctxt
MsgDoc -> MsgDoc -> MsgDoc
<+> String -> MsgDoc
text String
"must be an expression")
check_comp :: IOEnv
(Env TcGblEnv TcLclEnv)
(Located (StmtLR GhcPs GhcPs (Located (body GhcPs))))
check_comp
= case StmtLR GhcPs GhcPs (Located (body GhcPs))
stmt of
LastStmt {} -> Located (StmtLR GhcPs GhcPs (Located (body GhcPs)))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(Located (StmtLR GhcPs GhcPs (Located (body GhcPs))))
forall (m :: * -> *) a. Monad m => a -> m a
return Located (StmtLR GhcPs GhcPs (Located (body GhcPs)))
LStmt GhcPs (Located (body GhcPs))
lstmt
StmtLR GhcPs GhcPs (Located (body GhcPs))
_ -> String
-> MsgDoc
-> IOEnv
(Env TcGblEnv TcLclEnv)
(Located (StmtLR GhcPs GhcPs (Located (body GhcPs))))
forall a. HasCallStack => String -> MsgDoc -> a
pprPanic String
"checkLastStmt" (Located (StmtLR GhcPs GhcPs (Located (body GhcPs))) -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr Located (StmtLR GhcPs GhcPs (Located (body GhcPs)))
LStmt GhcPs (Located (body GhcPs))
lstmt)
check_other :: IOEnv
(Env TcGblEnv TcLclEnv)
(Located (StmtLR GhcPs GhcPs (Located (body GhcPs))))
check_other
= do { HsStmtContext GhcRn
-> LStmt GhcPs (Located (body GhcPs))
-> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (body :: * -> *).
HsStmtContext GhcRn
-> LStmt GhcPs (Located (body GhcPs))
-> IOEnv (Env TcGblEnv TcLclEnv) ()
checkStmt HsStmtContext GhcRn
ctxt LStmt GhcPs (Located (body GhcPs))
lstmt; Located (StmtLR GhcPs GhcPs (Located (body GhcPs)))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(Located (StmtLR GhcPs GhcPs (Located (body GhcPs))))
forall (m :: * -> *) a. Monad m => a -> m a
return Located (StmtLR GhcPs GhcPs (Located (body GhcPs)))
LStmt GhcPs (Located (body GhcPs))
lstmt }
checkStmt :: HsStmtContext GhcRn
-> LStmt GhcPs (Located (body GhcPs))
-> RnM ()
checkStmt :: HsStmtContext GhcRn
-> LStmt GhcPs (Located (body GhcPs))
-> IOEnv (Env TcGblEnv TcLclEnv) ()
checkStmt HsStmtContext GhcRn
ctxt (L _ stmt)
= do { DynFlags
dflags <- IOEnv (Env TcGblEnv TcLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
; case DynFlags
-> HsStmtContext GhcRn
-> Stmt GhcPs (Located (body GhcPs))
-> Validity
forall (body :: * -> *).
DynFlags
-> HsStmtContext GhcRn
-> Stmt GhcPs (Located (body GhcPs))
-> Validity
okStmt DynFlags
dflags HsStmtContext GhcRn
ctxt Stmt GhcPs (Located (body GhcPs))
stmt of
Validity
IsValid -> () -> IOEnv (Env TcGblEnv TcLclEnv) ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
NotValid MsgDoc
extra -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
addErr (MsgDoc
msg MsgDoc -> MsgDoc -> MsgDoc
$$ MsgDoc
extra) }
where
msg :: MsgDoc
msg = [MsgDoc] -> MsgDoc
sep [ String -> MsgDoc
text String
"Unexpected" MsgDoc -> MsgDoc -> MsgDoc
<+> Stmt GhcPs (Located (body GhcPs)) -> MsgDoc
forall (a :: Pass) body. Stmt (GhcPass a) body -> MsgDoc
pprStmtCat Stmt GhcPs (Located (body GhcPs))
stmt MsgDoc -> MsgDoc -> MsgDoc
<+> PtrString -> MsgDoc
ptext (String -> PtrString
sLit String
"statement")
, String -> MsgDoc
text String
"in" MsgDoc -> MsgDoc -> MsgDoc
<+> HsStmtContext GhcRn -> MsgDoc
forall p.
(Outputable (IdP p), UnXRec p) =>
HsStmtContext p -> MsgDoc
pprAStmtContext HsStmtContext GhcRn
ctxt ]
pprStmtCat :: Stmt (GhcPass a) body -> SDoc
pprStmtCat :: Stmt (GhcPass a) body -> MsgDoc
pprStmtCat (TransStmt {}) = String -> MsgDoc
text String
"transform"
pprStmtCat (LastStmt {}) = String -> MsgDoc
text String
"return expression"
pprStmtCat (BodyStmt {}) = String -> MsgDoc
text String
"body"
pprStmtCat (BindStmt {}) = String -> MsgDoc
text String
"binding"
pprStmtCat (LetStmt {}) = String -> MsgDoc
text String
"let"
pprStmtCat (RecStmt {}) = String -> MsgDoc
text String
"rec"
pprStmtCat (ParStmt {}) = String -> MsgDoc
text String
"parallel"
pprStmtCat (ApplicativeStmt {}) = String -> MsgDoc
forall a. String -> a
panic String
"pprStmtCat: ApplicativeStmt"
emptyInvalid :: Validity
emptyInvalid :: Validity
emptyInvalid = MsgDoc -> Validity
NotValid MsgDoc
Outputable.empty
okStmt, okDoStmt, okCompStmt, okParStmt
:: DynFlags -> HsStmtContext GhcRn
-> Stmt GhcPs (Located (body GhcPs)) -> Validity
okStmt :: DynFlags
-> HsStmtContext GhcRn
-> Stmt GhcPs (Located (body GhcPs))
-> Validity
okStmt DynFlags
dflags HsStmtContext GhcRn
ctxt Stmt GhcPs (Located (body GhcPs))
stmt
= case HsStmtContext GhcRn
ctxt of
PatGuard {} -> Stmt GhcPs (Located (body GhcPs)) -> Validity
forall (body :: * -> *).
Stmt GhcPs (Located (body GhcPs)) -> Validity
okPatGuardStmt Stmt GhcPs (Located (body GhcPs))
stmt
ParStmtCtxt HsStmtContext GhcRn
ctxt -> DynFlags
-> HsStmtContext GhcRn
-> Stmt GhcPs (Located (body GhcPs))
-> Validity
forall (body :: * -> *).
DynFlags
-> HsStmtContext GhcRn
-> Stmt GhcPs (Located (body GhcPs))
-> Validity
okParStmt DynFlags
dflags HsStmtContext GhcRn
ctxt Stmt GhcPs (Located (body GhcPs))
stmt
DoExpr{} -> DynFlags
-> HsStmtContext GhcRn
-> Stmt GhcPs (Located (body GhcPs))
-> Validity
forall (body :: * -> *).
DynFlags
-> HsStmtContext GhcRn
-> Stmt GhcPs (Located (body GhcPs))
-> Validity
okDoStmt DynFlags
dflags HsStmtContext GhcRn
ctxt Stmt GhcPs (Located (body GhcPs))
stmt
MDoExpr{} -> DynFlags
-> HsStmtContext GhcRn
-> Stmt GhcPs (Located (body GhcPs))
-> Validity
forall (body :: * -> *).
DynFlags
-> HsStmtContext GhcRn
-> Stmt GhcPs (Located (body GhcPs))
-> Validity
okDoStmt DynFlags
dflags HsStmtContext GhcRn
ctxt Stmt GhcPs (Located (body GhcPs))
stmt
HsStmtContext GhcRn
ArrowExpr -> DynFlags
-> HsStmtContext GhcRn
-> Stmt GhcPs (Located (body GhcPs))
-> Validity
forall (body :: * -> *).
DynFlags
-> HsStmtContext GhcRn
-> Stmt GhcPs (Located (body GhcPs))
-> Validity
okDoStmt DynFlags
dflags HsStmtContext GhcRn
ctxt Stmt GhcPs (Located (body GhcPs))
stmt
HsStmtContext GhcRn
GhciStmtCtxt -> DynFlags
-> HsStmtContext GhcRn
-> Stmt GhcPs (Located (body GhcPs))
-> Validity
forall (body :: * -> *).
DynFlags
-> HsStmtContext GhcRn
-> Stmt GhcPs (Located (body GhcPs))
-> Validity
okDoStmt DynFlags
dflags HsStmtContext GhcRn
ctxt Stmt GhcPs (Located (body GhcPs))
stmt
HsStmtContext GhcRn
ListComp -> DynFlags
-> HsStmtContext GhcRn
-> Stmt GhcPs (Located (body GhcPs))
-> Validity
forall (body :: * -> *).
DynFlags
-> HsStmtContext GhcRn
-> Stmt GhcPs (Located (body GhcPs))
-> Validity
okCompStmt DynFlags
dflags HsStmtContext GhcRn
ctxt Stmt GhcPs (Located (body GhcPs))
stmt
HsStmtContext GhcRn
MonadComp -> DynFlags
-> HsStmtContext GhcRn
-> Stmt GhcPs (Located (body GhcPs))
-> Validity
forall (body :: * -> *).
DynFlags
-> HsStmtContext GhcRn
-> Stmt GhcPs (Located (body GhcPs))
-> Validity
okCompStmt DynFlags
dflags HsStmtContext GhcRn
ctxt Stmt GhcPs (Located (body GhcPs))
stmt
TransStmtCtxt HsStmtContext GhcRn
ctxt -> DynFlags
-> HsStmtContext GhcRn
-> Stmt GhcPs (Located (body GhcPs))
-> Validity
forall (body :: * -> *).
DynFlags
-> HsStmtContext GhcRn
-> Stmt GhcPs (Located (body GhcPs))
-> Validity
okStmt DynFlags
dflags HsStmtContext GhcRn
ctxt Stmt GhcPs (Located (body GhcPs))
stmt
okPatGuardStmt :: Stmt GhcPs (Located (body GhcPs)) -> Validity
okPatGuardStmt :: Stmt GhcPs (Located (body GhcPs)) -> Validity
okPatGuardStmt Stmt GhcPs (Located (body GhcPs))
stmt
= case Stmt GhcPs (Located (body GhcPs))
stmt of
BodyStmt {} -> Validity
IsValid
BindStmt {} -> Validity
IsValid
LetStmt {} -> Validity
IsValid
Stmt GhcPs (Located (body GhcPs))
_ -> Validity
emptyInvalid
okParStmt :: DynFlags
-> HsStmtContext GhcRn
-> Stmt GhcPs (Located (body GhcPs))
-> Validity
okParStmt DynFlags
dflags HsStmtContext GhcRn
ctxt Stmt GhcPs (Located (body GhcPs))
stmt
= case Stmt GhcPs (Located (body GhcPs))
stmt of
LetStmt XLetStmt GhcPs GhcPs (Located (body GhcPs))
_ (L _ (HsIPBinds {})) -> Validity
emptyInvalid
Stmt GhcPs (Located (body GhcPs))
_ -> DynFlags
-> HsStmtContext GhcRn
-> Stmt GhcPs (Located (body GhcPs))
-> Validity
forall (body :: * -> *).
DynFlags
-> HsStmtContext GhcRn
-> Stmt GhcPs (Located (body GhcPs))
-> Validity
okStmt DynFlags
dflags HsStmtContext GhcRn
ctxt Stmt GhcPs (Located (body GhcPs))
stmt
okDoStmt :: DynFlags
-> HsStmtContext GhcRn
-> Stmt GhcPs (Located (body GhcPs))
-> Validity
okDoStmt DynFlags
dflags HsStmtContext GhcRn
ctxt Stmt GhcPs (Located (body GhcPs))
stmt
= case Stmt GhcPs (Located (body GhcPs))
stmt of
RecStmt {}
| Extension
LangExt.RecursiveDo Extension -> DynFlags -> Bool
`xopt` DynFlags
dflags -> Validity
IsValid
| HsStmtContext GhcRn
ArrowExpr <- HsStmtContext GhcRn
ctxt -> Validity
IsValid
| Bool
otherwise -> MsgDoc -> Validity
NotValid (String -> MsgDoc
text String
"Use RecursiveDo")
BindStmt {} -> Validity
IsValid
LetStmt {} -> Validity
IsValid
BodyStmt {} -> Validity
IsValid
Stmt GhcPs (Located (body GhcPs))
_ -> Validity
emptyInvalid
okCompStmt :: DynFlags
-> HsStmtContext GhcRn
-> Stmt GhcPs (Located (body GhcPs))
-> Validity
okCompStmt DynFlags
dflags HsStmtContext GhcRn
_ Stmt GhcPs (Located (body GhcPs))
stmt
= case Stmt GhcPs (Located (body GhcPs))
stmt of
BindStmt {} -> Validity
IsValid
LetStmt {} -> Validity
IsValid
BodyStmt {} -> Validity
IsValid
ParStmt {}
| Extension
LangExt.ParallelListComp Extension -> DynFlags -> Bool
`xopt` DynFlags
dflags -> Validity
IsValid
| Bool
otherwise -> MsgDoc -> Validity
NotValid (String -> MsgDoc
text String
"Use ParallelListComp")
TransStmt {}
| Extension
LangExt.TransformListComp Extension -> DynFlags -> Bool
`xopt` DynFlags
dflags -> Validity
IsValid
| Bool
otherwise -> MsgDoc -> Validity
NotValid (String -> MsgDoc
text String
"Use TransformListComp")
RecStmt {} -> Validity
emptyInvalid
LastStmt {} -> Validity
emptyInvalid
ApplicativeStmt {} -> Validity
emptyInvalid
checkTupleSection :: [LHsTupArg GhcPs] -> RnM ()
checkTupleSection :: [LHsTupArg GhcPs] -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkTupleSection [LHsTupArg GhcPs]
args
= do { Bool
tuple_section <- Extension -> TcRnIf TcGblEnv TcLclEnv Bool
forall gbl lcl. Extension -> TcRnIf gbl lcl Bool
xoptM Extension
LangExt.TupleSections
; Bool -> MsgDoc -> IOEnv (Env TcGblEnv TcLclEnv) ()
checkErr ((GenLocated SrcSpan (HsTupArg GhcPs) -> Bool)
-> [GenLocated SrcSpan (HsTupArg GhcPs)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all GenLocated SrcSpan (HsTupArg GhcPs) -> Bool
forall (p :: Pass). LHsTupArg (GhcPass p) -> Bool
tupArgPresent [GenLocated SrcSpan (HsTupArg GhcPs)]
[LHsTupArg GhcPs]
args Bool -> Bool -> Bool
|| Bool
tuple_section) MsgDoc
msg }
where
msg :: MsgDoc
msg = String -> MsgDoc
text String
"Illegal tuple section: use TupleSections"
sectionErr :: HsExpr GhcPs -> SDoc
sectionErr :: HsExpr GhcPs -> MsgDoc
sectionErr HsExpr GhcPs
expr
= MsgDoc -> Int -> MsgDoc -> MsgDoc
hang (String -> MsgDoc
text String
"A section must be enclosed in parentheses")
Int
2 (String -> MsgDoc
text String
"thus:" MsgDoc -> MsgDoc -> MsgDoc
<+> (MsgDoc -> MsgDoc
parens (HsExpr GhcPs -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr HsExpr GhcPs
expr)))
badIpBinds :: Outputable a => SDoc -> a -> SDoc
badIpBinds :: MsgDoc -> a -> MsgDoc
badIpBinds MsgDoc
what a
binds
= MsgDoc -> Int -> MsgDoc -> MsgDoc
hang (String -> MsgDoc
text String
"Implicit-parameter bindings illegal in" MsgDoc -> MsgDoc -> MsgDoc
<+> MsgDoc
what)
Int
2 (a -> MsgDoc
forall a. Outputable a => a -> MsgDoc
ppr a
binds)
monadFailOp :: LPat GhcPs
-> HsStmtContext GhcRn
-> RnM (FailOperator GhcRn, FreeVars)
monadFailOp :: LPat GhcPs
-> HsStmtContext GhcRn -> RnM (Maybe (SyntaxExpr GhcRn), FreeVars)
monadFailOp LPat GhcPs
pat HsStmtContext GhcRn
ctxt
| LPat GhcPs -> Bool
forall (p :: Pass). OutputableBndrId p => LPat (GhcPass p) -> Bool
isIrrefutableHsPat LPat GhcPs
pat = (Maybe SyntaxExprRn, FreeVars)
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe SyntaxExprRn
forall a. Maybe a
Nothing, FreeVars
emptyFVs)
| Bool -> Bool
not (HsStmtContext GhcRn -> Bool
forall id. HsStmtContext id -> Bool
isMonadStmtContext HsStmtContext GhcRn
ctxt) = (Maybe SyntaxExprRn, FreeVars)
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe SyntaxExprRn
forall a. Maybe a
Nothing, FreeVars
emptyFVs)
| Bool
otherwise = HsStmtContext GhcRn -> RnM (Maybe (SyntaxExpr GhcRn), FreeVars)
forall p.
HsStmtContext p -> RnM (Maybe (SyntaxExpr GhcRn), FreeVars)
getMonadFailOp HsStmtContext GhcRn
ctxt
getMonadFailOp :: HsStmtContext p -> RnM (FailOperator GhcRn, FreeVars)
getMonadFailOp :: HsStmtContext p -> RnM (Maybe (SyntaxExpr GhcRn), FreeVars)
getMonadFailOp HsStmtContext p
ctxt
= do { Bool
xOverloadedStrings <- (DynFlags -> Bool)
-> IOEnv (Env TcGblEnv TcLclEnv) DynFlags
-> TcRnIf TcGblEnv TcLclEnv Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Extension -> DynFlags -> Bool
xopt Extension
LangExt.OverloadedStrings) IOEnv (Env TcGblEnv TcLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
; Bool
xRebindableSyntax <- (DynFlags -> Bool)
-> IOEnv (Env TcGblEnv TcLclEnv) DynFlags
-> TcRnIf TcGblEnv TcLclEnv Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Extension -> DynFlags -> Bool
xopt Extension
LangExt.RebindableSyntax) IOEnv (Env TcGblEnv TcLclEnv) DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
; (SyntaxExprRn
fail, FreeVars
fvs) <- Bool
-> Bool -> IOEnv (Env TcGblEnv TcLclEnv) (SyntaxExprRn, FreeVars)
reallyGetMonadFailOp Bool
xRebindableSyntax Bool
xOverloadedStrings
; (Maybe SyntaxExprRn, FreeVars)
-> IOEnv (Env TcGblEnv TcLclEnv) (Maybe SyntaxExprRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (SyntaxExprRn -> Maybe SyntaxExprRn
forall a. a -> Maybe a
Just SyntaxExprRn
fail, FreeVars
fvs)
}
where
isQualifiedDo :: Bool
isQualifiedDo = Maybe ModuleName -> Bool
forall a. Maybe a -> Bool
isJust (HsStmtContext p -> Maybe ModuleName
forall p. HsStmtContext p -> Maybe ModuleName
qualifiedDoModuleName_maybe HsStmtContext p
ctxt)
reallyGetMonadFailOp :: Bool
-> Bool -> IOEnv (Env TcGblEnv TcLclEnv) (SyntaxExprRn, FreeVars)
reallyGetMonadFailOp Bool
rebindableSyntax Bool
overloadedStrings
| (Bool
isQualifiedDo Bool -> Bool -> Bool
|| Bool
rebindableSyntax) Bool -> Bool -> Bool
&& Bool
overloadedStrings = do
(HsExpr GhcRn
failExpr, FreeVars
failFvs) <- HsStmtContext p -> Name -> TcM (HsExpr GhcRn, FreeVars)
forall p. HsStmtContext p -> Name -> TcM (HsExpr GhcRn, FreeVars)
lookupQualifiedDoExpr HsStmtContext p
ctxt Name
failMName
(HsExpr GhcRn
fromStringExpr, FreeVars
fromStringFvs) <- Name -> TcM (HsExpr GhcRn, FreeVars)
lookupSyntaxExpr Name
fromStringName
let arg_lit :: OccName
arg_lit = String -> OccName
mkVarOcc String
"arg"
Name
arg_name <- OccName -> RnM Name
forall gbl lcl. OccName -> TcRnIf gbl lcl Name
newSysName OccName
arg_lit
let arg_syn_expr :: LHsExpr GhcRn
arg_syn_expr = IdP GhcRn -> LHsExpr GhcRn
forall (id :: Pass). IdP (GhcPass id) -> LHsExpr (GhcPass id)
nlHsVar Name
IdP GhcRn
arg_name
LHsExpr GhcRn
body :: LHsExpr GhcRn =
LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
nlHsApp (HsExpr GhcRn -> Located (HsExpr GhcRn)
forall e. e -> Located e
noLoc HsExpr GhcRn
failExpr)
(LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
nlHsApp (HsExpr GhcRn -> Located (HsExpr GhcRn)
forall e. e -> Located e
noLoc (HsExpr GhcRn -> Located (HsExpr GhcRn))
-> HsExpr GhcRn -> Located (HsExpr GhcRn)
forall a b. (a -> b) -> a -> b
$ HsExpr GhcRn
fromStringExpr) LHsExpr GhcRn
arg_syn_expr)
let HsExpr GhcRn
failAfterFromStringExpr :: HsExpr GhcRn =
Located (HsExpr GhcRn) -> HsExpr GhcRn
forall l e. GenLocated l e -> e
unLoc (Located (HsExpr GhcRn) -> HsExpr GhcRn)
-> Located (HsExpr GhcRn) -> HsExpr GhcRn
forall a b. (a -> b) -> a -> b
$ [LPat GhcRn] -> LHsExpr GhcRn -> LHsExpr GhcRn
forall (p :: Pass).
(IsPass p, XMG (GhcPass p) (LHsExpr (GhcPass p)) ~ NoExtField) =>
[LPat (GhcPass p)] -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
mkHsLam [Pat GhcRn -> Located (Pat GhcRn)
forall e. e -> Located e
noLoc (Pat GhcRn -> Located (Pat GhcRn))
-> Pat GhcRn -> Located (Pat GhcRn)
forall a b. (a -> b) -> a -> b
$ XVarPat GhcRn -> LIdP GhcRn -> Pat GhcRn
forall p. XVarPat p -> LIdP p -> Pat p
VarPat NoExtField
XVarPat GhcRn
noExtField (LIdP GhcRn -> Pat GhcRn) -> LIdP GhcRn -> Pat GhcRn
forall a b. (a -> b) -> a -> b
$ Name -> Located Name
forall e. e -> Located e
noLoc Name
arg_name] LHsExpr GhcRn
body
let SyntaxExpr GhcRn
failAfterFromStringSynExpr :: SyntaxExpr GhcRn =
HsExpr GhcRn -> SyntaxExprRn
mkSyntaxExpr HsExpr GhcRn
failAfterFromStringExpr
(SyntaxExprRn, FreeVars)
-> IOEnv (Env TcGblEnv TcLclEnv) (SyntaxExprRn, FreeVars)
forall (m :: * -> *) a. Monad m => a -> m a
return (SyntaxExprRn
SyntaxExpr GhcRn
failAfterFromStringSynExpr, FreeVars
failFvs FreeVars -> FreeVars -> FreeVars
`plusFV` FreeVars
fromStringFvs)
| Bool
otherwise = HsStmtContext p -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
forall p.
HsStmtContext p -> Name -> RnM (SyntaxExpr GhcRn, FreeVars)
lookupQualifiedDo HsStmtContext p
ctxt Name
failMName
rebindIf
:: Located Name
-> LHsExpr GhcRn
-> LHsExpr GhcRn
-> LHsExpr GhcRn
-> HsExpr GhcRn
rebindIf :: Located Name
-> LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn
rebindIf Located Name
ifteName LHsExpr GhcRn
p LHsExpr GhcRn
b1 LHsExpr GhcRn
b2 =
let ifteOrig :: HsExpr GhcRn
ifteOrig = XIf GhcRn
-> LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn
forall p. XIf p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
HsIf NoExtField
XIf GhcRn
noExtField LHsExpr GhcRn
p LHsExpr GhcRn
b1 LHsExpr GhcRn
b2
ifteFun :: Located (HsExpr GhcRn)
ifteFun = SrcSpan -> HsExpr GhcRn -> Located (HsExpr GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpan
generatedSrcSpan (XVar GhcRn -> LIdP GhcRn -> HsExpr GhcRn
forall p. XVar p -> LIdP p -> HsExpr p
HsVar NoExtField
XVar GhcRn
noExtField Located Name
LIdP GhcRn
ifteName)
ifteApp :: LHsExpr GhcRn
ifteApp = (LHsExpr GhcRn -> LHsExpr GhcRn -> HsExpr GhcRn -> LHsExpr GhcRn)
-> LHsExpr GhcRn -> [LHsExpr GhcRn] -> LHsExpr GhcRn
forall (id :: Pass).
(LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id)
-> HsExpr (GhcPass id)
-> LHsExpr (GhcPass id))
-> LHsExpr (GhcPass id)
-> [LHsExpr (GhcPass id)]
-> LHsExpr (GhcPass id)
mkHsAppsWith (\LHsExpr GhcRn
_ LHsExpr GhcRn
_ HsExpr GhcRn
e -> SrcSpan -> HsExpr GhcRn -> Located (HsExpr GhcRn)
forall l e. l -> e -> GenLocated l e
L SrcSpan
generatedSrcSpan HsExpr GhcRn
e)
Located (HsExpr GhcRn)
LHsExpr GhcRn
ifteFun
[LHsExpr GhcRn
p, LHsExpr GhcRn
b1, LHsExpr GhcRn
b2]
in (HsExpansion (HsExpr GhcRn) (HsExpr GhcRn) -> HsExpr GhcRn)
-> HsExpr GhcRn -> HsExpr GhcRn -> HsExpr GhcRn
forall a b. (HsExpansion a b -> b) -> a -> b -> b
mkExpanded HsExpansion (HsExpr GhcRn) (HsExpr GhcRn) -> HsExpr GhcRn
forall p. XXExpr p -> HsExpr p
XExpr HsExpr GhcRn
ifteOrig (Located (HsExpr GhcRn) -> HsExpr GhcRn
forall l e. GenLocated l e -> e
unLoc Located (HsExpr GhcRn)
LHsExpr GhcRn
ifteApp)