{-# LANGUAGE GADTs #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
module Debug.Breakpoint.Renamer
( renameAction
) where
import Control.Applicative ((<|>), empty)
import Control.Arrow ((&&&))
import Control.Monad.Reader
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.Writer.CPS
import Data.Data hiding (IntRep, FloatRep)
import qualified Data.Graph as Graph
import qualified Data.Map.Lazy as M
import Data.Maybe
import Data.Monoid (Any(..))
import Data.Traversable (for)
import qualified Debug.Breakpoint.GhcFacade as Ghc
renameAction
:: Ghc.TcGblEnv
-> Ghc.HsGroup Ghc.GhcRn
-> Ghc.TcM (Ghc.TcGblEnv, Ghc.HsGroup Ghc.GhcRn)
renameAction :: TcGblEnv
-> HsGroup (GhcPass 'Renamed)
-> TcM (TcGblEnv, HsGroup (GhcPass 'Renamed))
renameAction TcGblEnv
gblEnv HsGroup (GhcPass 'Renamed)
group = do
Ghc.Found ModLocation
_ Module
breakpointMod <-
ModuleName -> TcM FindResult
Ghc.findPluginModule' (String -> ModuleName
Ghc.mkModuleName String
"Debug.Breakpoint")
Name
captureVarsName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"captureVars")
Name
showLevName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"showLev")
Name
fromListName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"fromAscList")
Name
breakpointName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"breakpoint")
Name
queryVarsName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"queryVars")
Name
breakpointMName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"breakpointM")
Name
queryVarsMName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"queryVarsM")
Name
breakpointIOName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"breakpointIO")
Name
queryVarsIOName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"queryVarsIO")
Name
printAndWaitName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"printAndWait")
Name
printAndWaitMName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"printAndWaitM")
Name
printAndWaitIOName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"printAndWaitIO")
Name
runPromptIOName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"runPromptIO")
Name
runPromptMName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"runPromptM")
Name
runPromptName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"runPrompt")
Name
getSrcLocName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"getSrcLoc")
Name
excludeVarsName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"excludeVars")
(HsGroup (GhcPass 'Renamed)
group', Any
_) <-
ReaderT Env TcM (HsGroup (GhcPass 'Renamed), Any)
-> Env
-> IOEnv (Env TcGblEnv TcLclEnv) (HsGroup (GhcPass 'Renamed), Any)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (WriterT Any (ReaderT Env TcM) (HsGroup (GhcPass 'Renamed))
-> ReaderT Env TcM (HsGroup (GhcPass 'Renamed), Any)
forall w (m :: * -> *) a. Monoid w => WriterT w m a -> m (a, w)
runWriterT (WriterT Any (ReaderT Env TcM) (HsGroup (GhcPass 'Renamed))
-> ReaderT Env TcM (HsGroup (GhcPass 'Renamed), Any))
-> WriterT Any (ReaderT Env TcM) (HsGroup (GhcPass 'Renamed))
-> ReaderT Env TcM (HsGroup (GhcPass 'Renamed), Any)
forall a b. (a -> b) -> a -> b
$ HsGroup (GhcPass 'Renamed)
-> WriterT Any (ReaderT Env TcM) (HsGroup (GhcPass 'Renamed))
forall a. Data a => a -> EnvReader a
recurse HsGroup (GhcPass 'Renamed)
group)
MkEnv { varSet :: VarSet
varSet = VarSet
forall a. Monoid a => a
mempty, Name
captureVarsName :: Name
showLevName :: Name
fromListName :: Name
breakpointName :: Name
queryVarsName :: Name
breakpointMName :: Name
queryVarsMName :: Name
breakpointIOName :: Name
queryVarsIOName :: Name
printAndWaitName :: Name
printAndWaitMName :: Name
printAndWaitIOName :: Name
runPromptIOName :: Name
runPromptMName :: Name
runPromptName :: Name
getSrcLocName :: Name
excludeVarsName :: Name
captureVarsName :: Name
showLevName :: Name
fromListName :: Name
breakpointName :: Name
queryVarsName :: Name
breakpointMName :: Name
queryVarsMName :: Name
breakpointIOName :: Name
queryVarsIOName :: Name
printAndWaitName :: Name
printAndWaitMName :: Name
printAndWaitIOName :: Name
runPromptIOName :: Name
runPromptName :: Name
runPromptMName :: Name
getSrcLocName :: Name
excludeVarsName :: Name
.. }
(TcGblEnv, HsGroup (GhcPass 'Renamed))
-> TcM (TcGblEnv, HsGroup (GhcPass 'Renamed))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TcGblEnv
gblEnv, HsGroup (GhcPass 'Renamed)
group')
recurse :: Data a => a -> EnvReader a
recurse :: forall a. Data a => a -> EnvReader a
recurse a
a =
WriterT Any (ReaderT Env TcM) a
-> (a -> WriterT Any (ReaderT Env TcM) a)
-> Maybe a
-> WriterT Any (ReaderT Env TcM) a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((forall a. Data a => a -> EnvReader a)
-> a -> WriterT Any (ReaderT Env TcM) a
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> a -> m a
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a
gmapM d -> EnvReader d
forall a. Data a => a -> EnvReader a
recurse a
a) a -> WriterT Any (ReaderT Env TcM) a
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(Maybe a -> WriterT Any (ReaderT Env TcM) a)
-> WriterT Any (ReaderT Env TcM) (Maybe a)
-> WriterT Any (ReaderT Env TcM) a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< a -> WriterT Any (ReaderT Env TcM) (Maybe a)
forall a. Data a => a -> EnvReader (Maybe a)
transform a
a
newtype T a = T (a -> EnvReader (Maybe a))
transform :: forall a. Data a => a -> EnvReader (Maybe a)
transform :: forall a. Data a => a -> EnvReader (Maybe a)
transform a
a = MaybeT (WriterT Any (ReaderT Env TcM)) a
-> WriterT Any (ReaderT Env TcM) (Maybe a)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT
(MaybeT (WriterT Any (ReaderT Env TcM)) a
-> WriterT Any (ReaderT Env TcM) (Maybe a))
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
-> WriterT Any (ReaderT Env TcM) (Maybe a)
forall a b. (a -> b) -> a -> b
$ (HsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed))))
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
forall b.
Data b =>
(b -> EnvReader (Maybe b))
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
wrap HsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
hsVarCase
MaybeT (WriterT Any (ReaderT Env TcM)) a
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
forall a.
MaybeT (WriterT Any (ReaderT Env TcM)) a
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> EnvReader
(Maybe (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
forall b.
Data b =>
(b -> EnvReader (Maybe b))
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
wrap LHsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (LHsExpr (GhcPass 'Renamed)))
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> EnvReader
(Maybe (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
hsAppCase
MaybeT (WriterT Any (ReaderT Env TcM)) a
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
forall a.
MaybeT (WriterT Any (ReaderT Env TcM)) a
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Match
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader
(Maybe
(Match
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))))
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
forall b.
Data b =>
(b -> EnvReader (Maybe b))
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
wrap Match (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
-> EnvReader
(Maybe (Match (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))))
Match
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader
(Maybe
(Match
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
matchCase
MaybeT (WriterT Any (ReaderT Env TcM)) a
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
forall a.
MaybeT (WriterT Any (ReaderT Env TcM)) a
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader
(Maybe
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))))
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
forall b.
Data b =>
(b -> EnvReader (Maybe b))
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
wrap GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
-> EnvReader
(Maybe (GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))))
GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader
(Maybe
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
grhssCase
MaybeT (WriterT Any (ReaderT Env TcM)) a
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
forall a.
MaybeT (WriterT Any (ReaderT Env TcM)) a
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (HsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed))))
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
forall b.
Data b =>
(b -> EnvReader (Maybe b))
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
wrap HsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
hsLetCase
MaybeT (WriterT Any (ReaderT Env TcM)) a
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
forall a.
MaybeT (WriterT Any (ReaderT Env TcM)) a
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader
(Maybe
(GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))))
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
forall b.
Data b =>
(b -> EnvReader (Maybe b))
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
wrap GRHS (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
-> EnvReader
(Maybe (GRHS (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))))
GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader
(Maybe
(GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
grhsCase
MaybeT (WriterT Any (ReaderT Env TcM)) a
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
forall a.
MaybeT (WriterT Any (ReaderT Env TcM)) a
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (HsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed))))
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
forall b.
Data b =>
(b -> EnvReader (Maybe b))
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
wrap HsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
hsDoCase
MaybeT (WriterT Any (ReaderT Env TcM)) a
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
forall a.
MaybeT (WriterT Any (ReaderT Env TcM)) a
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (HsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed))))
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
forall b.
Data b =>
(b -> EnvReader (Maybe b))
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
wrap HsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
hsProcCase
where
wrap :: forall b. Data b
=> (b -> EnvReader (Maybe b))
-> MaybeT EnvReader a
wrap :: forall b.
Data b =>
(b -> EnvReader (Maybe b))
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
wrap b -> EnvReader (Maybe b)
f = do
case forall {k} (a :: k) (b :: k) (c :: k -> *).
(Typeable a, Typeable b) =>
c a -> Maybe (c b)
forall a b (c :: * -> *).
(Typeable a, Typeable b) =>
c a -> Maybe (c b)
gcast @b @a ((b -> EnvReader (Maybe b)) -> T b
forall a. (a -> EnvReader (Maybe a)) -> T a
T b -> EnvReader (Maybe b)
f) of
Maybe (T a)
Nothing -> MaybeT (WriterT Any (ReaderT Env TcM)) a
forall a. MaybeT (WriterT Any (ReaderT Env TcM)) a
forall (f :: * -> *) a. Alternative f => f a
empty
Just (T a -> WriterT Any (ReaderT Env TcM) (Maybe a)
f') -> WriterT Any (ReaderT Env TcM) (Maybe a)
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (WriterT Any (ReaderT Env TcM) (Maybe a)
-> MaybeT (WriterT Any (ReaderT Env TcM)) a)
-> WriterT Any (ReaderT Env TcM) (Maybe a)
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
forall a b. (a -> b) -> a -> b
$ a -> WriterT Any (ReaderT Env TcM) (Maybe a)
f' a
a
hsVarCase :: Ghc.HsExpr Ghc.GhcRn
-> EnvReader (Maybe (Ghc.HsExpr Ghc.GhcRn))
hsVarCase :: HsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
hsVarCase (Ghc.HsVar XVar (GhcPass 'Renamed)
_ (Ghc.L SrcSpanAnnN
loc Name
name)) = do
MkEnv{VarSet
Name
varSet :: Env -> VarSet
captureVarsName :: Env -> Name
showLevName :: Env -> Name
fromListName :: Env -> Name
breakpointName :: Env -> Name
queryVarsName :: Env -> Name
breakpointMName :: Env -> Name
queryVarsMName :: Env -> Name
breakpointIOName :: Env -> Name
queryVarsIOName :: Env -> Name
printAndWaitName :: Env -> Name
printAndWaitMName :: Env -> Name
printAndWaitIOName :: Env -> Name
runPromptIOName :: Env -> Name
runPromptName :: Env -> Name
runPromptMName :: Env -> Name
getSrcLocName :: Env -> Name
excludeVarsName :: Env -> Name
varSet :: VarSet
captureVarsName :: Name
showLevName :: Name
fromListName :: Name
breakpointName :: Name
queryVarsName :: Name
breakpointMName :: Name
queryVarsMName :: Name
breakpointIOName :: Name
queryVarsIOName :: Name
printAndWaitName :: Name
printAndWaitMName :: Name
printAndWaitIOName :: Name
runPromptIOName :: Name
runPromptName :: Name
runPromptMName :: Name
getSrcLocName :: Name
excludeVarsName :: Name
..} <- ReaderT Env TcM Env -> WriterT Any (ReaderT Env TcM) Env
forall (m :: * -> *) a. Monad m => m a -> WriterT Any m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT Env TcM Env
forall r (m :: * -> *). MonadReader r m => m r
ask
let srcLocStringExpr :: GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
srcLocStringExpr
= HsLit (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
HsLit (GhcPass 'Renamed)
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
forall (p :: Pass). HsLit (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsLit (HsLit (GhcPass 'Renamed)
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> (SrcSpan -> HsLit (GhcPass 'Renamed))
-> SrcSpan
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> HsLit (GhcPass 'Renamed)
forall (p :: Pass). String -> HsLit (GhcPass p)
Ghc.mkHsString
(String -> HsLit (GhcPass 'Renamed))
-> (SrcSpan -> String) -> SrcSpan -> HsLit (GhcPass 'Renamed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SDoc -> String
Ghc.showSDocUnsafe
(SDoc -> String) -> (SrcSpan -> SDoc) -> SrcSpan -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
Ghc.ppr
(SrcSpan -> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> SrcSpan -> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnN -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
Ghc.locA SrcSpanAnnN
loc
captureVarsExpr :: Maybe Name -> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
captureVarsExpr Maybe Name
mResultName =
let mkTuple :: (LexicalFastString, Name) -> LHsExpr (GhcPass 'Renamed)
mkTuple (LexicalFastString -> FastString
Ghc.fromLexicalFastString -> FastString
varStr, Name
n) =
[LHsExpr (GhcPass 'Renamed)]
-> XExplicitTuple (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (p :: Pass).
[LHsExpr (GhcPass p)]
-> XExplicitTuple (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.mkLHsTupleExpr
[ HsLit (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (p :: Pass). HsLit (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsLit (HsLit (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed))
-> (String -> HsLit (GhcPass 'Renamed))
-> String
-> LHsExpr (GhcPass 'Renamed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> HsLit (GhcPass 'Renamed)
forall (p :: Pass). String -> HsLit (GhcPass p)
Ghc.mkHsString (String -> LHsExpr (GhcPass 'Renamed))
-> String -> LHsExpr (GhcPass 'Renamed)
forall a b. (a -> b) -> a -> b
$ FastString -> String
Ghc.unpackFS FastString
varStr
, LHsExpr (GhcPass 'Renamed)
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp (IdP (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsVar IdP (GhcPass 'Renamed)
Name
showLevName) (IdP (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsVar IdP (GhcPass 'Renamed)
Name
n)
]
XExplicitTuple (GhcPass 'Renamed)
NoExtField
Ghc.NoExtField
mkList :: [XRec p (HsExpr p)] -> LocatedAn an (HsExpr p)
mkList [XRec p (HsExpr p)]
exprs = HsExpr p -> LocatedAn an (HsExpr p)
forall a an. a -> LocatedAn an a
Ghc.noLocA (XExplicitList p -> [XRec p (HsExpr p)] -> HsExpr p
forall p. XExplicitList p -> [LHsExpr p] -> HsExpr p
Ghc.ExplicitList XExplicitList p
NoExtField
Ghc.NoExtField [XRec p (HsExpr p)]
exprs)
varSetWithResult :: VarSet
varSetWithResult
| Just Name
resName <- Maybe Name
mResultName =
LexicalFastString -> Name -> VarSet -> VarSet
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (FastString -> LexicalFastString
Ghc.mkLexicalFastString (FastString -> LexicalFastString)
-> FastString -> LexicalFastString
forall a b. (a -> b) -> a -> b
$ String -> FastString
Ghc.mkFastString String
"*result")
Name
resName
VarSet
varSet
| Bool
otherwise = VarSet
varSet
in LHsExpr (GhcPass 'Renamed)
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp (IdP (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsVar IdP (GhcPass 'Renamed)
Name
fromListName) (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> ([GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))]
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> [GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))]
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LHsExpr (GhcPass 'Renamed)]
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
[GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))]
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
forall {p} {an}.
(XExplicitList p ~ NoExtField) =>
[XRec p (HsExpr p)] -> LocatedAn an (HsExpr p)
mkList
([GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))]
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> [GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))]
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ (LexicalFastString, Name) -> LHsExpr (GhcPass 'Renamed)
(LexicalFastString, Name)
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
mkTuple ((LexicalFastString, Name)
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> [(LexicalFastString, Name)]
-> [GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VarSet -> [(LexicalFastString, Name)]
forall k a. Map k a -> [(k, a)]
M.toList VarSet
varSetWithResult
bpExpr :: IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
bpExpr = do
Name
resultName <- OccName -> TcRnIf TcGblEnv TcLclEnv Name
Ghc.newName (NameSpace -> String -> OccName
Ghc.mkOccName NameSpace
Ghc.varName String
"_result_")
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall a b. (a -> b) -> a -> b
$
[LPat (GhcPass 'Renamed)]
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (p :: Pass).
(IsPass p, XMG (GhcPass p) (LHsExpr (GhcPass p)) ~ Origin) =>
[LPat (GhcPass p)] -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.mkHsLam [IdP (GhcPass 'Renamed) -> LPat (GhcPass 'Renamed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LPat (GhcPass p)
Ghc.nlVarPat IdP (GhcPass 'Renamed)
Name
resultName] (LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed))
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall a b. (a -> b) -> a -> b
$
LHsExpr (GhcPass 'Renamed)
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp
(LHsExpr (GhcPass 'Renamed)
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp
(LHsExpr (GhcPass 'Renamed)
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp (IdP (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsVar IdP (GhcPass 'Renamed)
Name
printAndWaitName) LHsExpr (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
srcLocStringExpr)
(Maybe Name -> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
captureVarsExpr (Maybe Name -> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> Maybe Name -> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ Name -> Maybe Name
forall a. a -> Maybe a
Just Name
resultName)
)
(IdP (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsVar IdP (GhcPass 'Renamed)
Name
resultName)
bpMExpr :: LHsExpr (GhcPass 'Renamed)
bpMExpr =
LHsExpr (GhcPass 'Renamed)
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp
(LHsExpr (GhcPass 'Renamed)
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp (IdP (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsVar IdP (GhcPass 'Renamed)
Name
printAndWaitMName) LHsExpr (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
srcLocStringExpr)
(LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed))
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall a b. (a -> b) -> a -> b
$ Maybe Name -> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
captureVarsExpr Maybe Name
forall a. Maybe a
Nothing
bpIOExpr :: LHsExpr (GhcPass 'Renamed)
bpIOExpr =
LHsExpr (GhcPass 'Renamed)
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp
(LHsExpr (GhcPass 'Renamed)
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp (IdP (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsVar IdP (GhcPass 'Renamed)
Name
printAndWaitIOName) LHsExpr (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
srcLocStringExpr)
(LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed))
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall a b. (a -> b) -> a -> b
$ Maybe Name -> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
captureVarsExpr Maybe Name
forall a. Maybe a
Nothing
queryVarsIOExpr :: LHsExpr (GhcPass 'Renamed)
queryVarsIOExpr =
LHsExpr (GhcPass 'Renamed)
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp
(LHsExpr (GhcPass 'Renamed)
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp (IdP (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsVar IdP (GhcPass 'Renamed)
Name
runPromptIOName) LHsExpr (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
srcLocStringExpr)
(LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed))
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall a b. (a -> b) -> a -> b
$ Maybe Name -> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
captureVarsExpr Maybe Name
forall a. Maybe a
Nothing
queryVarsExpr :: IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
queryVarsExpr = do
Name
resultName <- OccName -> TcRnIf TcGblEnv TcLclEnv Name
Ghc.newName (NameSpace -> String -> OccName
Ghc.mkOccName NameSpace
Ghc.varName String
"_result_")
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall a b. (a -> b) -> a -> b
$
[LPat (GhcPass 'Renamed)]
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (p :: Pass).
(IsPass p, XMG (GhcPass p) (LHsExpr (GhcPass p)) ~ Origin) =>
[LPat (GhcPass p)] -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.mkHsLam [IdP (GhcPass 'Renamed) -> LPat (GhcPass 'Renamed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LPat (GhcPass p)
Ghc.nlVarPat IdP (GhcPass 'Renamed)
Name
resultName] (LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed))
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall a b. (a -> b) -> a -> b
$
LHsExpr (GhcPass 'Renamed)
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp
(LHsExpr (GhcPass 'Renamed)
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp
(LHsExpr (GhcPass 'Renamed)
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp (IdP (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsVar IdP (GhcPass 'Renamed)
Name
runPromptName) LHsExpr (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
srcLocStringExpr)
(Maybe Name -> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
captureVarsExpr (Maybe Name -> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> Maybe Name -> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ Name -> Maybe Name
forall a. a -> Maybe a
Just Name
resultName)
)
(IdP (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsVar IdP (GhcPass 'Renamed)
Name
resultName)
queryVarsMExpr :: LHsExpr (GhcPass 'Renamed)
queryVarsMExpr =
LHsExpr (GhcPass 'Renamed)
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp
(LHsExpr (GhcPass 'Renamed)
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp (IdP (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsVar IdP (GhcPass 'Renamed)
Name
runPromptMName) LHsExpr (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
srcLocStringExpr)
(LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed))
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall a b. (a -> b) -> a -> b
$ Maybe Name -> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
captureVarsExpr Maybe Name
forall a. Maybe a
Nothing
if | Name
captureVarsName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name -> do
Any -> WriterT Any (ReaderT Env TcM) ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell (Any -> WriterT Any (ReaderT Env TcM) ())
-> Any -> WriterT Any (ReaderT Env TcM) ()
forall a b. (a -> b) -> a -> b
$ Bool -> Any
Any Bool
True
Maybe (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed))
forall a. a -> Maybe a
Just (HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed)))
-> (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> HsExpr (GhcPass 'Renamed))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> Maybe (HsExpr (GhcPass 'Renamed))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> HsExpr (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
Ghc.unLoc (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> Maybe (HsExpr (GhcPass 'Renamed)))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> Maybe (HsExpr (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ Maybe Name -> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
captureVarsExpr Maybe Name
forall a. Maybe a
Nothing)
| Name
breakpointName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name -> do
Any -> WriterT Any (ReaderT Env TcM) ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell (Any -> WriterT Any (ReaderT Env TcM) ())
-> Any -> WriterT Any (ReaderT Env TcM) ()
forall a b. (a -> b) -> a -> b
$ Bool -> Any
Any Bool
True
HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed))
forall a. a -> Maybe a
Just (HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed)))
-> (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> HsExpr (GhcPass 'Renamed))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> Maybe (HsExpr (GhcPass 'Renamed))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> HsExpr (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
Ghc.unLoc (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> Maybe (HsExpr (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env TcM)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
Env TcM (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env TcM)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall (m :: * -> *) a. Monad m => m a -> WriterT Any m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> ReaderT
Env TcM (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall (m :: * -> *) a. Monad m => m a -> ReaderT Env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
bpExpr)
| Name
breakpointMName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name -> do
Any -> WriterT Any (ReaderT Env TcM) ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell (Any -> WriterT Any (ReaderT Env TcM) ())
-> Any -> WriterT Any (ReaderT Env TcM) ()
forall a b. (a -> b) -> a -> b
$ Bool -> Any
Any Bool
True
Maybe (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed))
forall a. a -> Maybe a
Just (HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed)))
-> HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> HsExpr (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
Ghc.unLoc LHsExpr (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
bpMExpr)
| Name
breakpointIOName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name -> do
Any -> WriterT Any (ReaderT Env TcM) ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell (Any -> WriterT Any (ReaderT Env TcM) ())
-> Any -> WriterT Any (ReaderT Env TcM) ()
forall a b. (a -> b) -> a -> b
$ Bool -> Any
Any Bool
True
Maybe (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed))
forall a. a -> Maybe a
Just (HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed)))
-> HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> HsExpr (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
Ghc.unLoc LHsExpr (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
bpIOExpr)
| Name
queryVarsIOName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name -> do
Any -> WriterT Any (ReaderT Env TcM) ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell (Any -> WriterT Any (ReaderT Env TcM) ())
-> Any -> WriterT Any (ReaderT Env TcM) ()
forall a b. (a -> b) -> a -> b
$ Bool -> Any
Any Bool
True
Maybe (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed))
forall a. a -> Maybe a
Just (HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed)))
-> HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> HsExpr (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
Ghc.unLoc LHsExpr (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
queryVarsIOExpr)
| Name
queryVarsName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name -> do
Any -> WriterT Any (ReaderT Env TcM) ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell (Any -> WriterT Any (ReaderT Env TcM) ())
-> Any -> WriterT Any (ReaderT Env TcM) ()
forall a b. (a -> b) -> a -> b
$ Bool -> Any
Any Bool
True
HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed))
forall a. a -> Maybe a
Just (HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed)))
-> (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> HsExpr (GhcPass 'Renamed))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> Maybe (HsExpr (GhcPass 'Renamed))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> HsExpr (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
Ghc.unLoc (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> Maybe (HsExpr (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env TcM)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
Env TcM (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env TcM)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall (m :: * -> *) a. Monad m => m a -> WriterT Any m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> ReaderT
Env TcM (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall (m :: * -> *) a. Monad m => m a -> ReaderT Env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
queryVarsExpr)
| Name
queryVarsMName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name -> do
Any -> WriterT Any (ReaderT Env TcM) ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell (Any -> WriterT Any (ReaderT Env TcM) ())
-> Any -> WriterT Any (ReaderT Env TcM) ()
forall a b. (a -> b) -> a -> b
$ Bool -> Any
Any Bool
True
Maybe (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed))
forall a. a -> Maybe a
Just (HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed)))
-> HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> HsExpr (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
Ghc.unLoc LHsExpr (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
queryVarsMExpr)
| Name
getSrcLocName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name ->
Maybe (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed))
forall a. a -> Maybe a
Just (HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed)))
-> HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> HsExpr (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
Ghc.unLoc GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
srcLocStringExpr)
| Bool
otherwise -> Maybe (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (HsExpr (GhcPass 'Renamed))
forall a. Maybe a
Nothing
hsVarCase HsExpr (GhcPass 'Renamed)
_ = Maybe (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (HsExpr (GhcPass 'Renamed))
forall a. Maybe a
Nothing
hsAppCase :: Ghc.LHsExpr Ghc.GhcRn
-> EnvReader (Maybe (Ghc.LHsExpr Ghc.GhcRn))
hsAppCase :: LHsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (LHsExpr (GhcPass 'Renamed)))
hsAppCase (LHsExpr (GhcPass 'Renamed) -> HsExpr (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> HsExpr (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
Ghc.unLoc -> Ghc.HsApp XApp (GhcPass 'Renamed)
_ LHsExpr (GhcPass 'Renamed)
f LHsExpr (GhcPass 'Renamed)
innerExpr)
| Ghc.HsApp XApp (GhcPass 'Renamed)
_ (LHsExpr (GhcPass 'Renamed) -> HsExpr (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> HsExpr (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
Ghc.unLoc -> Ghc.HsVar XVar (GhcPass 'Renamed)
_ (LIdP (GhcPass 'Renamed) -> Name
GenLocated SrcSpanAnnN Name -> Name
forall l e. GenLocated l e -> e
Ghc.unLoc -> Name
name))
(LHsExpr (GhcPass 'Renamed) -> HsExpr (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> HsExpr (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
Ghc.unLoc -> Ghc.ExplicitList' XExplicitList (GhcPass 'Renamed)
_ [LHsExpr (GhcPass 'Renamed)]
exprsToExclude)
<- GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> HsExpr (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
Ghc.unLoc LHsExpr (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
f
= do
MkEnv{VarSet
Name
varSet :: Env -> VarSet
captureVarsName :: Env -> Name
showLevName :: Env -> Name
fromListName :: Env -> Name
breakpointName :: Env -> Name
queryVarsName :: Env -> Name
breakpointMName :: Env -> Name
queryVarsMName :: Env -> Name
breakpointIOName :: Env -> Name
queryVarsIOName :: Env -> Name
printAndWaitName :: Env -> Name
printAndWaitMName :: Env -> Name
printAndWaitIOName :: Env -> Name
runPromptIOName :: Env -> Name
runPromptName :: Env -> Name
runPromptMName :: Env -> Name
getSrcLocName :: Env -> Name
excludeVarsName :: Env -> Name
varSet :: VarSet
captureVarsName :: Name
showLevName :: Name
fromListName :: Name
breakpointName :: Name
queryVarsName :: Name
breakpointMName :: Name
queryVarsMName :: Name
breakpointIOName :: Name
queryVarsIOName :: Name
printAndWaitName :: Name
printAndWaitMName :: Name
printAndWaitIOName :: Name
runPromptIOName :: Name
runPromptName :: Name
runPromptMName :: Name
getSrcLocName :: Name
excludeVarsName :: Name
..} <- ReaderT Env TcM Env -> WriterT Any (ReaderT Env TcM) Env
forall (m :: * -> *) a. Monad m => m a -> WriterT Any m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT Env TcM Env
forall r (m :: * -> *). MonadReader r m => m r
ask
if Name
excludeVarsName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= Name
name
then Maybe (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader
(Maybe (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall a. Maybe a
Nothing
else do
let extractVarName :: HsExpr (GhcPass 'Renamed) -> Maybe LexicalFastString
extractVarName (Ghc.HsLit XLitE (GhcPass 'Renamed)
_ (Ghc.HsString XHsString (GhcPass 'Renamed)
_ FastString
fs)) =
LexicalFastString -> Maybe LexicalFastString
forall a. a -> Maybe a
Just (LexicalFastString -> Maybe LexicalFastString)
-> LexicalFastString -> Maybe LexicalFastString
forall a b. (a -> b) -> a -> b
$ FastString -> LexicalFastString
Ghc.mkLexicalFastString FastString
fs
extractVarName (Ghc.HsOverLit XOverLitE (GhcPass 'Renamed)
_ (Ghc.OverLit' (Ghc.HsIsString SourceText
_ FastString
fs))) =
LexicalFastString -> Maybe LexicalFastString
forall a. a -> Maybe a
Just (LexicalFastString -> Maybe LexicalFastString)
-> LexicalFastString -> Maybe LexicalFastString
forall a b. (a -> b) -> a -> b
$ FastString -> LexicalFastString
Ghc.mkLexicalFastString FastString
fs
extractVarName HsExpr (GhcPass 'Renamed)
_ = Maybe LexicalFastString
forall a. Maybe a
Nothing
varsToExclude :: [LexicalFastString]
varsToExclude =
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> Maybe LexicalFastString)
-> [GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))]
-> [LexicalFastString]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (HsExpr (GhcPass 'Renamed) -> Maybe LexicalFastString
extractVarName (HsExpr (GhcPass 'Renamed) -> Maybe LexicalFastString)
-> (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> HsExpr (GhcPass 'Renamed))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> Maybe LexicalFastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> HsExpr (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
Ghc.unLoc) [LHsExpr (GhcPass 'Renamed)]
[GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))]
exprsToExclude
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> Maybe (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall a. a -> Maybe a
Just (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> Maybe (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> WriterT
Any
(ReaderT Env TcM)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader
(Maybe (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(ReaderT
Env TcM (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)), Any)
-> ReaderT
Env TcM (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)), Any))
-> WriterT
Any
(ReaderT Env TcM)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env TcM)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall (n :: * -> *) w w' (m :: * -> *) a b.
(Monad n, Monoid w, Monoid w') =>
(m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
mapWriterT
((Env -> Env)
-> ReaderT
Env TcM (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)), Any)
-> ReaderT
Env TcM (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)), Any)
forall a. (Env -> Env) -> ReaderT Env TcM a -> ReaderT Env TcM a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ((VarSet -> VarSet) -> Env -> Env
overVarSet ((VarSet -> VarSet) -> Env -> Env)
-> (VarSet -> VarSet) -> Env -> Env
forall a b. (a -> b) -> a -> b
$ \VarSet
vs -> (LexicalFastString -> VarSet -> VarSet)
-> VarSet -> [LexicalFastString] -> VarSet
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr LexicalFastString -> VarSet -> VarSet
forall k a. Ord k => k -> Map k a -> Map k a
M.delete VarSet
vs [LexicalFastString]
varsToExclude))
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> WriterT
Any
(ReaderT Env TcM)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall a. Data a => a -> EnvReader a
recurse LHsExpr (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
innerExpr)
hsAppCase LHsExpr (GhcPass 'Renamed)
_ = Maybe (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader
(Maybe (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall a. Maybe a
Nothing
matchCase :: Ghc.Match Ghc.GhcRn (Ghc.LHsExpr Ghc.GhcRn)
-> EnvReader (Maybe (Ghc.Match Ghc.GhcRn (Ghc.LHsExpr Ghc.GhcRn)))
matchCase :: Match (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
-> EnvReader
(Maybe (Match (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))))
matchCase Ghc.Match {[LPat (GhcPass 'Renamed)]
XCMatch (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
HsMatchContext (GhcPass 'Renamed)
m_ext :: XCMatch (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
m_ctxt :: HsMatchContext (GhcPass 'Renamed)
m_pats :: [LPat (GhcPass 'Renamed)]
m_grhss :: GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
m_ext :: forall p body. Match p body -> XCMatch p body
m_ctxt :: forall p body. Match p body -> HsMatchContext p
m_pats :: forall p body. Match p body -> [LPat p]
m_grhss :: forall p body. Match p body -> GRHSs p body
..} = do
let names :: VarSet
names = (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)) -> VarSet)
-> [GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))] -> VarSet
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap LPat (GhcPass 'Renamed) -> VarSet
GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)) -> VarSet
extractVarPats [LPat (GhcPass 'Renamed)]
[GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))]
m_pats
GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
grhRes <- VarSet
-> EnvReader
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> EnvReader
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
forall a. VarSet -> EnvReader a -> EnvReader a
addScopedVars VarSet
names (EnvReader
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> EnvReader
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
-> EnvReader
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> EnvReader
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
forall a b. (a -> b) -> a -> b
$ GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
forall a. Data a => a -> EnvReader a
recurse GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
m_grhss
Maybe
(Match
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> EnvReader
(Maybe
(Match
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe
(Match
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> EnvReader
(Maybe
(Match
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))))
-> Maybe
(Match
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> EnvReader
(Maybe
(Match
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
forall a b. (a -> b) -> a -> b
$ Match
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> Maybe
(Match
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
forall a. a -> Maybe a
Just
Ghc.Match { m_grhss :: GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
Ghc.m_grhss = GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
grhRes, [LPat (GhcPass 'Renamed)]
XCMatch (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
XCMatch
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
HsMatchContext (GhcPass 'Renamed)
m_ext :: XCMatch (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
m_ctxt :: HsMatchContext (GhcPass 'Renamed)
m_pats :: [LPat (GhcPass 'Renamed)]
m_ext :: XCMatch
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
m_ctxt :: HsMatchContext (GhcPass 'Renamed)
m_pats :: [LPat (GhcPass 'Renamed)]
.. }
extractVarPats :: Ghc.LPat Ghc.GhcRn -> VarSet
= [Name] -> VarSet
mkVarSet ([Name] -> VarSet)
-> (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)) -> [Name])
-> GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
-> VarSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LPat (GhcPass 'Renamed) -> [Name]
GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)) -> [Name]
Ghc.collectPatBinders'
grhssCase :: Ghc.GRHSs Ghc.GhcRn (Ghc.LHsExpr Ghc.GhcRn)
-> EnvReader (Maybe (Ghc.GRHSs Ghc.GhcRn (Ghc.LHsExpr Ghc.GhcRn)))
grhssCase :: GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
-> EnvReader
(Maybe (GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))))
grhssCase Ghc.GRHSs {[LGRHS (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))]
XCGRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
HsLocalBinds (GhcPass 'Renamed)
grhssExt :: XCGRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
grhssGRHSs :: [LGRHS (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))]
grhssLocalBinds :: HsLocalBinds (GhcPass 'Renamed)
grhssExt :: forall p body. GRHSs p body -> XCGRHSs p body
grhssGRHSs :: forall p body. GRHSs p body -> [LGRHS p body]
grhssLocalBinds :: forall p body. GRHSs p body -> HsLocalBinds p
..} = do
(HsLocalBinds (GhcPass 'Renamed)
localBindsRes, VarSet
names)
<- HsLocalBinds (GhcPass 'Renamed)
-> EnvReader (HsLocalBinds (GhcPass 'Renamed), VarSet)
dealWithLocalBinds
HsLocalBinds (GhcPass 'Renamed)
grhssLocalBinds
[GenLocated
(SrcAnn NoEpAnns)
(GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
grhsRes <- VarSet
-> EnvReader
[GenLocated
(SrcAnn NoEpAnns)
(GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> EnvReader
[GenLocated
(SrcAnn NoEpAnns)
(GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
forall a. VarSet -> EnvReader a -> EnvReader a
addScopedVars VarSet
names (EnvReader
[GenLocated
(SrcAnn NoEpAnns)
(GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> EnvReader
[GenLocated
(SrcAnn NoEpAnns)
(GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))])
-> EnvReader
[GenLocated
(SrcAnn NoEpAnns)
(GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> EnvReader
[GenLocated
(SrcAnn NoEpAnns)
(GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
forall a b. (a -> b) -> a -> b
$ [GenLocated
(SrcAnn NoEpAnns)
(GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> EnvReader
[GenLocated
(SrcAnn NoEpAnns)
(GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
forall a. Data a => a -> EnvReader a
recurse [LGRHS (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))]
[GenLocated
(SrcAnn NoEpAnns)
(GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
grhssGRHSs
Maybe
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> EnvReader
(Maybe
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> EnvReader
(Maybe
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))))
-> Maybe
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> EnvReader
(Maybe
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
forall a b. (a -> b) -> a -> b
$ GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> Maybe
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
forall a. a -> Maybe a
Just
Ghc.GRHSs { grhssGRHSs :: [LGRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))]
Ghc.grhssGRHSs = [LGRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))]
[GenLocated
(SrcAnn NoEpAnns)
(GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
grhsRes
, grhssLocalBinds :: HsLocalBinds (GhcPass 'Renamed)
grhssLocalBinds = HsLocalBinds (GhcPass 'Renamed)
localBindsRes
, XCGRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
XCGRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
grhssExt :: XCGRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
grhssExt :: XCGRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
..
}
dealWithBind :: VarSet
-> Ghc.LHsBind Ghc.GhcRn
-> EnvReader (Ghc.LHsBind Ghc.GhcRn)
dealWithBind :: VarSet
-> LHsBind (GhcPass 'Renamed)
-> EnvReader (LHsBind (GhcPass 'Renamed))
dealWithBind VarSet
resultNames LHsBind (GhcPass 'Renamed)
lbind = GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
-> (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
-> WriterT
Any
(ReaderT Env TcM)
(HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env TcM)
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for LHsBind (GhcPass 'Renamed)
GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
lbind ((HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
-> WriterT
Any
(ReaderT Env TcM)
(HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env TcM)
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))))
-> (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
-> WriterT
Any
(ReaderT Env TcM)
(HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env TcM)
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
forall a b. (a -> b) -> a -> b
$ \case
Ghc.FunBind {XFunBind (GhcPass 'Renamed) (GhcPass 'Renamed)
LIdP (GhcPass 'Renamed)
MatchGroup (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
fun_ext :: XFunBind (GhcPass 'Renamed) (GhcPass 'Renamed)
fun_id :: LIdP (GhcPass 'Renamed)
fun_matches :: MatchGroup (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
fun_ext :: forall idL idR. HsBindLR idL idR -> XFunBind idL idR
fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
..} -> do
let resultNamesSansSelf :: VarSet
resultNamesSansSelf =
LexicalFastString -> VarSet -> VarSet
forall k a. Ord k => k -> Map k a -> Map k a
M.delete (Name -> LexicalFastString
getOccNameFS (Name -> LexicalFastString) -> Name -> LexicalFastString
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnN Name -> Name
forall l e. GenLocated l e -> e
Ghc.unLoc LIdP (GhcPass 'Renamed)
GenLocated SrcSpanAnnN Name
fun_id) VarSet
resultNames
(MatchGroup
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
matchesRes, Any Bool
containsTarget)
<- WriterT
Any
(ReaderT Env TcM)
(MatchGroup
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> WriterT
Any
(ReaderT Env TcM)
(MatchGroup
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))),
Any)
forall w (m :: * -> *) a.
(Monoid w, Monad m) =>
WriterT w m a -> WriterT w m (a, w)
listen
(WriterT
Any
(ReaderT Env TcM)
(MatchGroup
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> WriterT
Any
(ReaderT Env TcM)
(MatchGroup
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))),
Any))
-> (WriterT
Any
(ReaderT Env TcM)
(MatchGroup
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> WriterT
Any
(ReaderT Env TcM)
(MatchGroup
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
-> WriterT
Any
(ReaderT Env TcM)
(MatchGroup
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> WriterT
Any
(ReaderT Env TcM)
(MatchGroup
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))),
Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarSet
-> WriterT
Any
(ReaderT Env TcM)
(MatchGroup
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> WriterT
Any
(ReaderT Env TcM)
(MatchGroup
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
forall a. VarSet -> EnvReader a -> EnvReader a
addScopedVars VarSet
resultNamesSansSelf
(WriterT
Any
(ReaderT Env TcM)
(MatchGroup
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> WriterT
Any
(ReaderT Env TcM)
(MatchGroup
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))),
Any))
-> WriterT
Any
(ReaderT Env TcM)
(MatchGroup
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> WriterT
Any
(ReaderT Env TcM)
(MatchGroup
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))),
Any)
forall a b. (a -> b) -> a -> b
$ MatchGroup
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env TcM)
(MatchGroup
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
forall a. Data a => a -> EnvReader a
recurse MatchGroup (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
MatchGroup
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
fun_matches
let rhsVars :: UniqSet Name
rhsVars
| Bool
containsTarget
= [Name] -> UniqSet Name
forall a. Uniquable a => [a] -> UniqSet a
Ghc.mkUniqSet ([Name] -> UniqSet Name)
-> ([Name] -> [Name]) -> [Name] -> UniqSet Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarSet -> [Name]
forall k a. Map k a -> [a]
M.elems
(VarSet -> [Name]) -> ([Name] -> VarSet) -> [Name] -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VarSet -> VarSet -> VarSet
forall a. Semigroup a => a -> a -> a
<> VarSet
resultNamesSansSelf) (VarSet -> VarSet) -> ([Name] -> VarSet) -> [Name] -> VarSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Name] -> VarSet
mkVarSet
([Name] -> UniqSet Name) -> [Name] -> UniqSet Name
forall a b. (a -> b) -> a -> b
$ UniqSet Name -> [Name]
forall elt. UniqSet elt -> [elt]
Ghc.nonDetEltsUniqSet XFunBind (GhcPass 'Renamed) (GhcPass 'Renamed)
UniqSet Name
fun_ext
| Bool
otherwise = XFunBind (GhcPass 'Renamed) (GhcPass 'Renamed)
UniqSet Name
fun_ext
HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
-> WriterT
Any
(ReaderT Env TcM)
(HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ghc.FunBind { fun_matches :: MatchGroup (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
Ghc.fun_matches = MatchGroup (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
MatchGroup
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
matchesRes, fun_ext :: XFunBind (GhcPass 'Renamed) (GhcPass 'Renamed)
Ghc.fun_ext = XFunBind (GhcPass 'Renamed) (GhcPass 'Renamed)
UniqSet Name
rhsVars, LIdP (GhcPass 'Renamed)
fun_id :: LIdP (GhcPass 'Renamed)
fun_id :: LIdP (GhcPass 'Renamed)
.. }
Ghc.PatBind {XPatBind (GhcPass 'Renamed) (GhcPass 'Renamed)
LPat (GhcPass 'Renamed)
GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
pat_ext :: XPatBind (GhcPass 'Renamed) (GhcPass 'Renamed)
pat_lhs :: LPat (GhcPass 'Renamed)
pat_rhs :: GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
pat_ext :: forall idL idR. HsBindLR idL idR -> XPatBind idL idR
pat_lhs :: forall idL idR. HsBindLR idL idR -> LPat idL
pat_rhs :: forall idL idR. HsBindLR idL idR -> GRHSs idR (LHsExpr idR)
..} -> do
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
rhsRes, Any Bool
containsTarget)
<- EnvReader
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> WriterT
Any
(ReaderT Env TcM)
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))),
Any)
forall w (m :: * -> *) a.
(Monoid w, Monad m) =>
WriterT w m a -> WriterT w m (a, w)
listen
(EnvReader
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> WriterT
Any
(ReaderT Env TcM)
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))),
Any))
-> (EnvReader
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> EnvReader
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
-> EnvReader
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> WriterT
Any
(ReaderT Env TcM)
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))),
Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarSet
-> EnvReader
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> EnvReader
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
forall a. VarSet -> EnvReader a -> EnvReader a
addScopedVars VarSet
resultNames
(EnvReader
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> WriterT
Any
(ReaderT Env TcM)
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))),
Any))
-> EnvReader
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> WriterT
Any
(ReaderT Env TcM)
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))),
Any)
forall a b. (a -> b) -> a -> b
$ GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
forall a. Data a => a -> EnvReader a
recurse GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
pat_rhs
let rhsVars :: UniqSet Name
rhsVars
| Bool
containsTarget
= [Name] -> UniqSet Name
forall a. Uniquable a => [a] -> UniqSet a
Ghc.mkUniqSet ([Name] -> UniqSet Name)
-> ([Name] -> [Name]) -> [Name] -> UniqSet Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarSet -> [Name]
forall k a. Map k a -> [a]
M.elems
(VarSet -> [Name]) -> ([Name] -> VarSet) -> [Name] -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VarSet -> VarSet -> VarSet
forall a. Semigroup a => a -> a -> a
<> VarSet
resultNames) (VarSet -> VarSet) -> ([Name] -> VarSet) -> [Name] -> VarSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Name] -> VarSet
mkVarSet
([Name] -> UniqSet Name) -> [Name] -> UniqSet Name
forall a b. (a -> b) -> a -> b
$ UniqSet Name -> [Name]
forall elt. UniqSet elt -> [elt]
Ghc.nonDetEltsUniqSet XPatBind (GhcPass 'Renamed) (GhcPass 'Renamed)
UniqSet Name
pat_ext
| Bool
otherwise = XPatBind (GhcPass 'Renamed) (GhcPass 'Renamed)
UniqSet Name
pat_ext
HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
-> WriterT
Any
(ReaderT Env TcM)
(HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ghc.PatBind { pat_rhs :: GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
Ghc.pat_rhs = GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
rhsRes, pat_ext :: XPatBind (GhcPass 'Renamed) (GhcPass 'Renamed)
pat_ext = XPatBind (GhcPass 'Renamed) (GhcPass 'Renamed)
UniqSet Name
rhsVars, LPat (GhcPass 'Renamed)
pat_lhs :: LPat (GhcPass 'Renamed)
pat_lhs :: LPat (GhcPass 'Renamed)
.. }
Ghc.VarBind {XVarBind (GhcPass 'Renamed) (GhcPass 'Renamed)
IdP (GhcPass 'Renamed)
LHsExpr (GhcPass 'Renamed)
var_ext :: XVarBind (GhcPass 'Renamed) (GhcPass 'Renamed)
var_id :: IdP (GhcPass 'Renamed)
var_rhs :: LHsExpr (GhcPass 'Renamed)
var_ext :: forall idL idR. HsBindLR idL idR -> XVarBind idL idR
var_id :: forall idL idR. HsBindLR idL idR -> IdP idL
var_rhs :: forall idL idR. HsBindLR idL idR -> LHsExpr idR
..} -> do
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
rhsRes
<- VarSet
-> WriterT
Any
(ReaderT Env TcM)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env TcM)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall a. VarSet -> EnvReader a -> EnvReader a
addScopedVars VarSet
resultNames
(WriterT
Any
(ReaderT Env TcM)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env TcM)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> WriterT
Any
(ReaderT Env TcM)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env TcM)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> WriterT
Any
(ReaderT Env TcM)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall a. Data a => a -> EnvReader a
recurse LHsExpr (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
var_rhs
HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
-> WriterT
Any
(ReaderT Env TcM)
(HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ghc.VarBind { var_rhs :: LHsExpr (GhcPass 'Renamed)
Ghc.var_rhs = LHsExpr (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
rhsRes, XVarBind (GhcPass 'Renamed) (GhcPass 'Renamed)
IdP (GhcPass 'Renamed)
var_ext :: XVarBind (GhcPass 'Renamed) (GhcPass 'Renamed)
var_id :: IdP (GhcPass 'Renamed)
var_ext :: XVarBind (GhcPass 'Renamed) (GhcPass 'Renamed)
var_id :: IdP (GhcPass 'Renamed)
.. }
Ghc.PatSynBind XPatSynBind (GhcPass 'Renamed) (GhcPass 'Renamed)
x Ghc.PSB {XPSB (GhcPass 'Renamed) (GhcPass 'Renamed)
LIdP (GhcPass 'Renamed)
LPat (GhcPass 'Renamed)
HsPatSynDetails (GhcPass 'Renamed)
HsPatSynDir (GhcPass 'Renamed)
psb_ext :: XPSB (GhcPass 'Renamed) (GhcPass 'Renamed)
psb_id :: LIdP (GhcPass 'Renamed)
psb_args :: HsPatSynDetails (GhcPass 'Renamed)
psb_def :: LPat (GhcPass 'Renamed)
psb_dir :: HsPatSynDir (GhcPass 'Renamed)
psb_ext :: forall idL idR. PatSynBind idL idR -> XPSB idL idR
psb_id :: forall idL idR. PatSynBind idL idR -> LIdP idL
psb_args :: forall idL idR. PatSynBind idL idR -> HsPatSynDetails idR
psb_def :: forall idL idR. PatSynBind idL idR -> LPat idR
psb_dir :: forall idL idR. PatSynBind idL idR -> HsPatSynDir idR
..} -> do
(GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
defRes, Any Bool
containsTarget)
<- WriterT
Any
(ReaderT Env TcM)
(GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env TcM)
(GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)), Any)
forall w (m :: * -> *) a.
(Monoid w, Monad m) =>
WriterT w m a -> WriterT w m (a, w)
listen
(WriterT
Any
(ReaderT Env TcM)
(GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env TcM)
(GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)), Any))
-> (WriterT
Any
(ReaderT Env TcM)
(GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env TcM)
(GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))))
-> WriterT
Any
(ReaderT Env TcM)
(GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env TcM)
(GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)), Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarSet
-> WriterT
Any
(ReaderT Env TcM)
(GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env TcM)
(GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
forall a. VarSet -> EnvReader a -> EnvReader a
addScopedVars VarSet
resultNames
(WriterT
Any
(ReaderT Env TcM)
(GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env TcM)
(GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)), Any))
-> WriterT
Any
(ReaderT Env TcM)
(GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env TcM)
(GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)), Any)
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
-> WriterT
Any
(ReaderT Env TcM)
(GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
forall a. Data a => a -> EnvReader a
recurse LPat (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
psb_def
let rhsVars :: UniqSet Name
rhsVars
| Bool
containsTarget
= [Name] -> UniqSet Name
forall a. Uniquable a => [a] -> UniqSet a
Ghc.mkUniqSet ([Name] -> UniqSet Name)
-> ([Name] -> [Name]) -> [Name] -> UniqSet Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarSet -> [Name]
forall k a. Map k a -> [a]
M.elems
(VarSet -> [Name]) -> ([Name] -> VarSet) -> [Name] -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VarSet -> VarSet -> VarSet
forall a. Semigroup a => a -> a -> a
<> VarSet
resultNames) (VarSet -> VarSet) -> ([Name] -> VarSet) -> [Name] -> VarSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Name] -> VarSet
mkVarSet
([Name] -> UniqSet Name) -> [Name] -> UniqSet Name
forall a b. (a -> b) -> a -> b
$ UniqSet Name -> [Name]
forall elt. UniqSet elt -> [elt]
Ghc.nonDetEltsUniqSet XPSB (GhcPass 'Renamed) (GhcPass 'Renamed)
UniqSet Name
psb_ext
| Bool
otherwise = XPSB (GhcPass 'Renamed) (GhcPass 'Renamed)
UniqSet Name
psb_ext
HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
-> WriterT
Any
(ReaderT Env TcM)
(HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
-> WriterT
Any
(ReaderT Env TcM)
(HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
-> HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
-> WriterT
Any
(ReaderT Env TcM)
(HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ XPatSynBind (GhcPass 'Renamed) (GhcPass 'Renamed)
-> PatSynBind (GhcPass 'Renamed) (GhcPass 'Renamed)
-> HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
forall idL idR.
XPatSynBind idL idR -> PatSynBind idL idR -> HsBindLR idL idR
Ghc.PatSynBind XPatSynBind (GhcPass 'Renamed) (GhcPass 'Renamed)
x Ghc.PSB { psb_def :: LPat (GhcPass 'Renamed)
psb_def = LPat (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
defRes, psb_ext :: XPSB (GhcPass 'Renamed) (GhcPass 'Renamed)
psb_ext = XPSB (GhcPass 'Renamed) (GhcPass 'Renamed)
UniqSet Name
rhsVars, LIdP (GhcPass 'Renamed)
HsPatSynDetails (GhcPass 'Renamed)
HsPatSynDir (GhcPass 'Renamed)
psb_id :: LIdP (GhcPass 'Renamed)
psb_args :: HsPatSynDetails (GhcPass 'Renamed)
psb_dir :: HsPatSynDir (GhcPass 'Renamed)
psb_id :: LIdP (GhcPass 'Renamed)
psb_args :: HsPatSynDetails (GhcPass 'Renamed)
psb_dir :: HsPatSynDir (GhcPass 'Renamed)
.. }
#if !MIN_VERSION_ghc(9,4,0)
other -> pure other
#endif
grhsCase :: Ghc.GRHS Ghc.GhcRn (Ghc.LHsExpr Ghc.GhcRn)
-> EnvReader (Maybe (Ghc.GRHS Ghc.GhcRn (Ghc.LHsExpr Ghc.GhcRn)))
grhsCase :: GRHS (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
-> EnvReader
(Maybe (GRHS (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))))
grhsCase (Ghc.GRHS XCGRHS (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
x [GuardLStmt (GhcPass 'Renamed)]
guards LHsExpr (GhcPass 'Renamed)
body) = do
([GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
guardsRes, VarSet
names) <- WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> WriterT
Any
(ReaderT Env TcM)
([GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
VarSet)
forall w (m :: * -> *) a. Monoid w => WriterT w m a -> m (a, w)
runWriterT (WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> WriterT
Any
(ReaderT Env TcM)
([GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
VarSet))
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> WriterT
Any
(ReaderT Env TcM)
([GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
VarSet)
forall a b. (a -> b) -> a -> b
$ [LStmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))]
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
[LStmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))]
forall body.
(Data body, Data (Stmt (GhcPass 'Renamed) body)) =>
[LStmt (GhcPass 'Renamed) body]
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
[LStmt (GhcPass 'Renamed) body]
dealWithStatements [GuardLStmt (GhcPass 'Renamed)]
[LStmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))]
guards
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
bodyRes <- VarSet
-> WriterT
Any
(ReaderT Env TcM)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env TcM)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall a. VarSet -> EnvReader a -> EnvReader a
addScopedVars VarSet
names (WriterT
Any
(ReaderT Env TcM)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env TcM)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> WriterT
Any
(ReaderT Env TcM)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env TcM)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> WriterT
Any
(ReaderT Env TcM)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall a. Data a => a -> EnvReader a
recurse LHsExpr (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
body
Maybe
(GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> EnvReader
(Maybe
(GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe
(GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> EnvReader
(Maybe
(GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))))
-> (GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> Maybe
(GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
-> GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader
(Maybe
(GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> Maybe
(GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
forall a. a -> Maybe a
Just (GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader
(Maybe
(GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))))
-> GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader
(Maybe
(GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
forall a b. (a -> b) -> a -> b
$ XCGRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> [GuardLStmt (GhcPass 'Renamed)]
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
Ghc.GRHS XCGRHS (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
XCGRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
x [GuardLStmt (GhcPass 'Renamed)]
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
guardsRes GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
bodyRes
hsLetCase :: Ghc.HsExpr Ghc.GhcRn
-> EnvReader (Maybe (Ghc.HsExpr Ghc.GhcRn))
hsLetCase :: HsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
hsLetCase (Ghc.HsLet' XLet (GhcPass 'Renamed)
x LetToken
letToken (Ghc.L SrcSpan
loc HsLocalBinds (GhcPass 'Renamed)
localBinds) InToken
inToken LHsExpr (GhcPass 'Renamed)
inExpr) = do
(HsLocalBinds (GhcPass 'Renamed)
bindsRes, VarSet
names) <- HsLocalBinds (GhcPass 'Renamed)
-> EnvReader (HsLocalBinds (GhcPass 'Renamed), VarSet)
dealWithLocalBinds HsLocalBinds (GhcPass 'Renamed)
localBinds
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
inExprRes <- VarSet
-> WriterT
Any
(ReaderT Env TcM)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env TcM)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall a. VarSet -> EnvReader a -> EnvReader a
addScopedVars VarSet
names (WriterT
Any
(ReaderT Env TcM)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env TcM)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> WriterT
Any
(ReaderT Env TcM)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env TcM)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> WriterT
Any
(ReaderT Env TcM)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall a. Data a => a -> EnvReader a
recurse LHsExpr (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
inExpr
Maybe (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed))))
-> (HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed)))
-> HsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed))
forall a. a -> Maybe a
Just (HsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed))))
-> HsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall a b. (a -> b) -> a -> b
$
XLet (GhcPass 'Renamed)
-> LetToken
-> GenLocated SrcSpan (HsLocalBinds (GhcPass 'Renamed))
-> InToken
-> LHsExpr (GhcPass 'Renamed)
-> HsExpr (GhcPass 'Renamed)
Ghc.HsLet' XLet (GhcPass 'Renamed)
x LetToken
letToken (SrcSpan
-> HsLocalBinds (GhcPass 'Renamed)
-> GenLocated SrcSpan (HsLocalBinds (GhcPass 'Renamed))
forall l e. l -> e -> GenLocated l e
Ghc.L SrcSpan
loc HsLocalBinds (GhcPass 'Renamed)
bindsRes) InToken
inToken LHsExpr (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
inExprRes
hsLetCase HsExpr (GhcPass 'Renamed)
_ = Maybe (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (HsExpr (GhcPass 'Renamed))
forall a. Maybe a
Nothing
dealWithLocalBinds
:: Ghc.HsLocalBinds Ghc.GhcRn
-> EnvReader (Ghc.HsLocalBinds Ghc.GhcRn, VarSet)
dealWithLocalBinds :: HsLocalBinds (GhcPass 'Renamed)
-> EnvReader (HsLocalBinds (GhcPass 'Renamed), VarSet)
dealWithLocalBinds = \case
hlb :: HsLocalBinds (GhcPass 'Renamed)
hlb@(Ghc.HsValBinds XHsValBinds (GhcPass 'Renamed) (GhcPass 'Renamed)
x HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
valBinds) -> case HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
valBinds of
Ghc.ValBinds{} -> (HsLocalBinds (GhcPass 'Renamed), VarSet)
-> EnvReader (HsLocalBinds (GhcPass 'Renamed), VarSet)
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsLocalBinds (GhcPass 'Renamed)
hlb, VarSet
forall a. Monoid a => a
mempty)
Ghc.XValBindsLR (Ghc.NValBinds [(RecFlag, LHsBinds (GhcPass 'Renamed))]
bindPairs [LSig (GhcPass 'Renamed)]
sigs) -> do
let binds :: [LHsBind (GhcPass 'Renamed)]
binds = Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
-> [LHsBind (GhcPass 'Renamed)]
Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
-> [GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
forall a. Bag a -> [a]
Ghc.bagToList
(Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
-> [LHsBind (GhcPass 'Renamed)])
-> ([Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))]
-> Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))))
-> [Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))]
-> [LHsBind (GhcPass 'Renamed)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))]
-> Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
forall a. [Bag a] -> Bag a
Ghc.unionManyBags
([Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))]
-> [LHsBind (GhcPass 'Renamed)])
-> [Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))]
-> [LHsBind (GhcPass 'Renamed)]
forall a b. (a -> b) -> a -> b
$ ((RecFlag,
Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))))
-> Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))))
-> [(RecFlag,
Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))))]
-> [Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))]
forall a b. (a -> b) -> [a] -> [b]
map (RecFlag,
Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))))
-> Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
forall a b. (a, b) -> b
snd [(RecFlag, LHsBinds (GhcPass 'Renamed))]
[(RecFlag,
Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))))]
bindPairs :: [Ghc.LHsBind Ghc.GhcRn]
names :: [[Name]]
names = (GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
-> [Name])
-> [GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
-> [[Name]]
forall a b. (a -> b) -> [a] -> [b]
map ((HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed) -> [Name])
-> GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
-> [Name]
forall m a. Monoid m => (a -> m) -> GenLocated SrcSpanAnnA a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed) -> [Name]
forall idR. HsBindLR (GhcPass 'Renamed) idR -> [Name]
Ghc.collectHsBindBinders')
[LHsBind (GhcPass 'Renamed)]
[GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
binds
resultNames :: VarSet
resultNames = [Name] -> VarSet
mkVarSet ([Name] -> VarSet) -> [Name] -> VarSet
forall a b. (a -> b) -> a -> b
$ [[Name]] -> [Name]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Name]]
names
([(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name])]
resBindsWithNames, Any Bool
containsTarget)
<- WriterT
Any
(ReaderT Env TcM)
[(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name])]
-> WriterT
Any
(ReaderT Env TcM)
([(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name])],
Any)
forall w (m :: * -> *) a.
(Monoid w, Monad m) =>
WriterT w m a -> WriterT w m (a, w)
listen
(WriterT
Any
(ReaderT Env TcM)
[(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name])]
-> WriterT
Any
(ReaderT Env TcM)
([(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name])],
Any))
-> (WriterT
Any
(ReaderT Env TcM)
[GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
-> WriterT
Any
(ReaderT Env TcM)
[(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name])])
-> WriterT
Any
(ReaderT Env TcM)
[GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
-> WriterT
Any
(ReaderT Env TcM)
([(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name])],
Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
-> [(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name])])
-> WriterT
Any
(ReaderT Env TcM)
[GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
-> WriterT
Any
(ReaderT Env TcM)
[(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name])]
forall a b.
(a -> b)
-> WriterT Any (ReaderT Env TcM) a
-> WriterT Any (ReaderT Env TcM) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
-> [[Name]]
-> [(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name])]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [[Name]]
names)
(WriterT
Any
(ReaderT Env TcM)
[GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
-> WriterT
Any
(ReaderT Env TcM)
([(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name])],
Any))
-> WriterT
Any
(ReaderT Env TcM)
[GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
-> WriterT
Any
(ReaderT Env TcM)
([(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name])],
Any)
forall a b. (a -> b) -> a -> b
$ (GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
-> WriterT
Any
(ReaderT Env TcM)
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))))
-> [GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
-> WriterT
Any
(ReaderT Env TcM)
[GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (VarSet
-> LHsBind (GhcPass 'Renamed)
-> EnvReader (LHsBind (GhcPass 'Renamed))
dealWithBind VarSet
resultNames) [LHsBind (GhcPass 'Renamed)]
[GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
binds
if Bool -> Bool
not Bool
containsTarget
then (HsLocalBinds (GhcPass 'Renamed), VarSet)
-> EnvReader (HsLocalBinds (GhcPass 'Renamed), VarSet)
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsLocalBinds (GhcPass 'Renamed)
hlb, VarSet
resultNames)
else do
let mkTuple :: (t (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)), b)
-> (t (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)), b,
UniqSet Name)
mkTuple (t (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
bind, b
ns)
= (t (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
bind, b
ns, (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed) -> UniqSet Name)
-> t (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
-> UniqSet Name
forall m a. Monoid m => (a -> m) -> t a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed) -> UniqSet Name
getRhsFreeVars t (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
bind)
finalResult :: [(RecFlag, LHsBinds (GhcPass 'Renamed))]
finalResult = [(LHsBind (GhcPass 'Renamed), [Name], UniqSet Name)]
-> [(RecFlag, LHsBinds (GhcPass 'Renamed))]
depAnalBinds ([(LHsBind (GhcPass 'Renamed), [Name], UniqSet Name)]
-> [(RecFlag, LHsBinds (GhcPass 'Renamed))])
-> [(LHsBind (GhcPass 'Renamed), [Name], UniqSet Name)]
-> [(RecFlag, LHsBinds (GhcPass 'Renamed))]
forall a b. (a -> b) -> a -> b
$ (GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name])
-> (GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name], UniqSet Name)
forall {t :: * -> *} {b}.
Foldable t =>
(t (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)), b)
-> (t (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)), b,
UniqSet Name)
mkTuple ((GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name])
-> (GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name], UniqSet Name))
-> [(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name])]
-> [(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name], UniqSet Name)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name])]
resBindsWithNames
(HsLocalBinds (GhcPass 'Renamed), VarSet)
-> EnvReader (HsLocalBinds (GhcPass 'Renamed), VarSet)
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ( XHsValBinds (GhcPass 'Renamed) (GhcPass 'Renamed)
-> HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
-> HsLocalBinds (GhcPass 'Renamed)
forall idL idR.
XHsValBinds idL idR
-> HsValBindsLR idL idR -> HsLocalBindsLR idL idR
Ghc.HsValBinds XHsValBinds (GhcPass 'Renamed) (GhcPass 'Renamed)
x
(HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
-> HsLocalBinds (GhcPass 'Renamed))
-> HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
-> HsLocalBinds (GhcPass 'Renamed)
forall a b. (a -> b) -> a -> b
$ XXValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
-> HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
forall idL idR. XXValBindsLR idL idR -> HsValBindsLR idL idR
Ghc.XValBindsLR
(XXValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
-> HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed))
-> XXValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
-> HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
forall a b. (a -> b) -> a -> b
$ [(RecFlag, LHsBinds (GhcPass 'Renamed))]
-> [LSig (GhcPass 'Renamed)] -> NHsValBindsLR (GhcPass 'Renamed)
forall idL.
[(RecFlag, LHsBinds idL)]
-> [LSig (GhcPass 'Renamed)] -> NHsValBindsLR idL
Ghc.NValBinds [(RecFlag, LHsBinds (GhcPass 'Renamed))]
finalResult [LSig (GhcPass 'Renamed)]
sigs
, VarSet
resultNames
)
x :: HsLocalBinds (GhcPass 'Renamed)
x@(Ghc.HsIPBinds XHsIPBinds (GhcPass 'Renamed) (GhcPass 'Renamed)
_ HsIPBinds (GhcPass 'Renamed)
_) -> (HsLocalBinds (GhcPass 'Renamed), VarSet)
-> EnvReader (HsLocalBinds (GhcPass 'Renamed), VarSet)
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsLocalBinds (GhcPass 'Renamed)
x, VarSet
forall a. Monoid a => a
mempty)
HsLocalBinds (GhcPass 'Renamed)
other -> (HsLocalBinds (GhcPass 'Renamed), VarSet)
-> EnvReader (HsLocalBinds (GhcPass 'Renamed), VarSet)
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsLocalBinds (GhcPass 'Renamed)
other, VarSet
forall a. Monoid a => a
mempty)
getRhsFreeVars :: Ghc.HsBind Ghc.GhcRn -> Ghc.UniqSet Ghc.Name
getRhsFreeVars :: HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed) -> UniqSet Name
getRhsFreeVars = \case
Ghc.FunBind {XFunBind (GhcPass 'Renamed) (GhcPass 'Renamed)
LIdP (GhcPass 'Renamed)
MatchGroup (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
fun_ext :: forall idL idR. HsBindLR idL idR -> XFunBind idL idR
fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_ext :: XFunBind (GhcPass 'Renamed) (GhcPass 'Renamed)
fun_id :: LIdP (GhcPass 'Renamed)
fun_matches :: MatchGroup (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
..} -> XFunBind (GhcPass 'Renamed) (GhcPass 'Renamed)
UniqSet Name
fun_ext
Ghc.PatBind {XPatBind (GhcPass 'Renamed) (GhcPass 'Renamed)
LPat (GhcPass 'Renamed)
GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
pat_ext :: forall idL idR. HsBindLR idL idR -> XPatBind idL idR
pat_lhs :: forall idL idR. HsBindLR idL idR -> LPat idL
pat_rhs :: forall idL idR. HsBindLR idL idR -> GRHSs idR (LHsExpr idR)
pat_ext :: XPatBind (GhcPass 'Renamed) (GhcPass 'Renamed)
pat_lhs :: LPat (GhcPass 'Renamed)
pat_rhs :: GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
..} -> XPatBind (GhcPass 'Renamed) (GhcPass 'Renamed)
UniqSet Name
pat_ext
Ghc.PatSynBind XPatSynBind (GhcPass 'Renamed) (GhcPass 'Renamed)
_ Ghc.PSB {XPSB (GhcPass 'Renamed) (GhcPass 'Renamed)
LIdP (GhcPass 'Renamed)
LPat (GhcPass 'Renamed)
HsPatSynDetails (GhcPass 'Renamed)
HsPatSynDir (GhcPass 'Renamed)
psb_ext :: forall idL idR. PatSynBind idL idR -> XPSB idL idR
psb_id :: forall idL idR. PatSynBind idL idR -> LIdP idL
psb_args :: forall idL idR. PatSynBind idL idR -> HsPatSynDetails idR
psb_def :: forall idL idR. PatSynBind idL idR -> LPat idR
psb_dir :: forall idL idR. PatSynBind idL idR -> HsPatSynDir idR
psb_ext :: XPSB (GhcPass 'Renamed) (GhcPass 'Renamed)
psb_id :: LIdP (GhcPass 'Renamed)
psb_args :: HsPatSynDetails (GhcPass 'Renamed)
psb_def :: LPat (GhcPass 'Renamed)
psb_dir :: HsPatSynDir (GhcPass 'Renamed)
..} -> XPSB (GhcPass 'Renamed) (GhcPass 'Renamed)
UniqSet Name
psb_ext
HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
_ -> UniqSet Name
forall a. Monoid a => a
mempty
hsDoCase :: Ghc.HsExpr Ghc.GhcRn
-> EnvReader (Maybe (Ghc.HsExpr Ghc.GhcRn))
hsDoCase :: HsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
hsDoCase (Ghc.HsDo XDo (GhcPass 'Renamed)
x HsDoFlavour
ctx XRec (GhcPass 'Renamed) [GuardLStmt (GhcPass 'Renamed)]
lStmts) = do
(GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
stmtsRes, VarSet
_) <- WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
(GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))])
-> WriterT
Any
(ReaderT Env TcM)
(GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
VarSet)
forall w (m :: * -> *) a. Monoid w => WriterT w m a -> m (a, w)
runWriterT (WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
(GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))])
-> WriterT
Any
(ReaderT Env TcM)
(GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
VarSet))
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
(GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))])
-> WriterT
Any
(ReaderT Env TcM)
(GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
VarSet)
forall a b. (a -> b) -> a -> b
$ GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> ([GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
[GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))])
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
(GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for XRec (GhcPass 'Renamed) [GuardLStmt (GhcPass 'Renamed)]
GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
lStmts [LStmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))]
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
[LStmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))]
[GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
[GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
forall body.
(Data body, Data (Stmt (GhcPass 'Renamed) body)) =>
[LStmt (GhcPass 'Renamed) body]
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
[LStmt (GhcPass 'Renamed) body]
dealWithStatements
Maybe (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed))))
-> (HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed)))
-> HsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed))
forall a. a -> Maybe a
Just (HsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed))))
-> HsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall a b. (a -> b) -> a -> b
$ XDo (GhcPass 'Renamed)
-> HsDoFlavour
-> XRec (GhcPass 'Renamed) [GuardLStmt (GhcPass 'Renamed)]
-> HsExpr (GhcPass 'Renamed)
forall p. XDo p -> HsDoFlavour -> XRec p [ExprLStmt p] -> HsExpr p
Ghc.HsDo XDo (GhcPass 'Renamed)
x HsDoFlavour
ctx XRec (GhcPass 'Renamed) [GuardLStmt (GhcPass 'Renamed)]
GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
stmtsRes
hsDoCase HsExpr (GhcPass 'Renamed)
_ = Maybe (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (HsExpr (GhcPass 'Renamed))
forall a. Maybe a
Nothing
dealWithStatements
:: (Data body, Data (Ghc.Stmt Ghc.GhcRn body))
=> [Ghc.LStmt Ghc.GhcRn body]
-> WriterT VarSet EnvReader [Ghc.LStmt Ghc.GhcRn body]
dealWithStatements :: forall body.
(Data body, Data (Stmt (GhcPass 'Renamed) body)) =>
[LStmt (GhcPass 'Renamed) body]
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
[LStmt (GhcPass 'Renamed) body]
dealWithStatements [] = [GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body)]
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
[GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body)]
forall a. a -> WriterT VarSet (WriterT Any (ReaderT Env TcM)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
dealWithStatements (LStmt (GhcPass 'Renamed) body
lstmt : [LStmt (GhcPass 'Renamed) body]
xs) = do
(GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body)
stmtRes, VarSet
names) <- WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
(GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body))
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
(GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body),
VarSet)
forall w (m :: * -> *) a.
(Monoid w, Monad m) =>
WriterT w m a -> WriterT w m (a, w)
listen (WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
(GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body))
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
(GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body),
VarSet))
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
(GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body))
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
(GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body),
VarSet)
forall a b. (a -> b) -> a -> b
$ (Stmt (GhcPass 'Renamed) body
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
(Stmt (GhcPass 'Renamed) body))
-> GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body)
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
(GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> GenLocated (Anno (Stmt (GhcPass 'Renamed) body)) a
-> f (GenLocated (Anno (Stmt (GhcPass 'Renamed) body)) b)
traverse Stmt (GhcPass 'Renamed) body
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
(Stmt (GhcPass 'Renamed) body)
forall body.
(Data (Stmt (GhcPass 'Renamed) body), Data body) =>
Stmt (GhcPass 'Renamed) body
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
(Stmt (GhcPass 'Renamed) body)
dealWithStmt LStmt (GhcPass 'Renamed) body
GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body)
lstmt
(GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body)
stmtRes GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body)
-> [GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body)]
-> [GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body)]
forall a. a -> [a] -> [a]
:) ([GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body)]
-> [GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body)])
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
[GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body)]
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
[GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WriterT
Any
(ReaderT Env TcM)
([GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body)],
VarSet)
-> WriterT
Any
(ReaderT Env TcM)
([GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body)],
VarSet))
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
[GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body)]
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
[GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body)]
forall (n :: * -> *) w w' (m :: * -> *) a b.
(Monad n, Monoid w, Monoid w') =>
(m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
mapWriterT (VarSet
-> WriterT
Any
(ReaderT Env TcM)
([GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body)],
VarSet)
-> WriterT
Any
(ReaderT Env TcM)
([GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body)],
VarSet)
forall a. VarSet -> EnvReader a -> EnvReader a
addScopedVars VarSet
names) ([LStmt (GhcPass 'Renamed) body]
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
[LStmt (GhcPass 'Renamed) body]
forall body.
(Data body, Data (Stmt (GhcPass 'Renamed) body)) =>
[LStmt (GhcPass 'Renamed) body]
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
[LStmt (GhcPass 'Renamed) body]
dealWithStatements [LStmt (GhcPass 'Renamed) body]
xs)
dealWithStmt :: (Data (Ghc.Stmt Ghc.GhcRn body), Data body)
=> Ghc.Stmt Ghc.GhcRn body
-> WriterT VarSet EnvReader (Ghc.Stmt Ghc.GhcRn body)
dealWithStmt :: forall body.
(Data (Stmt (GhcPass 'Renamed) body), Data body) =>
Stmt (GhcPass 'Renamed) body
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
(Stmt (GhcPass 'Renamed) body)
dealWithStmt = \case
Ghc.BindStmt XBindStmt (GhcPass 'Renamed) (GhcPass 'Renamed) body
x LPat (GhcPass 'Renamed)
lpat body
body -> do
let names :: VarSet
names = LPat (GhcPass 'Renamed) -> VarSet
extractVarPats LPat (GhcPass 'Renamed)
lpat
VarSet -> WriterT VarSet (WriterT Any (ReaderT Env TcM)) ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell VarSet
names
body
bodyRes <- EnvReader body
-> WriterT VarSet (WriterT Any (ReaderT Env TcM)) body
forall (m :: * -> *) a. Monad m => m a -> WriterT VarSet m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (EnvReader body
-> WriterT VarSet (WriterT Any (ReaderT Env TcM)) body)
-> EnvReader body
-> WriterT VarSet (WriterT Any (ReaderT Env TcM)) body
forall a b. (a -> b) -> a -> b
$ body -> EnvReader body
forall a. Data a => a -> EnvReader a
recurse body
body
Stmt (GhcPass 'Renamed) body
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
(Stmt (GhcPass 'Renamed) body)
forall a. a -> WriterT VarSet (WriterT Any (ReaderT Env TcM)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Stmt (GhcPass 'Renamed) body
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
(Stmt (GhcPass 'Renamed) body))
-> Stmt (GhcPass 'Renamed) body
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
(Stmt (GhcPass 'Renamed) body)
forall a b. (a -> b) -> a -> b
$ XBindStmt (GhcPass 'Renamed) (GhcPass 'Renamed) body
-> LPat (GhcPass 'Renamed) -> body -> Stmt (GhcPass 'Renamed) body
forall idL idR body.
XBindStmt idL idR body -> LPat idL -> body -> StmtLR idL idR body
Ghc.BindStmt XBindStmt (GhcPass 'Renamed) (GhcPass 'Renamed) body
x LPat (GhcPass 'Renamed)
lpat body
bodyRes
Ghc.LetStmt' XLetStmt (GhcPass 'Renamed) (GhcPass 'Renamed) body
x (Ghc.L SrcSpan
loc HsLocalBinds (GhcPass 'Renamed)
localBinds) -> do
(HsLocalBinds (GhcPass 'Renamed)
bindsRes, VarSet
names) <- EnvReader (HsLocalBinds (GhcPass 'Renamed), VarSet)
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
(HsLocalBinds (GhcPass 'Renamed), VarSet)
forall (m :: * -> *) a. Monad m => m a -> WriterT VarSet m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (EnvReader (HsLocalBinds (GhcPass 'Renamed), VarSet)
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
(HsLocalBinds (GhcPass 'Renamed), VarSet))
-> EnvReader (HsLocalBinds (GhcPass 'Renamed), VarSet)
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
(HsLocalBinds (GhcPass 'Renamed), VarSet)
forall a b. (a -> b) -> a -> b
$ HsLocalBinds (GhcPass 'Renamed)
-> EnvReader (HsLocalBinds (GhcPass 'Renamed), VarSet)
dealWithLocalBinds HsLocalBinds (GhcPass 'Renamed)
localBinds
VarSet -> WriterT VarSet (WriterT Any (ReaderT Env TcM)) ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell VarSet
names
Stmt (GhcPass 'Renamed) body
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
(Stmt (GhcPass 'Renamed) body)
forall a. a -> WriterT VarSet (WriterT Any (ReaderT Env TcM)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Stmt (GhcPass 'Renamed) body
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
(Stmt (GhcPass 'Renamed) body))
-> Stmt (GhcPass 'Renamed) body
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
(Stmt (GhcPass 'Renamed) body)
forall a b. (a -> b) -> a -> b
$ XLetStmt (GhcPass 'Renamed) (GhcPass 'Renamed) body
-> GenLocated SrcSpan (HsLocalBinds (GhcPass 'Renamed))
-> Stmt (GhcPass 'Renamed) body
forall body.
XLetStmt (GhcPass 'Renamed) (GhcPass 'Renamed) body
-> GenLocated SrcSpan (HsLocalBinds (GhcPass 'Renamed))
-> StmtLR (GhcPass 'Renamed) (GhcPass 'Renamed) body
Ghc.LetStmt' XLetStmt (GhcPass 'Renamed) (GhcPass 'Renamed) body
x (SrcSpan
-> HsLocalBinds (GhcPass 'Renamed)
-> GenLocated SrcSpan (HsLocalBinds (GhcPass 'Renamed))
forall l e. l -> e -> GenLocated l e
Ghc.L SrcSpan
loc HsLocalBinds (GhcPass 'Renamed)
bindsRes)
Ghc.ApplicativeStmt XApplicativeStmt (GhcPass 'Renamed) (GhcPass 'Renamed) body
x [(SyntaxExpr (GhcPass 'Renamed),
ApplicativeArg (GhcPass 'Renamed))]
pairs Maybe (SyntaxExpr (GhcPass 'Renamed))
mbJoin -> do
let dealWithAppArg :: ApplicativeArg (GhcPass 'Renamed)
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
(ApplicativeArg (GhcPass 'Renamed))
dealWithAppArg = \case
a :: ApplicativeArg (GhcPass 'Renamed)
a@Ghc.ApplicativeArgOne{Bool
XApplicativeArgOne (GhcPass 'Renamed)
LPat (GhcPass 'Renamed)
LHsExpr (GhcPass 'Renamed)
xarg_app_arg_one :: XApplicativeArgOne (GhcPass 'Renamed)
app_arg_pattern :: LPat (GhcPass 'Renamed)
arg_expr :: LHsExpr (GhcPass 'Renamed)
is_body_stmt :: Bool
xarg_app_arg_one :: forall idL. ApplicativeArg idL -> XApplicativeArgOne idL
app_arg_pattern :: forall idL. ApplicativeArg idL -> LPat idL
arg_expr :: forall idL. ApplicativeArg idL -> LHsExpr idL
is_body_stmt :: forall idL. ApplicativeArg idL -> Bool
..} -> do
VarSet -> WriterT VarSet (WriterT Any (ReaderT Env TcM)) ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell (VarSet -> WriterT VarSet (WriterT Any (ReaderT Env TcM)) ())
-> VarSet -> WriterT VarSet (WriterT Any (ReaderT Env TcM)) ()
forall a b. (a -> b) -> a -> b
$ LPat (GhcPass 'Renamed) -> VarSet
extractVarPats LPat (GhcPass 'Renamed)
app_arg_pattern
ApplicativeArg (GhcPass 'Renamed)
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
(ApplicativeArg (GhcPass 'Renamed))
forall a. a -> WriterT VarSet (WriterT Any (ReaderT Env TcM)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ApplicativeArg (GhcPass 'Renamed)
a
a :: ApplicativeArg (GhcPass 'Renamed)
a@Ghc.ApplicativeArgMany{[GuardLStmt (GhcPass 'Renamed)]
XApplicativeArgMany (GhcPass 'Renamed)
LPat (GhcPass 'Renamed)
HsExpr (GhcPass 'Renamed)
HsDoFlavour
xarg_app_arg_many :: XApplicativeArgMany (GhcPass 'Renamed)
app_stmts :: [GuardLStmt (GhcPass 'Renamed)]
final_expr :: HsExpr (GhcPass 'Renamed)
bv_pattern :: LPat (GhcPass 'Renamed)
stmt_context :: HsDoFlavour
xarg_app_arg_many :: forall idL. ApplicativeArg idL -> XApplicativeArgMany idL
app_stmts :: forall idL. ApplicativeArg idL -> [ExprLStmt idL]
final_expr :: forall idL. ApplicativeArg idL -> HsExpr idL
bv_pattern :: forall idL. ApplicativeArg idL -> LPat idL
stmt_context :: forall idL. ApplicativeArg idL -> HsDoFlavour
..} -> do
VarSet -> WriterT VarSet (WriterT Any (ReaderT Env TcM)) ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell (VarSet -> WriterT VarSet (WriterT Any (ReaderT Env TcM)) ())
-> VarSet -> WriterT VarSet (WriterT Any (ReaderT Env TcM)) ()
forall a b. (a -> b) -> a -> b
$ LPat (GhcPass 'Renamed) -> VarSet
extractVarPats LPat (GhcPass 'Renamed)
bv_pattern
([GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
stmtsRes, VarSet
_) <- WriterT
Any
(ReaderT Env TcM)
([GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
VarSet)
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
([GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
VarSet)
forall (m :: * -> *) a. Monad m => m a -> WriterT VarSet m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WriterT
Any
(ReaderT Env TcM)
([GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
VarSet)
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
([GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
VarSet))
-> (WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> WriterT
Any
(ReaderT Env TcM)
([GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
VarSet))
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
([GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
VarSet)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> WriterT
Any
(ReaderT Env TcM)
([GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
VarSet)
forall w (m :: * -> *) a. Monoid w => WriterT w m a -> m (a, w)
runWriterT (WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
([GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
VarSet))
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
([GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
VarSet)
forall a b. (a -> b) -> a -> b
$ [LStmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))]
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
[LStmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))]
forall body.
(Data body, Data (Stmt (GhcPass 'Renamed) body)) =>
[LStmt (GhcPass 'Renamed) body]
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
[LStmt (GhcPass 'Renamed) body]
dealWithStatements [GuardLStmt (GhcPass 'Renamed)]
[LStmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))]
app_stmts
ApplicativeArg (GhcPass 'Renamed)
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
(ApplicativeArg (GhcPass 'Renamed))
forall a. a -> WriterT VarSet (WriterT Any (ReaderT Env TcM)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ApplicativeArg (GhcPass 'Renamed)
a {Ghc.app_stmts = stmtsRes}
[(SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))]
pairsRes <- (((SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
(SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed)))
-> [(SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))]
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
[(SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (((SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
(SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed)))
-> [(SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))]
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
[(SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))])
-> ((ApplicativeArg (GhcPass 'Renamed)
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
(ApplicativeArg (GhcPass 'Renamed)))
-> (SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
(SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed)))
-> (ApplicativeArg (GhcPass 'Renamed)
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
(ApplicativeArg (GhcPass 'Renamed)))
-> [(SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))]
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
[(SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ApplicativeArg (GhcPass 'Renamed)
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
(ApplicativeArg (GhcPass 'Renamed)))
-> (SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
(SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> (SyntaxExprRn, a) -> f (SyntaxExprRn, b)
traverse) ApplicativeArg (GhcPass 'Renamed)
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
(ApplicativeArg (GhcPass 'Renamed))
dealWithAppArg [(SyntaxExpr (GhcPass 'Renamed),
ApplicativeArg (GhcPass 'Renamed))]
[(SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))]
pairs
Stmt (GhcPass 'Renamed) body
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
(Stmt (GhcPass 'Renamed) body)
forall a. a -> WriterT VarSet (WriterT Any (ReaderT Env TcM)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Stmt (GhcPass 'Renamed) body
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
(Stmt (GhcPass 'Renamed) body))
-> Stmt (GhcPass 'Renamed) body
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
(Stmt (GhcPass 'Renamed) body)
forall a b. (a -> b) -> a -> b
$ XApplicativeStmt (GhcPass 'Renamed) (GhcPass 'Renamed) body
-> [(SyntaxExpr (GhcPass 'Renamed),
ApplicativeArg (GhcPass 'Renamed))]
-> Maybe (SyntaxExpr (GhcPass 'Renamed))
-> Stmt (GhcPass 'Renamed) body
forall idL idR body.
XApplicativeStmt idL idR body
-> [(SyntaxExpr idR, ApplicativeArg idL)]
-> Maybe (SyntaxExpr idR)
-> StmtLR idL idR body
Ghc.ApplicativeStmt XApplicativeStmt (GhcPass 'Renamed) (GhcPass 'Renamed) body
x [(SyntaxExpr (GhcPass 'Renamed),
ApplicativeArg (GhcPass 'Renamed))]
[(SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))]
pairsRes Maybe (SyntaxExpr (GhcPass 'Renamed))
mbJoin
Stmt (GhcPass 'Renamed) body
other -> EnvReader (Stmt (GhcPass 'Renamed) body)
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
(Stmt (GhcPass 'Renamed) body)
forall (m :: * -> *) a. Monad m => m a -> WriterT VarSet m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (EnvReader (Stmt (GhcPass 'Renamed) body)
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
(Stmt (GhcPass 'Renamed) body))
-> EnvReader (Stmt (GhcPass 'Renamed) body)
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
(Stmt (GhcPass 'Renamed) body)
forall a b. (a -> b) -> a -> b
$ (forall a. Data a => a -> EnvReader a)
-> Stmt (GhcPass 'Renamed) body
-> EnvReader (Stmt (GhcPass 'Renamed) body)
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> a -> m a
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Stmt (GhcPass 'Renamed) body -> m (Stmt (GhcPass 'Renamed) body)
gmapM d -> EnvReader d
forall a. Data a => a -> EnvReader a
recurse Stmt (GhcPass 'Renamed) body
other
hsProcCase :: Ghc.HsExpr Ghc.GhcRn
-> EnvReader (Maybe (Ghc.HsExpr Ghc.GhcRn))
hsProcCase :: HsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
hsProcCase (Ghc.HsProc XProc (GhcPass 'Renamed)
x1 LPat (GhcPass 'Renamed)
lpat LHsCmdTop (GhcPass 'Renamed)
cmdTop) = do
let inputNames :: VarSet
inputNames = LPat (GhcPass 'Renamed) -> VarSet
extractVarPats LPat (GhcPass 'Renamed)
lpat
MaybeT (WriterT Any (ReaderT Env TcM)) (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (WriterT Any (ReaderT Env TcM)) (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed))))
-> MaybeT
(WriterT Any (ReaderT Env TcM)) (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall a b. (a -> b) -> a -> b
$ do
GenLocated (SrcAnn NoEpAnns) (HsCmdTop (GhcPass 'Renamed))
cmdTopRes <- GenLocated (SrcAnn NoEpAnns) (HsCmdTop (GhcPass 'Renamed))
-> (HsCmdTop (GhcPass 'Renamed)
-> MaybeT
(WriterT Any (ReaderT Env TcM)) (HsCmdTop (GhcPass 'Renamed)))
-> MaybeT
(WriterT Any (ReaderT Env TcM))
(GenLocated (SrcAnn NoEpAnns) (HsCmdTop (GhcPass 'Renamed)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for LHsCmdTop (GhcPass 'Renamed)
GenLocated (SrcAnn NoEpAnns) (HsCmdTop (GhcPass 'Renamed))
cmdTop ((HsCmdTop (GhcPass 'Renamed)
-> MaybeT
(WriterT Any (ReaderT Env TcM)) (HsCmdTop (GhcPass 'Renamed)))
-> MaybeT
(WriterT Any (ReaderT Env TcM))
(GenLocated (SrcAnn NoEpAnns) (HsCmdTop (GhcPass 'Renamed))))
-> (HsCmdTop (GhcPass 'Renamed)
-> MaybeT
(WriterT Any (ReaderT Env TcM)) (HsCmdTop (GhcPass 'Renamed)))
-> MaybeT
(WriterT Any (ReaderT Env TcM))
(GenLocated (SrcAnn NoEpAnns) (HsCmdTop (GhcPass 'Renamed)))
forall a b. (a -> b) -> a -> b
$ \case
Ghc.HsCmdTop XCmdTop (GhcPass 'Renamed)
x2 LHsCmd (GhcPass 'Renamed)
lcmd -> do
GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))
cmdRes <- GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))
-> (HsCmd (GhcPass 'Renamed)
-> MaybeT
(WriterT Any (ReaderT Env TcM)) (HsCmd (GhcPass 'Renamed)))
-> MaybeT
(WriterT Any (ReaderT Env TcM))
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for LHsCmd (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))
lcmd ((HsCmd (GhcPass 'Renamed)
-> MaybeT
(WriterT Any (ReaderT Env TcM)) (HsCmd (GhcPass 'Renamed)))
-> MaybeT
(WriterT Any (ReaderT Env TcM))
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))
-> (HsCmd (GhcPass 'Renamed)
-> MaybeT
(WriterT Any (ReaderT Env TcM)) (HsCmd (GhcPass 'Renamed)))
-> MaybeT
(WriterT Any (ReaderT Env TcM))
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))
forall a b. (a -> b) -> a -> b
$ \case
Ghc.HsCmdDo XCmdDo (GhcPass 'Renamed)
x3 XRec (GhcPass 'Renamed) [CmdLStmt (GhcPass 'Renamed)]
lstmts -> do
(GenLocated
SrcSpanAnnL
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
stmtsRes, VarSet
_) <- WriterT
Any
(ReaderT Env TcM)
(GenLocated
SrcSpanAnnL
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
VarSet)
-> MaybeT
(WriterT Any (ReaderT Env TcM))
(GenLocated
SrcSpanAnnL
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
VarSet)
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WriterT
Any
(ReaderT Env TcM)
(GenLocated
SrcSpanAnnL
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
VarSet)
-> MaybeT
(WriterT Any (ReaderT Env TcM))
(GenLocated
SrcSpanAnnL
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
VarSet))
-> (([GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))])
-> WriterT
Any
(ReaderT Env TcM)
(GenLocated
SrcSpanAnnL
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
VarSet))
-> ([GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))])
-> MaybeT
(WriterT Any (ReaderT Env TcM))
(GenLocated
SrcSpanAnnL
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
VarSet)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
(GenLocated
SrcSpanAnnL
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))])
-> WriterT
Any
(ReaderT Env TcM)
(GenLocated
SrcSpanAnnL
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
VarSet)
forall w (m :: * -> *) a. Monoid w => WriterT w m a -> m (a, w)
runWriterT (WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
(GenLocated
SrcSpanAnnL
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))])
-> WriterT
Any
(ReaderT Env TcM)
(GenLocated
SrcSpanAnnL
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
VarSet))
-> (([GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))])
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
(GenLocated
SrcSpanAnnL
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]))
-> ([GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))])
-> WriterT
Any
(ReaderT Env TcM)
(GenLocated
SrcSpanAnnL
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
VarSet)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
-> ([GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))])
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
(GenLocated
SrcSpanAnnL
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for XRec (GhcPass 'Renamed) [CmdLStmt (GhcPass 'Renamed)]
GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
lstmts (([GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))])
-> MaybeT
(WriterT Any (ReaderT Env TcM))
(GenLocated
SrcSpanAnnL
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
VarSet))
-> ([GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))])
-> MaybeT
(WriterT Any (ReaderT Env TcM))
(GenLocated
SrcSpanAnnL
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
VarSet)
forall a b. (a -> b) -> a -> b
$ \[GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
stmts -> do
VarSet -> WriterT VarSet (WriterT Any (ReaderT Env TcM)) ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell VarSet
inputNames
(WriterT
Any
(ReaderT Env TcM)
([GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
VarSet)
-> WriterT
Any
(ReaderT Env TcM)
([GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
VarSet))
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
forall (n :: * -> *) w w' (m :: * -> *) a b.
(Monad n, Monoid w, Monoid w') =>
(m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
mapWriterT (VarSet
-> WriterT
Any
(ReaderT Env TcM)
([GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
VarSet)
-> WriterT
Any
(ReaderT Env TcM)
([GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
VarSet)
forall a. VarSet -> EnvReader a -> EnvReader a
addScopedVars VarSet
inputNames) (WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))])
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
forall a b. (a -> b) -> a -> b
$ [LStmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))]
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
[LStmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))]
forall body.
(Data body, Data (Stmt (GhcPass 'Renamed) body)) =>
[LStmt (GhcPass 'Renamed) body]
-> WriterT
VarSet
(WriterT Any (ReaderT Env TcM))
[LStmt (GhcPass 'Renamed) body]
dealWithStatements [LStmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))]
[GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
stmts
HsCmd (GhcPass 'Renamed)
-> MaybeT
(WriterT Any (ReaderT Env TcM)) (HsCmd (GhcPass 'Renamed))
forall a. a -> MaybeT (WriterT Any (ReaderT Env TcM)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsCmd (GhcPass 'Renamed)
-> MaybeT
(WriterT Any (ReaderT Env TcM)) (HsCmd (GhcPass 'Renamed)))
-> HsCmd (GhcPass 'Renamed)
-> MaybeT
(WriterT Any (ReaderT Env TcM)) (HsCmd (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ XCmdDo (GhcPass 'Renamed)
-> XRec (GhcPass 'Renamed) [CmdLStmt (GhcPass 'Renamed)]
-> HsCmd (GhcPass 'Renamed)
forall id. XCmdDo id -> XRec id [CmdLStmt id] -> HsCmd id
Ghc.HsCmdDo XCmdDo (GhcPass 'Renamed)
x3 XRec (GhcPass 'Renamed) [CmdLStmt (GhcPass 'Renamed)]
GenLocated
SrcSpanAnnL
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
stmtsRes
HsCmd (GhcPass 'Renamed)
_ -> MaybeT (WriterT Any (ReaderT Env TcM)) (HsCmd (GhcPass 'Renamed))
forall a. MaybeT (WriterT Any (ReaderT Env TcM)) a
forall (f :: * -> *) a. Alternative f => f a
empty
HsCmdTop (GhcPass 'Renamed)
-> MaybeT
(WriterT Any (ReaderT Env TcM)) (HsCmdTop (GhcPass 'Renamed))
forall a. a -> MaybeT (WriterT Any (ReaderT Env TcM)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsCmdTop (GhcPass 'Renamed)
-> MaybeT
(WriterT Any (ReaderT Env TcM)) (HsCmdTop (GhcPass 'Renamed)))
-> HsCmdTop (GhcPass 'Renamed)
-> MaybeT
(WriterT Any (ReaderT Env TcM)) (HsCmdTop (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ XCmdTop (GhcPass 'Renamed)
-> LHsCmd (GhcPass 'Renamed) -> HsCmdTop (GhcPass 'Renamed)
forall p. XCmdTop p -> LHsCmd p -> HsCmdTop p
Ghc.HsCmdTop XCmdTop (GhcPass 'Renamed)
x2 LHsCmd (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))
cmdRes
HsExpr (GhcPass 'Renamed)
-> MaybeT
(WriterT Any (ReaderT Env TcM)) (HsExpr (GhcPass 'Renamed))
forall a. a -> MaybeT (WriterT Any (ReaderT Env TcM)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsExpr (GhcPass 'Renamed)
-> MaybeT
(WriterT Any (ReaderT Env TcM)) (HsExpr (GhcPass 'Renamed)))
-> HsExpr (GhcPass 'Renamed)
-> MaybeT
(WriterT Any (ReaderT Env TcM)) (HsExpr (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ XProc (GhcPass 'Renamed)
-> LPat (GhcPass 'Renamed)
-> LHsCmdTop (GhcPass 'Renamed)
-> HsExpr (GhcPass 'Renamed)
forall p. XProc p -> LPat p -> LHsCmdTop p -> HsExpr p
Ghc.HsProc XProc (GhcPass 'Renamed)
x1 LPat (GhcPass 'Renamed)
lpat LHsCmdTop (GhcPass 'Renamed)
GenLocated (SrcAnn NoEpAnns) (HsCmdTop (GhcPass 'Renamed))
cmdTopRes
hsProcCase HsExpr (GhcPass 'Renamed)
_ = Maybe (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (HsExpr (GhcPass 'Renamed))
forall a. Maybe a
Nothing
type EnvReader = WriterT Any (ReaderT Env Ghc.TcM)
type VarSet = M.Map Ghc.LexicalFastString Ghc.Name
data Env = MkEnv
{ Env -> VarSet
varSet :: !VarSet
, Env -> Name
captureVarsName :: !Ghc.Name
, Env -> Name
showLevName :: !Ghc.Name
, Env -> Name
fromListName :: !Ghc.Name
, Env -> Name
breakpointName :: !Ghc.Name
, Env -> Name
queryVarsName :: !Ghc.Name
, Env -> Name
breakpointMName :: !Ghc.Name
, Env -> Name
queryVarsMName :: !Ghc.Name
, Env -> Name
breakpointIOName :: !Ghc.Name
, Env -> Name
queryVarsIOName :: !Ghc.Name
, Env -> Name
printAndWaitName :: !Ghc.Name
, Env -> Name
printAndWaitMName :: !Ghc.Name
, Env -> Name
printAndWaitIOName :: !Ghc.Name
, Env -> Name
runPromptIOName :: !Ghc.Name
, Env -> Name
runPromptName :: !Ghc.Name
, Env -> Name
runPromptMName :: !Ghc.Name
, Env -> Name
getSrcLocName :: !Ghc.Name
, Env -> Name
excludeVarsName :: !Ghc.Name
}
overVarSet :: (VarSet -> VarSet) -> Env -> Env
overVarSet :: (VarSet -> VarSet) -> Env -> Env
overVarSet VarSet -> VarSet
f Env
env = Env
env { varSet = f $ varSet env }
getOccNameFS :: Ghc.Name -> Ghc.LexicalFastString
getOccNameFS :: Name -> LexicalFastString
getOccNameFS = FastString -> LexicalFastString
Ghc.mkLexicalFastString (FastString -> LexicalFastString)
-> (Name -> FastString) -> Name -> LexicalFastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> FastString
Ghc.occNameFS (OccName -> FastString) -> (Name -> OccName) -> Name -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> OccName
forall a. NamedThing a => a -> OccName
Ghc.getOccName
mkVarSet :: [Ghc.Name] -> VarSet
mkVarSet :: [Name] -> VarSet
mkVarSet [Name]
names = [(LexicalFastString, Name)] -> VarSet
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(LexicalFastString, Name)] -> VarSet)
-> [(LexicalFastString, Name)] -> VarSet
forall a b. (a -> b) -> a -> b
$ (Name -> LexicalFastString
getOccNameFS (Name -> LexicalFastString)
-> (Name -> Name) -> Name -> (LexicalFastString, Name)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Name -> Name
forall a. a -> a
id) (Name -> (LexicalFastString, Name))
-> [Name] -> [(LexicalFastString, Name)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name]
names
addScopedVars :: VarSet -> EnvReader a -> EnvReader a
addScopedVars :: forall a. VarSet -> EnvReader a -> EnvReader a
addScopedVars VarSet
names = (ReaderT Env TcM (a, Any) -> ReaderT Env TcM (a, Any))
-> WriterT Any (ReaderT Env TcM) a
-> WriterT Any (ReaderT Env TcM) a
forall (n :: * -> *) w w' (m :: * -> *) a b.
(Monad n, Monoid w, Monoid w') =>
(m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
mapWriterT ((ReaderT Env TcM (a, Any) -> ReaderT Env TcM (a, Any))
-> WriterT Any (ReaderT Env TcM) a
-> WriterT Any (ReaderT Env TcM) a)
-> (ReaderT Env TcM (a, Any) -> ReaderT Env TcM (a, Any))
-> WriterT Any (ReaderT Env TcM) a
-> WriterT Any (ReaderT Env TcM) a
forall a b. (a -> b) -> a -> b
$ (Env -> Env)
-> ReaderT Env TcM (a, Any) -> ReaderT Env TcM (a, Any)
forall a. (Env -> Env) -> ReaderT Env TcM a -> ReaderT Env TcM a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ((VarSet -> VarSet) -> Env -> Env
overVarSet (VarSet
names VarSet -> VarSet -> VarSet
forall a. Semigroup a => a -> a -> a
<>))
depAnalBinds :: [(Ghc.LHsBind Ghc.GhcRn, [Ghc.Name], Ghc.UniqSet Ghc.Name)]
-> [(Ghc.RecFlag, Ghc.LHsBinds Ghc.GhcRn)]
depAnalBinds :: [(LHsBind (GhcPass 'Renamed), [Name], UniqSet Name)]
-> [(RecFlag, LHsBinds (GhcPass 'Renamed))]
depAnalBinds [(LHsBind (GhcPass 'Renamed), [Name], UniqSet Name)]
binds_w_dus
= (SCC
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name], UniqSet Name)
-> (RecFlag,
Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))))
-> [SCC
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name], UniqSet Name)]
-> [(RecFlag,
Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))))]
forall a b. (a -> b) -> [a] -> [b]
map SCC
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name], UniqSet Name)
-> (RecFlag,
Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))))
forall {a} {b} {c}. SCC (a, b, c) -> (RecFlag, Bag a)
get_binds [SCC
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name], UniqSet Name)]
sccs
where
sccs :: [SCC
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name], UniqSet Name)]
sccs = ((GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name], UniqSet Name)
-> [Name])
-> ((GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name], UniqSet Name)
-> [Name])
-> [(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name], UniqSet Name)]
-> [SCC
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name], UniqSet Name)]
forall node.
(node -> [Name]) -> (node -> [Name]) -> [node] -> [SCC node]
Ghc.depAnal
(\(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
_, [Name]
defs, UniqSet Name
_) -> [Name]
defs)
(\(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
_, [Name]
_, UniqSet Name
uses) -> UniqSet Name -> [Name]
forall elt. UniqSet elt -> [elt]
Ghc.nonDetEltsUniqSet UniqSet Name
uses)
[(LHsBind (GhcPass 'Renamed), [Name], UniqSet Name)]
[(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name], UniqSet Name)]
binds_w_dus
get_binds :: SCC (a, b, c) -> (RecFlag, Bag a)
get_binds (Graph.AcyclicSCC (a
bind, b
_, c
_)) =
(RecFlag
Ghc.NonRecursive, a -> Bag a
forall a. a -> Bag a
Ghc.unitBag a
bind)
get_binds (Graph.CyclicSCC [(a, b, c)]
binds_w_dus') =
(RecFlag
Ghc.Recursive, [a] -> Bag a
forall a. [a] -> Bag a
Ghc.listToBag [a
b | (a
b,b
_,c
_) <- [(a, b, c)]
binds_w_dus'])