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