{-# LANGUAGE GADTs #-} -- for 8.10
{-# 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           GHC.Exts (fromList, toList)

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 GhcRn -> TcM (TcGblEnv, HsGroup GhcRn)
renameAction TcGblEnv
gblEnv HsGroup GhcRn
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 GhcRn
group', Any
_) <-
    ReaderT Env TcM (HsGroup GhcRn, Any)
-> Env -> IOEnv (Env TcGblEnv TcLclEnv) (HsGroup GhcRn, Any)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (WriterT Any (ReaderT Env TcM) (HsGroup GhcRn)
-> ReaderT Env TcM (HsGroup GhcRn, Any)
forall w (m :: * -> *) a. Monoid w => WriterT w m a -> m (a, w)
runWriterT (WriterT Any (ReaderT Env TcM) (HsGroup GhcRn)
 -> ReaderT Env TcM (HsGroup GhcRn, Any))
-> WriterT Any (ReaderT Env TcM) (HsGroup GhcRn)
-> ReaderT Env TcM (HsGroup GhcRn, Any)
forall a b. (a -> b) -> a -> b
$ HsGroup GhcRn -> WriterT Any (ReaderT Env TcM) (HsGroup GhcRn)
forall a. Data a => a -> EnvReader a
recurse HsGroup GhcRn
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
excludeVarsName :: Name
getSrcLocName :: Name
runPromptMName :: Name
runPromptName :: Name
runPromptIOName :: Name
printAndWaitIOName :: Name
printAndWaitMName :: Name
printAndWaitName :: Name
queryVarsIOName :: Name
breakpointIOName :: Name
queryVarsMName :: Name
breakpointMName :: Name
queryVarsName :: Name
breakpointName :: Name
fromListName :: Name
showLevName :: Name
captureVarsName :: Name
.. }

  (TcGblEnv, HsGroup GhcRn) -> TcM (TcGblEnv, HsGroup GhcRn)
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TcGblEnv
gblEnv, HsGroup GhcRn
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 GhcRn -> EnvReader (Maybe (HsExpr GhcRn)))
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
forall b.
Data b =>
(b -> EnvReader (Maybe b))
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
wrap HsExpr GhcRn -> EnvReader (Maybe (HsExpr GhcRn))
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 GhcRn)
 -> EnvReader (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
forall b.
Data b =>
(b -> EnvReader (Maybe b))
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
wrap LHsExpr GhcRn -> EnvReader (Maybe (LHsExpr GhcRn))
GenLocated SrcSpanAnnA (HsExpr GhcRn)
-> EnvReader (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
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 GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
 -> EnvReader
      (Maybe (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))))
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
forall b.
Data b =>
(b -> EnvReader (Maybe b))
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
wrap Match GhcRn (LHsExpr GhcRn)
-> EnvReader (Maybe (Match GhcRn (LHsExpr GhcRn)))
Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> EnvReader
     (Maybe (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
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 GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
 -> EnvReader
      (Maybe (GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))))
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
forall b.
Data b =>
(b -> EnvReader (Maybe b))
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
wrap GRHSs GhcRn (LHsExpr GhcRn)
-> EnvReader (Maybe (GRHSs GhcRn (LHsExpr GhcRn)))
GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> EnvReader
     (Maybe (GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
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 GhcRn -> EnvReader (Maybe (HsExpr GhcRn)))
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
forall b.
Data b =>
(b -> EnvReader (Maybe b))
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
wrap HsExpr GhcRn -> EnvReader (Maybe (HsExpr GhcRn))
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 GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
 -> EnvReader
      (Maybe (GRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))))
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
forall b.
Data b =>
(b -> EnvReader (Maybe b))
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
wrap GRHS GhcRn (LHsExpr GhcRn)
-> EnvReader (Maybe (GRHS GhcRn (LHsExpr GhcRn)))
GRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> EnvReader
     (Maybe (GRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
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 GhcRn -> EnvReader (Maybe (HsExpr GhcRn)))
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
forall b.
Data b =>
(b -> EnvReader (Maybe b))
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
wrap HsExpr GhcRn -> EnvReader (Maybe (HsExpr GhcRn))
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 GhcRn -> EnvReader (Maybe (HsExpr GhcRn)))
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
forall b.
Data b =>
(b -> EnvReader (Maybe b))
-> MaybeT (WriterT Any (ReaderT Env TcM)) a
wrap HsExpr GhcRn -> EnvReader (Maybe (HsExpr GhcRn))
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

--------------------------------------------------------------------------------
-- Variable Expr
--------------------------------------------------------------------------------

hsVarCase :: Ghc.HsExpr Ghc.GhcRn
          -> EnvReader (Maybe (Ghc.HsExpr Ghc.GhcRn))
hsVarCase :: HsExpr GhcRn -> EnvReader (Maybe (HsExpr GhcRn))
hsVarCase (Ghc.HsVar XVar GhcRn
_ (Ghc.L SrcSpanAnnN
loc Name
name)) = do
  MkEnv{VarSet
Name
varSet :: Env -> VarSet
excludeVarsName :: Env -> Name
getSrcLocName :: Env -> Name
runPromptMName :: Env -> Name
runPromptName :: Env -> Name
runPromptIOName :: Env -> Name
printAndWaitIOName :: Env -> Name
printAndWaitMName :: Env -> Name
printAndWaitName :: Env -> Name
queryVarsIOName :: Env -> Name
breakpointIOName :: Env -> Name
queryVarsMName :: Env -> Name
breakpointMName :: Env -> Name
queryVarsName :: Env -> Name
breakpointName :: Env -> Name
fromListName :: Env -> Name
showLevName :: Env -> Name
captureVarsName :: 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 GhcRn)
srcLocStringExpr
        = HsLit GhcRn -> LHsExpr GhcRn
HsLit GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall (p :: Pass). HsLit (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsLit (HsLit GhcRn -> GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> (SrcSpan -> HsLit GhcRn)
-> SrcSpan
-> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> HsLit GhcRn
forall (p :: Pass). String -> HsLit (GhcPass p)
Ghc.mkHsString
        (String -> HsLit GhcRn)
-> (SrcSpan -> String) -> SrcSpan -> HsLit GhcRn
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 GhcRn))
-> SrcSpan -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnN -> SrcSpan
forall a. SrcSpanAnn' a -> SrcSpan
Ghc.locA SrcSpanAnnN
loc

      captureVarsExpr :: Maybe Name -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
captureVarsExpr Maybe Name
mResultName =
        let mkTuple :: (LexicalFastString, Name) -> LHsExpr GhcRn
mkTuple (LexicalFastString -> FastString
Ghc.fromLexicalFastString -> FastString
varStr, Name
n) =
              [LHsExpr GhcRn] -> XExplicitTuple GhcRn -> LHsExpr GhcRn
forall (p :: Pass).
[LHsExpr (GhcPass p)]
-> XExplicitTuple (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.mkLHsTupleExpr
                [ HsLit GhcRn -> LHsExpr GhcRn
forall (p :: Pass). HsLit (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsLit (HsLit GhcRn -> LHsExpr GhcRn)
-> (String -> HsLit GhcRn) -> String -> LHsExpr GhcRn
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> HsLit GhcRn
forall (p :: Pass). String -> HsLit (GhcPass p)
Ghc.mkHsString (String -> LHsExpr GhcRn) -> String -> LHsExpr GhcRn
forall a b. (a -> b) -> a -> b
$ FastString -> String
Ghc.unpackFS FastString
varStr
                , LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp (IdP GhcRn -> LHsExpr GhcRn
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsVar IdP GhcRn
Name
showLevName) (IdP GhcRn -> LHsExpr GhcRn
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsVar IdP GhcRn
Name
n)
                ]
                XExplicitTuple GhcRn
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 GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp (IdP GhcRn -> LHsExpr GhcRn
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsVar IdP GhcRn
Name
fromListName) (GenLocated SrcSpanAnnA (HsExpr GhcRn)
 -> GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> ([GenLocated SrcSpanAnnA (HsExpr GhcRn)]
    -> GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> [GenLocated SrcSpanAnnA (HsExpr GhcRn)]
-> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [LHsExpr GhcRn] -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
[GenLocated SrcSpanAnnA (HsExpr GhcRn)]
-> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall {p} {an}.
(XExplicitList p ~ NoExtField) =>
[XRec p (HsExpr p)] -> LocatedAn an (HsExpr p)
mkList
              ([GenLocated SrcSpanAnnA (HsExpr GhcRn)]
 -> GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> [GenLocated SrcSpanAnnA (HsExpr GhcRn)]
-> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall a b. (a -> b) -> a -> b
$ (LexicalFastString, Name) -> LHsExpr GhcRn
(LexicalFastString, Name) -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
mkTuple ((LexicalFastString, Name)
 -> GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> [(LexicalFastString, Name)]
-> [GenLocated SrcSpanAnnA (HsExpr GhcRn)]
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 GhcRn))
bpExpr = do
        Name
resultName <- OccName -> TcRnIf TcGblEnv TcLclEnv Name
Ghc.newName (NameSpace -> String -> OccName
Ghc.mkOccName NameSpace
Ghc.varName String
"_result_")
        GenLocated SrcSpanAnnA (HsExpr GhcRn)
-> IOEnv
     (Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenLocated SrcSpanAnnA (HsExpr GhcRn)
 -> IOEnv
      (Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> GenLocated SrcSpanAnnA (HsExpr GhcRn)
-> IOEnv
     (Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
forall a b. (a -> b) -> a -> b
$
          [LPat GhcRn] -> LHsExpr GhcRn -> LHsExpr GhcRn
Ghc.mkHsLam' [IdP GhcRn -> LPat GhcRn
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LPat (GhcPass p)
Ghc.nlVarPat IdP GhcRn
Name
resultName] (LHsExpr GhcRn -> LHsExpr GhcRn) -> LHsExpr GhcRn -> LHsExpr GhcRn
forall a b. (a -> b) -> a -> b
$
            LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp
              (LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp
                (LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp (IdP GhcRn -> LHsExpr GhcRn
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsVar IdP GhcRn
Name
printAndWaitName) LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
srcLocStringExpr)
                (Maybe Name -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
captureVarsExpr (Maybe Name -> GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> Maybe Name -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall a b. (a -> b) -> a -> b
$ Name -> Maybe Name
forall a. a -> Maybe a
Just Name
resultName)
              )
              (IdP GhcRn -> LHsExpr GhcRn
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsVar IdP GhcRn
Name
resultName)

      bpMExpr :: LHsExpr GhcRn
bpMExpr =
        LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp
          (LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp (IdP GhcRn -> LHsExpr GhcRn
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsVar IdP GhcRn
Name
printAndWaitMName) LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
srcLocStringExpr)
          (LHsExpr GhcRn -> LHsExpr GhcRn) -> LHsExpr GhcRn -> LHsExpr GhcRn
forall a b. (a -> b) -> a -> b
$ Maybe Name -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
captureVarsExpr Maybe Name
forall a. Maybe a
Nothing

      bpIOExpr :: LHsExpr GhcRn
bpIOExpr =
        LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp
          (LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp (IdP GhcRn -> LHsExpr GhcRn
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsVar IdP GhcRn
Name
printAndWaitIOName) LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
srcLocStringExpr)
          (LHsExpr GhcRn -> LHsExpr GhcRn) -> LHsExpr GhcRn -> LHsExpr GhcRn
forall a b. (a -> b) -> a -> b
$ Maybe Name -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
captureVarsExpr Maybe Name
forall a. Maybe a
Nothing

      queryVarsIOExpr :: LHsExpr GhcRn
queryVarsIOExpr =
        LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp
          (LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp (IdP GhcRn -> LHsExpr GhcRn
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsVar IdP GhcRn
Name
runPromptIOName) LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
srcLocStringExpr)
          (LHsExpr GhcRn -> LHsExpr GhcRn) -> LHsExpr GhcRn -> LHsExpr GhcRn
forall a b. (a -> b) -> a -> b
$ Maybe Name -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
captureVarsExpr Maybe Name
forall a. Maybe a
Nothing

      queryVarsExpr :: IOEnv
  (Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
queryVarsExpr = do
        Name
resultName <- OccName -> TcRnIf TcGblEnv TcLclEnv Name
Ghc.newName (NameSpace -> String -> OccName
Ghc.mkOccName NameSpace
Ghc.varName String
"_result_")
        GenLocated SrcSpanAnnA (HsExpr GhcRn)
-> IOEnv
     (Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenLocated SrcSpanAnnA (HsExpr GhcRn)
 -> IOEnv
      (Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> GenLocated SrcSpanAnnA (HsExpr GhcRn)
-> IOEnv
     (Env TcGblEnv TcLclEnv) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
forall a b. (a -> b) -> a -> b
$
          [LPat GhcRn] -> LHsExpr GhcRn -> LHsExpr GhcRn
Ghc.mkHsLam' [IdP GhcRn -> LPat GhcRn
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LPat (GhcPass p)
Ghc.nlVarPat IdP GhcRn
Name
resultName] (LHsExpr GhcRn -> LHsExpr GhcRn) -> LHsExpr GhcRn -> LHsExpr GhcRn
forall a b. (a -> b) -> a -> b
$
            LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp
              (LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp
                (LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp (IdP GhcRn -> LHsExpr GhcRn
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsVar IdP GhcRn
Name
runPromptName) LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
srcLocStringExpr)
                (Maybe Name -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
captureVarsExpr (Maybe Name -> GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> Maybe Name -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
forall a b. (a -> b) -> a -> b
$ Name -> Maybe Name
forall a. a -> Maybe a
Just Name
resultName)
              )
              (IdP GhcRn -> LHsExpr GhcRn
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsVar IdP GhcRn
Name
resultName)

      queryVarsMExpr :: LHsExpr GhcRn
queryVarsMExpr =
        LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp
          (LHsExpr GhcRn -> LHsExpr GhcRn -> LHsExpr GhcRn
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp (IdP GhcRn -> LHsExpr GhcRn
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsVar IdP GhcRn
Name
runPromptMName) LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
srcLocStringExpr)
          (LHsExpr GhcRn -> LHsExpr GhcRn) -> LHsExpr GhcRn -> LHsExpr GhcRn
forall a b. (a -> b) -> a -> b
$ Maybe Name -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
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 GhcRn) -> EnvReader (Maybe (HsExpr GhcRn))
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsExpr GhcRn -> Maybe (HsExpr GhcRn)
forall a. a -> Maybe a
Just (HsExpr GhcRn -> Maybe (HsExpr GhcRn))
-> (GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn)
-> GenLocated SrcSpanAnnA (HsExpr GhcRn)
-> Maybe (HsExpr GhcRn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn
forall l e. GenLocated l e -> e
Ghc.unLoc (GenLocated SrcSpanAnnA (HsExpr GhcRn) -> Maybe (HsExpr GhcRn))
-> GenLocated SrcSpanAnnA (HsExpr GhcRn) -> Maybe (HsExpr GhcRn)
forall a b. (a -> b) -> a -> b
$ Maybe Name -> GenLocated SrcSpanAnnA (HsExpr GhcRn)
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 GhcRn -> Maybe (HsExpr GhcRn)
forall a. a -> Maybe a
Just (HsExpr GhcRn -> Maybe (HsExpr GhcRn))
-> (GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn)
-> GenLocated SrcSpanAnnA (HsExpr GhcRn)
-> Maybe (HsExpr GhcRn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn
forall l e. GenLocated l e -> e
Ghc.unLoc (GenLocated SrcSpanAnnA (HsExpr GhcRn) -> Maybe (HsExpr GhcRn))
-> WriterT
     Any (ReaderT Env TcM) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> EnvReader (Maybe (HsExpr GhcRn))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT Env TcM (GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> WriterT
     Any (ReaderT Env TcM) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
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 GhcRn))
-> ReaderT Env TcM (GenLocated SrcSpanAnnA (HsExpr GhcRn))
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 GhcRn))
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 GhcRn) -> EnvReader (Maybe (HsExpr GhcRn))
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsExpr GhcRn -> Maybe (HsExpr GhcRn)
forall a. a -> Maybe a
Just (HsExpr GhcRn -> Maybe (HsExpr GhcRn))
-> HsExpr GhcRn -> Maybe (HsExpr GhcRn)
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn
forall l e. GenLocated l e -> e
Ghc.unLoc LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
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 GhcRn) -> EnvReader (Maybe (HsExpr GhcRn))
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsExpr GhcRn -> Maybe (HsExpr GhcRn)
forall a. a -> Maybe a
Just (HsExpr GhcRn -> Maybe (HsExpr GhcRn))
-> HsExpr GhcRn -> Maybe (HsExpr GhcRn)
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn
forall l e. GenLocated l e -> e
Ghc.unLoc LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
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 GhcRn) -> EnvReader (Maybe (HsExpr GhcRn))
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsExpr GhcRn -> Maybe (HsExpr GhcRn)
forall a. a -> Maybe a
Just (HsExpr GhcRn -> Maybe (HsExpr GhcRn))
-> HsExpr GhcRn -> Maybe (HsExpr GhcRn)
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn
forall l e. GenLocated l e -> e
Ghc.unLoc LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
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 GhcRn -> Maybe (HsExpr GhcRn)
forall a. a -> Maybe a
Just (HsExpr GhcRn -> Maybe (HsExpr GhcRn))
-> (GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn)
-> GenLocated SrcSpanAnnA (HsExpr GhcRn)
-> Maybe (HsExpr GhcRn)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn
forall l e. GenLocated l e -> e
Ghc.unLoc (GenLocated SrcSpanAnnA (HsExpr GhcRn) -> Maybe (HsExpr GhcRn))
-> WriterT
     Any (ReaderT Env TcM) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> EnvReader (Maybe (HsExpr GhcRn))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT Env TcM (GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> WriterT
     Any (ReaderT Env TcM) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
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 GhcRn))
-> ReaderT Env TcM (GenLocated SrcSpanAnnA (HsExpr GhcRn))
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 GhcRn))
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 GhcRn) -> EnvReader (Maybe (HsExpr GhcRn))
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsExpr GhcRn -> Maybe (HsExpr GhcRn)
forall a. a -> Maybe a
Just (HsExpr GhcRn -> Maybe (HsExpr GhcRn))
-> HsExpr GhcRn -> Maybe (HsExpr GhcRn)
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn
forall l e. GenLocated l e -> e
Ghc.unLoc LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
queryVarsMExpr)

     | Name
getSrcLocName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name ->
         Maybe (HsExpr GhcRn) -> EnvReader (Maybe (HsExpr GhcRn))
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsExpr GhcRn -> Maybe (HsExpr GhcRn)
forall a. a -> Maybe a
Just (HsExpr GhcRn -> Maybe (HsExpr GhcRn))
-> HsExpr GhcRn -> Maybe (HsExpr GhcRn)
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn
forall l e. GenLocated l e -> e
Ghc.unLoc GenLocated SrcSpanAnnA (HsExpr GhcRn)
srcLocStringExpr)

     | Bool
otherwise -> Maybe (HsExpr GhcRn) -> EnvReader (Maybe (HsExpr GhcRn))
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (HsExpr GhcRn)
forall a. Maybe a
Nothing
hsVarCase HsExpr GhcRn
_ = Maybe (HsExpr GhcRn) -> EnvReader (Maybe (HsExpr GhcRn))
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (HsExpr GhcRn)
forall a. Maybe a
Nothing

--------------------------------------------------------------------------------
-- App Expr
--------------------------------------------------------------------------------

hsAppCase :: Ghc.LHsExpr Ghc.GhcRn
          -> EnvReader (Maybe (Ghc.LHsExpr Ghc.GhcRn))
hsAppCase :: LHsExpr GhcRn -> EnvReader (Maybe (LHsExpr GhcRn))
hsAppCase (LHsExpr GhcRn -> HsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn
forall l e. GenLocated l e -> e
Ghc.unLoc -> Ghc.HsApp XApp GhcRn
_ LHsExpr GhcRn
f LHsExpr GhcRn
innerExpr)
  | Ghc.HsApp XApp GhcRn
_ (LHsExpr GhcRn -> HsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn
forall l e. GenLocated l e -> e
Ghc.unLoc -> Ghc.HsVar XVar GhcRn
_ (LIdP GhcRn -> Name
GenLocated SrcSpanAnnN Name -> Name
forall l e. GenLocated l e -> e
Ghc.unLoc -> Name
name))
                (LHsExpr GhcRn -> HsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn
forall l e. GenLocated l e -> e
Ghc.unLoc -> Ghc.ExplicitList XExplicitList GhcRn
_ [LHsExpr GhcRn]
exprsToExclude)
      <- GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn
forall l e. GenLocated l e -> e
Ghc.unLoc LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
f
  = do
    MkEnv{VarSet
Name
varSet :: Env -> VarSet
excludeVarsName :: Env -> Name
getSrcLocName :: Env -> Name
runPromptMName :: Env -> Name
runPromptName :: Env -> Name
runPromptIOName :: Env -> Name
printAndWaitIOName :: Env -> Name
printAndWaitMName :: Env -> Name
printAndWaitName :: Env -> Name
queryVarsIOName :: Env -> Name
breakpointIOName :: Env -> Name
queryVarsMName :: Env -> Name
breakpointMName :: Env -> Name
queryVarsName :: Env -> Name
breakpointName :: Env -> Name
fromListName :: Env -> Name
showLevName :: Env -> Name
captureVarsName :: 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 GhcRn))
-> EnvReader (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (GenLocated SrcSpanAnnA (HsExpr GhcRn))
forall a. Maybe a
Nothing
       else do
         let extractVarName :: HsExpr GhcRn -> Maybe LexicalFastString
extractVarName (Ghc.HsLit XLitE GhcRn
_ (Ghc.HsString XHsString GhcRn
_ 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 GhcRn
_ (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 GhcRn
_ = Maybe LexicalFastString
forall a. Maybe a
Nothing

             varsToExclude :: [LexicalFastString]
varsToExclude =
               (GenLocated SrcSpanAnnA (HsExpr GhcRn) -> Maybe LexicalFastString)
-> [GenLocated SrcSpanAnnA (HsExpr GhcRn)] -> [LexicalFastString]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (HsExpr GhcRn -> Maybe LexicalFastString
extractVarName (HsExpr GhcRn -> Maybe LexicalFastString)
-> (GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn)
-> GenLocated SrcSpanAnnA (HsExpr GhcRn)
-> Maybe LexicalFastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsExpr GhcRn) -> HsExpr GhcRn
forall l e. GenLocated l e -> e
Ghc.unLoc) [LHsExpr GhcRn]
[GenLocated SrcSpanAnnA (HsExpr GhcRn)]
exprsToExclude

         GenLocated SrcSpanAnnA (HsExpr GhcRn)
-> Maybe (GenLocated SrcSpanAnnA (HsExpr GhcRn))
forall a. a -> Maybe a
Just (GenLocated SrcSpanAnnA (HsExpr GhcRn)
 -> Maybe (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> WriterT
     Any (ReaderT Env TcM) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> EnvReader (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
           (ReaderT Env TcM (GenLocated SrcSpanAnnA (HsExpr GhcRn), Any)
 -> ReaderT Env TcM (GenLocated SrcSpanAnnA (HsExpr GhcRn), Any))
-> WriterT
     Any (ReaderT Env TcM) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> WriterT
     Any (ReaderT Env TcM) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
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 GhcRn), Any)
-> ReaderT Env TcM (GenLocated SrcSpanAnnA (HsExpr GhcRn), 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 GhcRn)
-> WriterT
     Any (ReaderT Env TcM) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
forall a. Data a => a -> EnvReader a
recurse LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
innerExpr)
hsAppCase LHsExpr GhcRn
_ = Maybe (GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> EnvReader (Maybe (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (GenLocated SrcSpanAnnA (HsExpr GhcRn))
forall a. Maybe a
Nothing

--------------------------------------------------------------------------------
-- Match
--------------------------------------------------------------------------------

matchCase :: Ghc.Match Ghc.GhcRn (Ghc.LHsExpr Ghc.GhcRn)
          -> EnvReader (Maybe (Ghc.Match Ghc.GhcRn (Ghc.LHsExpr Ghc.GhcRn)))
matchCase :: Match GhcRn (LHsExpr GhcRn)
-> EnvReader (Maybe (Match GhcRn (LHsExpr GhcRn)))
matchCase Ghc.Match {[LPat GhcRn]
XCMatch GhcRn (LHsExpr GhcRn)
GRHSs GhcRn (LHsExpr GhcRn)
HsMatchContext GhcRn
m_ext :: XCMatch GhcRn (LHsExpr GhcRn)
m_ctxt :: HsMatchContext GhcRn
m_pats :: [LPat GhcRn]
m_grhss :: GRHSs GhcRn (LHsExpr GhcRn)
m_grhss :: forall p body. Match p body -> GRHSs p body
m_pats :: forall p body. Match p body -> [LPat p]
m_ctxt :: forall p body. Match p body -> HsMatchContext p
m_ext :: forall p body. Match p body -> XCMatch p body
..} = do
#if MIN_VERSION_ghc(9,12,0)
  let names = (foldMap . foldMap) extractVarPats m_pats
#else
  let names :: VarSet
names = (GenLocated SrcSpanAnnA (Pat GhcRn) -> VarSet)
-> [GenLocated SrcSpanAnnA (Pat GhcRn)] -> 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 GhcRn -> VarSet
GenLocated SrcSpanAnnA (Pat GhcRn) -> VarSet
extractVarPats [LPat GhcRn]
[GenLocated SrcSpanAnnA (Pat GhcRn)]
m_pats
#endif
  GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
grhRes <- VarSet
-> EnvReader (GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> EnvReader (GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
forall a. VarSet -> EnvReader a -> EnvReader a
addScopedVars VarSet
names (EnvReader (GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
 -> EnvReader (GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
-> EnvReader (GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> EnvReader (GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
forall a b. (a -> b) -> a -> b
$ GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> EnvReader (GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
forall a. Data a => a -> EnvReader a
recurse GRHSs GhcRn (LHsExpr GhcRn)
GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
m_grhss
  Maybe (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> EnvReader
     (Maybe (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
 -> EnvReader
      (Maybe (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))))
-> Maybe (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> EnvReader
     (Maybe (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
forall a b. (a -> b) -> a -> b
$ Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> Maybe (Match GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
forall a. a -> Maybe a
Just
    Ghc.Match { m_grhss :: GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
Ghc.m_grhss = GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
grhRes, [LPat GhcRn]
XCMatch GhcRn (LHsExpr GhcRn)
XCMatch GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
HsMatchContext GhcRn
m_ext :: XCMatch GhcRn (LHsExpr GhcRn)
m_ctxt :: HsMatchContext GhcRn
m_pats :: [LPat GhcRn]
m_pats :: [LPat GhcRn]
m_ctxt :: HsMatchContext GhcRn
m_ext :: XCMatch GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
.. }

extractVarPats :: Ghc.LPat Ghc.GhcRn -> VarSet
extractVarPats :: LPat GhcRn -> VarSet
extractVarPats = [Name] -> VarSet
mkVarSet ([Name] -> VarSet)
-> (GenLocated SrcSpanAnnA (Pat GhcRn) -> [Name])
-> GenLocated SrcSpanAnnA (Pat GhcRn)
-> VarSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LPat GhcRn -> [Name]
GenLocated SrcSpanAnnA (Pat GhcRn) -> [Name]
Ghc.collectPatBinders'

--------------------------------------------------------------------------------
-- Guarded Right-hand Sides
--------------------------------------------------------------------------------

grhssCase :: Ghc.GRHSs Ghc.GhcRn (Ghc.LHsExpr Ghc.GhcRn)
         -> EnvReader (Maybe (Ghc.GRHSs Ghc.GhcRn (Ghc.LHsExpr Ghc.GhcRn)))
grhssCase :: GRHSs GhcRn (LHsExpr GhcRn)
-> EnvReader (Maybe (GRHSs GhcRn (LHsExpr GhcRn)))
grhssCase Ghc.GRHSs {[LGRHS GhcRn (LHsExpr GhcRn)]
XCGRHSs GhcRn (LHsExpr GhcRn)
HsLocalBinds GhcRn
grhssExt :: XCGRHSs GhcRn (LHsExpr GhcRn)
grhssGRHSs :: [LGRHS GhcRn (LHsExpr GhcRn)]
grhssLocalBinds :: HsLocalBinds GhcRn
grhssLocalBinds :: forall p body. GRHSs p body -> HsLocalBinds p
grhssGRHSs :: forall p body. GRHSs p body -> [LGRHS p body]
grhssExt :: forall p body. GRHSs p body -> XCGRHSs p body
..} = do
  (HsLocalBinds GhcRn
localBindsRes, VarSet
names)
    <- HsLocalBinds GhcRn -> EnvReader (HsLocalBinds GhcRn, VarSet)
dealWithLocalBinds
         HsLocalBinds GhcRn
grhssLocalBinds

  [GenLocated
   (SrcAnn NoEpAnns)
   (GRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
grhsRes <- VarSet
-> EnvReader
     [GenLocated
        (SrcAnn NoEpAnns)
        (GRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> EnvReader
     [GenLocated
        (SrcAnn NoEpAnns)
        (GRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
forall a. VarSet -> EnvReader a -> EnvReader a
addScopedVars VarSet
names (EnvReader
   [GenLocated
      (SrcAnn NoEpAnns)
      (GRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
 -> EnvReader
      [GenLocated
         (SrcAnn NoEpAnns)
         (GRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))])
-> EnvReader
     [GenLocated
        (SrcAnn NoEpAnns)
        (GRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> EnvReader
     [GenLocated
        (SrcAnn NoEpAnns)
        (GRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
forall a b. (a -> b) -> a -> b
$ [GenLocated
   (SrcAnn NoEpAnns)
   (GRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> EnvReader
     [GenLocated
        (SrcAnn NoEpAnns)
        (GRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
forall a. Data a => a -> EnvReader a
recurse [LGRHS GhcRn (LHsExpr GhcRn)]
[GenLocated
   (SrcAnn NoEpAnns)
   (GRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
grhssGRHSs
  Maybe (GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> EnvReader
     (Maybe (GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
 -> EnvReader
      (Maybe (GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))))
-> Maybe (GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> EnvReader
     (Maybe (GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
forall a b. (a -> b) -> a -> b
$ GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> Maybe (GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
forall a. a -> Maybe a
Just
    Ghc.GRHSs { grhssGRHSs :: [LGRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))]
Ghc.grhssGRHSs = [LGRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))]
[GenLocated
   (SrcAnn NoEpAnns)
   (GRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
grhsRes
              , grhssLocalBinds :: HsLocalBinds GhcRn
grhssLocalBinds = HsLocalBinds GhcRn
localBindsRes
              , XCGRHSs GhcRn (LHsExpr GhcRn)
XCGRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
grhssExt :: XCGRHSs GhcRn (LHsExpr GhcRn)
grhssExt :: XCGRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
..
              }

dealWithBind :: VarSet
             -> Ghc.LHsBind Ghc.GhcRn
             -> EnvReader (Ghc.LHsBind Ghc.GhcRn)
dealWithBind :: VarSet -> LHsBind GhcRn -> EnvReader (LHsBind GhcRn)
dealWithBind VarSet
resultNames LHsBind GhcRn
lbind = GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn)
-> (HsBindLR GhcRn GhcRn
    -> WriterT Any (ReaderT Env TcM) (HsBindLR GhcRn GhcRn))
-> WriterT
     Any
     (ReaderT Env TcM)
     (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for LHsBind GhcRn
GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn)
lbind ((HsBindLR GhcRn GhcRn
  -> WriterT Any (ReaderT Env TcM) (HsBindLR GhcRn GhcRn))
 -> WriterT
      Any
      (ReaderT Env TcM)
      (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn)))
-> (HsBindLR GhcRn GhcRn
    -> WriterT Any (ReaderT Env TcM) (HsBindLR GhcRn GhcRn))
-> WriterT
     Any
     (ReaderT Env TcM)
     (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn))
forall a b. (a -> b) -> a -> b
$ \case
  Ghc.FunBind {XFunBind GhcRn GhcRn
LIdP GhcRn
MatchGroup GhcRn (LHsExpr GhcRn)
fun_ext :: XFunBind GhcRn GhcRn
fun_id :: LIdP GhcRn
fun_matches :: MatchGroup GhcRn (LHsExpr GhcRn)
fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_ext :: forall idL idR. HsBindLR idL idR -> XFunBind idL 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 GhcRn
GenLocated SrcSpanAnnN Name
fun_id) VarSet
resultNames
    (MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
matchesRes, Any Bool
containsTarget)
      <- WriterT
  Any
  (ReaderT Env TcM)
  (MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> WriterT
     Any
     (ReaderT Env TcM)
     (MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)), 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 GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
 -> WriterT
      Any
      (ReaderT Env TcM)
      (MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)), Any))
-> (WriterT
      Any
      (ReaderT Env TcM)
      (MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    -> WriterT
         Any
         (ReaderT Env TcM)
         (MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
-> WriterT
     Any
     (ReaderT Env TcM)
     (MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> WriterT
     Any
     (ReaderT Env TcM)
     (MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)), Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarSet
-> WriterT
     Any
     (ReaderT Env TcM)
     (MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> WriterT
     Any
     (ReaderT Env TcM)
     (MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
forall a. VarSet -> EnvReader a -> EnvReader a
addScopedVars VarSet
resultNamesSansSelf
       (WriterT
   Any
   (ReaderT Env TcM)
   (MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
 -> WriterT
      Any
      (ReaderT Env TcM)
      (MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)), Any))
-> WriterT
     Any
     (ReaderT Env TcM)
     (MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> WriterT
     Any
     (ReaderT Env TcM)
     (MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)), Any)
forall a b. (a -> b) -> a -> b
$ MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> WriterT
     Any
     (ReaderT Env TcM)
     (MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
forall a. Data a => a -> EnvReader a
recurse MatchGroup GhcRn (LHsExpr GhcRn)
MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
fun_matches
    -- be sure to use the result names on the right so that they are overriden
    -- by any shadowing vars inside the expr.
    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 GhcRn GhcRn
UniqSet Name
fun_ext
          | Bool
otherwise = XFunBind GhcRn GhcRn
UniqSet Name
fun_ext
    HsBindLR GhcRn GhcRn
-> WriterT Any (ReaderT Env TcM) (HsBindLR GhcRn GhcRn)
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ghc.FunBind { fun_matches :: MatchGroup GhcRn (LHsExpr GhcRn)
Ghc.fun_matches = MatchGroup GhcRn (LHsExpr GhcRn)
MatchGroup GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
matchesRes, fun_ext :: XFunBind GhcRn GhcRn
Ghc.fun_ext = XFunBind GhcRn GhcRn
UniqSet Name
rhsVars, LIdP GhcRn
fun_id :: LIdP GhcRn
fun_id :: LIdP GhcRn
.. }

  Ghc.PatBind {XPatBind GhcRn GhcRn
LPat GhcRn
GRHSs GhcRn (LHsExpr GhcRn)
pat_ext :: XPatBind GhcRn GhcRn
pat_lhs :: LPat GhcRn
pat_rhs :: GRHSs GhcRn (LHsExpr GhcRn)
pat_rhs :: forall idL idR. HsBindLR idL idR -> GRHSs idR (LHsExpr idR)
pat_lhs :: forall idL idR. HsBindLR idL idR -> LPat idL
pat_ext :: forall idL idR. HsBindLR idL idR -> XPatBind idL idR
..} -> do
    (GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
rhsRes, Any Bool
containsTarget)
      <- EnvReader (GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> WriterT
     Any
     (ReaderT Env TcM)
     (GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)), Any)
forall w (m :: * -> *) a.
(Monoid w, Monad m) =>
WriterT w m a -> WriterT w m (a, w)
listen
       (EnvReader (GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
 -> WriterT
      Any
      (ReaderT Env TcM)
      (GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)), Any))
-> (EnvReader (GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
    -> EnvReader (GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
-> EnvReader (GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> WriterT
     Any
     (ReaderT Env TcM)
     (GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)), Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarSet
-> EnvReader (GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> EnvReader (GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
forall a. VarSet -> EnvReader a -> EnvReader a
addScopedVars VarSet
resultNames
       (EnvReader (GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
 -> WriterT
      Any
      (ReaderT Env TcM)
      (GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)), Any))
-> EnvReader (GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> WriterT
     Any
     (ReaderT Env TcM)
     (GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)), Any)
forall a b. (a -> b) -> a -> b
$ GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> EnvReader (GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
forall a. Data a => a -> EnvReader a
recurse GRHSs GhcRn (LHsExpr GhcRn)
GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
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 GhcRn GhcRn
UniqSet Name
pat_ext
          | Bool
otherwise = XPatBind GhcRn GhcRn
UniqSet Name
pat_ext
    HsBindLR GhcRn GhcRn
-> WriterT Any (ReaderT Env TcM) (HsBindLR GhcRn GhcRn)
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ghc.PatBind { pat_rhs :: GRHSs GhcRn (LHsExpr GhcRn)
Ghc.pat_rhs = GRHSs GhcRn (LHsExpr GhcRn)
GRHSs GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
rhsRes, pat_ext :: XPatBind GhcRn GhcRn
pat_ext = XPatBind GhcRn GhcRn
UniqSet Name
rhsVars, LPat GhcRn
pat_lhs :: LPat GhcRn
pat_lhs :: LPat GhcRn
.. }

  -- Does this not occur in the renamer?
  Ghc.VarBind {XVarBind GhcRn GhcRn
IdP GhcRn
LHsExpr GhcRn
var_ext :: XVarBind GhcRn GhcRn
var_id :: IdP GhcRn
var_rhs :: LHsExpr GhcRn
var_rhs :: forall idL idR. HsBindLR idL idR -> LHsExpr idR
var_id :: forall idL idR. HsBindLR idL idR -> IdP idL
var_ext :: forall idL idR. HsBindLR idL idR -> XVarBind idL idR
..} -> do
    GenLocated SrcSpanAnnA (HsExpr GhcRn)
rhsRes
      <- VarSet
-> WriterT
     Any (ReaderT Env TcM) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> WriterT
     Any (ReaderT Env TcM) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
forall a. VarSet -> EnvReader a -> EnvReader a
addScopedVars VarSet
resultNames
       (WriterT
   Any (ReaderT Env TcM) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
 -> WriterT
      Any (ReaderT Env TcM) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> WriterT
     Any (ReaderT Env TcM) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> WriterT
     Any (ReaderT Env TcM) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcRn)
-> WriterT
     Any (ReaderT Env TcM) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
forall a. Data a => a -> EnvReader a
recurse LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
var_rhs
    HsBindLR GhcRn GhcRn
-> WriterT Any (ReaderT Env TcM) (HsBindLR GhcRn GhcRn)
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ghc.VarBind { var_rhs :: LHsExpr GhcRn
Ghc.var_rhs = LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
rhsRes, XVarBind GhcRn GhcRn
IdP GhcRn
var_ext :: XVarBind GhcRn GhcRn
var_id :: IdP GhcRn
var_id :: IdP GhcRn
var_ext :: XVarBind GhcRn GhcRn
.. }

  Ghc.PatSynBind XPatSynBind GhcRn GhcRn
x Ghc.PSB {XPSB GhcRn GhcRn
LIdP GhcRn
LPat GhcRn
HsPatSynDetails GhcRn
HsPatSynDir GhcRn
psb_ext :: XPSB GhcRn GhcRn
psb_id :: LIdP GhcRn
psb_args :: HsPatSynDetails GhcRn
psb_def :: LPat GhcRn
psb_dir :: HsPatSynDir GhcRn
psb_dir :: forall idL idR. PatSynBind idL idR -> HsPatSynDir idR
psb_def :: forall idL idR. PatSynBind idL idR -> LPat idR
psb_args :: forall idL idR. PatSynBind idL idR -> HsPatSynDetails idR
psb_id :: forall idL idR. PatSynBind idL idR -> LIdP idL
psb_ext :: forall idL idR. PatSynBind idL idR -> XPSB idL idR
..} -> do
    (GenLocated SrcSpanAnnA (Pat GhcRn)
defRes, Any Bool
containsTarget)
      <- WriterT Any (ReaderT Env TcM) (GenLocated SrcSpanAnnA (Pat GhcRn))
-> WriterT
     Any (ReaderT Env TcM) (GenLocated SrcSpanAnnA (Pat GhcRn), 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 GhcRn))
 -> WriterT
      Any (ReaderT Env TcM) (GenLocated SrcSpanAnnA (Pat GhcRn), Any))
-> (WriterT
      Any (ReaderT Env TcM) (GenLocated SrcSpanAnnA (Pat GhcRn))
    -> WriterT
         Any (ReaderT Env TcM) (GenLocated SrcSpanAnnA (Pat GhcRn)))
-> WriterT
     Any (ReaderT Env TcM) (GenLocated SrcSpanAnnA (Pat GhcRn))
-> WriterT
     Any (ReaderT Env TcM) (GenLocated SrcSpanAnnA (Pat GhcRn), Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarSet
-> WriterT
     Any (ReaderT Env TcM) (GenLocated SrcSpanAnnA (Pat GhcRn))
-> WriterT
     Any (ReaderT Env TcM) (GenLocated SrcSpanAnnA (Pat GhcRn))
forall a. VarSet -> EnvReader a -> EnvReader a
addScopedVars VarSet
resultNames
       (WriterT Any (ReaderT Env TcM) (GenLocated SrcSpanAnnA (Pat GhcRn))
 -> WriterT
      Any (ReaderT Env TcM) (GenLocated SrcSpanAnnA (Pat GhcRn), Any))
-> WriterT
     Any (ReaderT Env TcM) (GenLocated SrcSpanAnnA (Pat GhcRn))
-> WriterT
     Any (ReaderT Env TcM) (GenLocated SrcSpanAnnA (Pat GhcRn), Any)
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (Pat GhcRn)
-> WriterT
     Any (ReaderT Env TcM) (GenLocated SrcSpanAnnA (Pat GhcRn))
forall a. Data a => a -> EnvReader a
recurse LPat GhcRn
GenLocated SrcSpanAnnA (Pat GhcRn)
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 GhcRn GhcRn
UniqSet Name
psb_ext
          | Bool
otherwise = XPSB GhcRn GhcRn
UniqSet Name
psb_ext
    HsBindLR GhcRn GhcRn
-> WriterT Any (ReaderT Env TcM) (HsBindLR GhcRn GhcRn)
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsBindLR GhcRn GhcRn
 -> WriterT Any (ReaderT Env TcM) (HsBindLR GhcRn GhcRn))
-> HsBindLR GhcRn GhcRn
-> WriterT Any (ReaderT Env TcM) (HsBindLR GhcRn GhcRn)
forall a b. (a -> b) -> a -> b
$ XPatSynBind GhcRn GhcRn
-> PatSynBind GhcRn GhcRn -> HsBindLR GhcRn GhcRn
forall idL idR.
XPatSynBind idL idR -> PatSynBind idL idR -> HsBindLR idL idR
Ghc.PatSynBind XPatSynBind GhcRn GhcRn
x Ghc.PSB { psb_def :: LPat GhcRn
psb_def = LPat GhcRn
GenLocated SrcSpanAnnA (Pat GhcRn)
defRes, psb_ext :: XPSB GhcRn GhcRn
psb_ext = XPSB GhcRn GhcRn
UniqSet Name
rhsVars, LIdP GhcRn
HsPatSynDetails GhcRn
HsPatSynDir GhcRn
psb_id :: LIdP GhcRn
psb_args :: HsPatSynDetails GhcRn
psb_dir :: HsPatSynDir GhcRn
psb_dir :: HsPatSynDir GhcRn
psb_args :: HsPatSynDetails GhcRn
psb_id :: LIdP GhcRn
.. }

grhsCase :: Ghc.GRHS Ghc.GhcRn (Ghc.LHsExpr Ghc.GhcRn)
         -> EnvReader (Maybe (Ghc.GRHS Ghc.GhcRn (Ghc.LHsExpr Ghc.GhcRn)))
grhsCase :: GRHS GhcRn (LHsExpr GhcRn)
-> EnvReader (Maybe (GRHS GhcRn (LHsExpr GhcRn)))
grhsCase (Ghc.GRHS XCGRHS GhcRn (LHsExpr GhcRn)
x [GuardLStmt GhcRn]
guards LHsExpr GhcRn
body) = do
  ([GenLocated
   (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
   (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
guardsRes, VarSet
names) <- WriterT
  VarSet
  (WriterT Any (ReaderT Env TcM))
  [GenLocated
     (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
     (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> WriterT
     Any
     (ReaderT Env TcM)
     ([GenLocated
         (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
         (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))],
      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 GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
      (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
 -> WriterT
      Any
      (ReaderT Env TcM)
      ([GenLocated
          (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
          (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))],
       VarSet))
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env TcM))
     [GenLocated
        (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
        (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> WriterT
     Any
     (ReaderT Env TcM)
     ([GenLocated
         (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
         (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))],
      VarSet)
forall a b. (a -> b) -> a -> b
$ [LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))]
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env TcM))
     [LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))]
forall body.
(Data body, Data (Stmt GhcRn body)) =>
[LStmt GhcRn body]
-> WriterT
     VarSet (WriterT Any (ReaderT Env TcM)) [LStmt GhcRn body]
dealWithStatements [GuardLStmt GhcRn]
[LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))]
guards
  GenLocated SrcSpanAnnA (HsExpr GhcRn)
bodyRes <- VarSet
-> WriterT
     Any (ReaderT Env TcM) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> WriterT
     Any (ReaderT Env TcM) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
forall a. VarSet -> EnvReader a -> EnvReader a
addScopedVars VarSet
names (WriterT
   Any (ReaderT Env TcM) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
 -> WriterT
      Any (ReaderT Env TcM) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> WriterT
     Any (ReaderT Env TcM) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> WriterT
     Any (ReaderT Env TcM) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcRn)
-> WriterT
     Any (ReaderT Env TcM) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
forall a. Data a => a -> EnvReader a
recurse LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
body
  Maybe (GRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> EnvReader
     (Maybe (GRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (GRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
 -> EnvReader
      (Maybe (GRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))))
-> (GRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
    -> Maybe (GRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
-> GRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> EnvReader
     (Maybe (GRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> Maybe (GRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
forall a. a -> Maybe a
Just (GRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
 -> EnvReader
      (Maybe (GRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))))
-> GRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> EnvReader
     (Maybe (GRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
forall a b. (a -> b) -> a -> b
$ XCGRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> [GuardLStmt GhcRn]
-> GenLocated SrcSpanAnnA (HsExpr GhcRn)
-> GRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
Ghc.GRHS XCGRHS GhcRn (LHsExpr GhcRn)
XCGRHS GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))
x [GuardLStmt GhcRn]
[GenLocated
   (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
   (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
guardsRes GenLocated SrcSpanAnnA (HsExpr GhcRn)
bodyRes

--------------------------------------------------------------------------------
-- Let Binds (Non-do)
--------------------------------------------------------------------------------

-- TODO could combine with hsVar case to allow for "quick failure"
hsLetCase :: Ghc.HsExpr Ghc.GhcRn
          -> EnvReader (Maybe (Ghc.HsExpr Ghc.GhcRn))
hsLetCase :: HsExpr GhcRn -> EnvReader (Maybe (HsExpr GhcRn))
hsLetCase (Ghc.HsLet' XLet GhcRn
x LetToken
letToken HsLocalBinds GhcRn
localBinds InToken
inToken LHsExpr GhcRn
inExpr) = do
  (HsLocalBinds GhcRn
bindsRes, VarSet
names) <- HsLocalBinds GhcRn -> EnvReader (HsLocalBinds GhcRn, VarSet)
dealWithLocalBinds HsLocalBinds GhcRn
localBinds

  GenLocated SrcSpanAnnA (HsExpr GhcRn)
inExprRes <- VarSet
-> WriterT
     Any (ReaderT Env TcM) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> WriterT
     Any (ReaderT Env TcM) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
forall a. VarSet -> EnvReader a -> EnvReader a
addScopedVars VarSet
names (WriterT
   Any (ReaderT Env TcM) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
 -> WriterT
      Any (ReaderT Env TcM) (GenLocated SrcSpanAnnA (HsExpr GhcRn)))
-> WriterT
     Any (ReaderT Env TcM) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
-> WriterT
     Any (ReaderT Env TcM) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr GhcRn)
-> WriterT
     Any (ReaderT Env TcM) (GenLocated SrcSpanAnnA (HsExpr GhcRn))
forall a. Data a => a -> EnvReader a
recurse LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
inExpr
  Maybe (HsExpr GhcRn) -> EnvReader (Maybe (HsExpr GhcRn))
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (HsExpr GhcRn) -> EnvReader (Maybe (HsExpr GhcRn)))
-> (HsExpr GhcRn -> Maybe (HsExpr GhcRn))
-> HsExpr GhcRn
-> EnvReader (Maybe (HsExpr GhcRn))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcRn -> Maybe (HsExpr GhcRn)
forall a. a -> Maybe a
Just (HsExpr GhcRn -> EnvReader (Maybe (HsExpr GhcRn)))
-> HsExpr GhcRn -> EnvReader (Maybe (HsExpr GhcRn))
forall a b. (a -> b) -> a -> b
$
    XLet GhcRn
-> LetToken
-> HsLocalBinds GhcRn
-> InToken
-> LHsExpr GhcRn
-> HsExpr GhcRn
Ghc.HsLet' XLet GhcRn
x LetToken
letToken HsLocalBinds GhcRn
bindsRes InToken
inToken LHsExpr GhcRn
GenLocated SrcSpanAnnA (HsExpr GhcRn)
inExprRes
hsLetCase HsExpr GhcRn
_ = Maybe (HsExpr GhcRn) -> EnvReader (Maybe (HsExpr GhcRn))
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (HsExpr GhcRn)
forall a. Maybe a
Nothing

dealWithLocalBinds
  :: Ghc.HsLocalBinds Ghc.GhcRn
  -> EnvReader (Ghc.HsLocalBinds Ghc.GhcRn, VarSet)
dealWithLocalBinds :: HsLocalBinds GhcRn -> EnvReader (HsLocalBinds GhcRn, VarSet)
dealWithLocalBinds = \case
  hlb :: HsLocalBinds GhcRn
hlb@(Ghc.HsValBinds XHsValBinds GhcRn GhcRn
x HsValBindsLR GhcRn GhcRn
valBinds) -> case HsValBindsLR GhcRn GhcRn
valBinds of
    Ghc.ValBinds{} -> (HsLocalBinds GhcRn, VarSet)
-> EnvReader (HsLocalBinds GhcRn, VarSet)
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsLocalBinds GhcRn
hlb, VarSet
forall a. Monoid a => a
mempty)
    Ghc.XValBindsLR (Ghc.NValBinds [(RecFlag, LHsBinds GhcRn)]
bindPairs [LSig GhcRn]
sigs) -> do
      let binds :: [LHsBind GhcRn]
binds = Bag (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn))
-> [Item (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn)))]
Bag (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn))
-> [LHsBind GhcRn]
forall l. IsList l => l -> [Item l]
toList
                (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn))
 -> [LHsBind GhcRn])
-> ([Bag (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn))]
    -> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn)))
-> [Bag (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn))]
-> [LHsBind GhcRn]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Bag (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn))]
-> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn))
forall a. Monoid a => [a] -> a
mconcat
                ([Bag (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn))]
 -> [LHsBind GhcRn])
-> [Bag (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn))]
-> [LHsBind GhcRn]
forall a b. (a -> b) -> a -> b
$ ((RecFlag, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn)))
 -> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn)))
-> [(RecFlag, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn)))]
-> [Bag (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn))]
forall a b. (a -> b) -> [a] -> [b]
map (RecFlag, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn)))
-> Bag (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn))
forall a b. (a, b) -> b
snd [(RecFlag, LHsBinds GhcRn)]
[(RecFlag, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn)))]
bindPairs :: [Ghc.LHsBind Ghc.GhcRn]
          names :: [[Name]]
names = (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn) -> [Name])
-> [GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn)] -> [[Name]]
forall a b. (a -> b) -> [a] -> [b]
map ((HsBindLR GhcRn GhcRn -> [Name])
-> GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn) -> [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 GhcRn GhcRn -> [Name]
forall idR. HsBindLR GhcRn idR -> [Name]
Ghc.collectHsBindBinders')
                      [LHsBind GhcRn]
[GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn)]
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 GhcRn GhcRn), [Name])]
resBindsWithNames, Any Bool
containsTarget)
        <- WriterT
  Any
  (ReaderT Env TcM)
  [(GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn), [Name])]
-> WriterT
     Any
     (ReaderT Env TcM)
     ([(GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn), [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 GhcRn GhcRn), [Name])]
 -> WriterT
      Any
      (ReaderT Env TcM)
      ([(GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn), [Name])], Any))
-> (WriterT
      Any
      (ReaderT Env TcM)
      [GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn)]
    -> WriterT
         Any
         (ReaderT Env TcM)
         [(GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn), [Name])])
-> WriterT
     Any
     (ReaderT Env TcM)
     [GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn)]
-> WriterT
     Any
     (ReaderT Env TcM)
     ([(GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn), [Name])], Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn)]
 -> [(GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn), [Name])])
-> WriterT
     Any
     (ReaderT Env TcM)
     [GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn)]
-> WriterT
     Any
     (ReaderT Env TcM)
     [(GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn), [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 GhcRn GhcRn)]
-> [[Name]]
-> [(GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn), [Name])]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [[Name]]
names)
         (WriterT
   Any
   (ReaderT Env TcM)
   [GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn)]
 -> WriterT
      Any
      (ReaderT Env TcM)
      ([(GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn), [Name])], Any))
-> WriterT
     Any
     (ReaderT Env TcM)
     [GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn)]
-> WriterT
     Any
     (ReaderT Env TcM)
     ([(GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn), [Name])], Any)
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn)
 -> WriterT
      Any
      (ReaderT Env TcM)
      (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn)))
-> [GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn)]
-> WriterT
     Any
     (ReaderT Env TcM)
     [GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn)]
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 GhcRn -> EnvReader (LHsBind GhcRn)
dealWithBind VarSet
resultNames) [LHsBind GhcRn]
[GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn)]
binds

      if Bool -> Bool
not Bool
containsTarget
         then (HsLocalBinds GhcRn, VarSet)
-> EnvReader (HsLocalBinds GhcRn, VarSet)
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsLocalBinds GhcRn
hlb, VarSet
resultNames) -- if no bind contained the target then we're done
         else do
           -- Need to reorder the binds because the variables references on the
           -- RHS of some binds have changed
           let mkTuple :: (t (HsBindLR GhcRn GhcRn), b)
-> (t (HsBindLR GhcRn GhcRn), b, UniqSet Name)
mkTuple (t (HsBindLR GhcRn GhcRn)
bind, b
ns)
                 = (t (HsBindLR GhcRn GhcRn)
bind, b
ns, (HsBindLR GhcRn GhcRn -> UniqSet Name)
-> t (HsBindLR GhcRn GhcRn) -> 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 GhcRn GhcRn -> UniqSet Name
getRhsFreeVars t (HsBindLR GhcRn GhcRn)
bind)

               finalResult :: [(RecFlag, LHsBinds GhcRn)]
finalResult = [(LHsBind GhcRn, [Name], UniqSet Name)]
-> [(RecFlag, LHsBinds GhcRn)]
depAnalBinds ([(LHsBind GhcRn, [Name], UniqSet Name)]
 -> [(RecFlag, LHsBinds GhcRn)])
-> [(LHsBind GhcRn, [Name], UniqSet Name)]
-> [(RecFlag, LHsBinds GhcRn)]
forall a b. (a -> b) -> a -> b
$ (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn), [Name])
-> (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn), [Name],
    UniqSet Name)
forall {t :: * -> *} {b}.
Foldable t =>
(t (HsBindLR GhcRn GhcRn), b)
-> (t (HsBindLR GhcRn GhcRn), b, UniqSet Name)
mkTuple ((GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn), [Name])
 -> (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn), [Name],
     UniqSet Name))
-> [(GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn), [Name])]
-> [(GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn), [Name],
     UniqSet Name)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn), [Name])]
resBindsWithNames

           (HsLocalBinds GhcRn, VarSet)
-> EnvReader (HsLocalBinds GhcRn, VarSet)
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ( XHsValBinds GhcRn GhcRn
-> HsValBindsLR GhcRn GhcRn -> HsLocalBinds GhcRn
forall idL idR.
XHsValBinds idL idR
-> HsValBindsLR idL idR -> HsLocalBindsLR idL idR
Ghc.HsValBinds XHsValBinds GhcRn GhcRn
x
                    (HsValBindsLR GhcRn GhcRn -> HsLocalBinds GhcRn)
-> HsValBindsLR GhcRn GhcRn -> HsLocalBinds GhcRn
forall a b. (a -> b) -> a -> b
$ XXValBindsLR GhcRn GhcRn -> HsValBindsLR GhcRn GhcRn
forall idL idR. XXValBindsLR idL idR -> HsValBindsLR idL idR
Ghc.XValBindsLR
                        (XXValBindsLR GhcRn GhcRn -> HsValBindsLR GhcRn GhcRn)
-> XXValBindsLR GhcRn GhcRn -> HsValBindsLR GhcRn GhcRn
forall a b. (a -> b) -> a -> b
$ [(RecFlag, LHsBinds GhcRn)] -> [LSig GhcRn] -> NHsValBindsLR GhcRn
forall idL.
[(RecFlag, LHsBinds idL)] -> [LSig GhcRn] -> NHsValBindsLR idL
Ghc.NValBinds [(RecFlag, LHsBinds GhcRn)]
finalResult [LSig GhcRn]
sigs
                , VarSet
resultNames
                )

  x :: HsLocalBinds GhcRn
x@(Ghc.HsIPBinds XHsIPBinds GhcRn GhcRn
_ HsIPBinds GhcRn
_) -> (HsLocalBinds GhcRn, VarSet)
-> EnvReader (HsLocalBinds GhcRn, VarSet)
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsLocalBinds GhcRn
x, VarSet
forall a. Monoid a => a
mempty) -- TODO ImplicitParams

  HsLocalBinds GhcRn
other -> (HsLocalBinds GhcRn, VarSet)
-> EnvReader (HsLocalBinds GhcRn, VarSet)
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsLocalBinds GhcRn
other, VarSet
forall a. Monoid a => a
mempty)

getRhsFreeVars :: Ghc.HsBind Ghc.GhcRn -> Ghc.UniqSet Ghc.Name
getRhsFreeVars :: HsBindLR GhcRn GhcRn -> UniqSet Name
getRhsFreeVars = \case
  Ghc.FunBind {XFunBind GhcRn GhcRn
LIdP GhcRn
MatchGroup GhcRn (LHsExpr GhcRn)
fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_ext :: forall idL idR. HsBindLR idL idR -> XFunBind idL idR
fun_ext :: XFunBind GhcRn GhcRn
fun_id :: LIdP GhcRn
fun_matches :: MatchGroup GhcRn (LHsExpr GhcRn)
..} -> XFunBind GhcRn GhcRn
UniqSet Name
fun_ext
  Ghc.PatBind {XPatBind GhcRn GhcRn
LPat GhcRn
GRHSs GhcRn (LHsExpr GhcRn)
pat_rhs :: forall idL idR. HsBindLR idL idR -> GRHSs idR (LHsExpr idR)
pat_lhs :: forall idL idR. HsBindLR idL idR -> LPat idL
pat_ext :: forall idL idR. HsBindLR idL idR -> XPatBind idL idR
pat_ext :: XPatBind GhcRn GhcRn
pat_lhs :: LPat GhcRn
pat_rhs :: GRHSs GhcRn (LHsExpr GhcRn)
..} -> XPatBind GhcRn GhcRn
UniqSet Name
pat_ext
  Ghc.PatSynBind XPatSynBind GhcRn GhcRn
_ Ghc.PSB {XPSB GhcRn GhcRn
LIdP GhcRn
LPat GhcRn
HsPatSynDetails GhcRn
HsPatSynDir GhcRn
psb_dir :: forall idL idR. PatSynBind idL idR -> HsPatSynDir idR
psb_def :: forall idL idR. PatSynBind idL idR -> LPat idR
psb_args :: forall idL idR. PatSynBind idL idR -> HsPatSynDetails idR
psb_id :: forall idL idR. PatSynBind idL idR -> LIdP idL
psb_ext :: forall idL idR. PatSynBind idL idR -> XPSB idL idR
psb_ext :: XPSB GhcRn GhcRn
psb_id :: LIdP GhcRn
psb_args :: HsPatSynDetails GhcRn
psb_def :: LPat GhcRn
psb_dir :: HsPatSynDir GhcRn
..} -> XPSB GhcRn GhcRn
UniqSet Name
psb_ext
  HsBindLR GhcRn GhcRn
_ -> UniqSet Name
forall a. Monoid a => a
mempty

--------------------------------------------------------------------------------
-- Do Block
--------------------------------------------------------------------------------

hsDoCase :: Ghc.HsExpr Ghc.GhcRn
         -> EnvReader (Maybe (Ghc.HsExpr Ghc.GhcRn))
-- TODO look at the context to determine if it's a recursive do
hsDoCase :: HsExpr GhcRn -> EnvReader (Maybe (HsExpr GhcRn))
hsDoCase (Ghc.HsDo XDo GhcRn
x HsDoFlavour
ctx XRec GhcRn [GuardLStmt GhcRn]
lStmts) = do
  (GenLocated
  SrcSpanAnnL
  [GenLocated
     SrcSpanAnnA (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
stmtsRes, VarSet
_) <- WriterT
  VarSet
  (WriterT Any (ReaderT Env TcM))
  (GenLocated
     SrcSpanAnnL
     [GenLocated
        SrcSpanAnnA (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))])
-> WriterT
     Any
     (ReaderT Env TcM)
     (GenLocated
        SrcSpanAnnL
        [GenLocated
           SrcSpanAnnA (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))],
      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 GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))])
 -> WriterT
      Any
      (ReaderT Env TcM)
      (GenLocated
         SrcSpanAnnL
         [GenLocated
            SrcSpanAnnA (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))],
       VarSet))
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env TcM))
     (GenLocated
        SrcSpanAnnL
        [GenLocated
           SrcSpanAnnA (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))])
-> WriterT
     Any
     (ReaderT Env TcM)
     (GenLocated
        SrcSpanAnnL
        [GenLocated
           SrcSpanAnnA (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))],
      VarSet)
forall a b. (a -> b) -> a -> b
$ GenLocated
  SrcSpanAnnL
  [GenLocated
     SrcSpanAnnA (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> ([GenLocated
       SrcSpanAnnA (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
    -> WriterT
         VarSet
         (WriterT Any (ReaderT Env TcM))
         [GenLocated
            SrcSpanAnnA (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))])
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env TcM))
     (GenLocated
        SrcSpanAnnL
        [GenLocated
           SrcSpanAnnA (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for XRec GhcRn [GuardLStmt GhcRn]
GenLocated
  SrcSpanAnnL
  [GenLocated
     SrcSpanAnnA (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
lStmts [LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))]
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env TcM))
     [LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))]
[GenLocated
   SrcSpanAnnA (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env TcM))
     [GenLocated
        SrcSpanAnnA (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
forall body.
(Data body, Data (Stmt GhcRn body)) =>
[LStmt GhcRn body]
-> WriterT
     VarSet (WriterT Any (ReaderT Env TcM)) [LStmt GhcRn body]
dealWithStatements
  Maybe (HsExpr GhcRn) -> EnvReader (Maybe (HsExpr GhcRn))
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (HsExpr GhcRn) -> EnvReader (Maybe (HsExpr GhcRn)))
-> (HsExpr GhcRn -> Maybe (HsExpr GhcRn))
-> HsExpr GhcRn
-> EnvReader (Maybe (HsExpr GhcRn))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr GhcRn -> Maybe (HsExpr GhcRn)
forall a. a -> Maybe a
Just (HsExpr GhcRn -> EnvReader (Maybe (HsExpr GhcRn)))
-> HsExpr GhcRn -> EnvReader (Maybe (HsExpr GhcRn))
forall a b. (a -> b) -> a -> b
$ XDo GhcRn
-> HsDoFlavour -> XRec GhcRn [GuardLStmt GhcRn] -> HsExpr GhcRn
forall p. XDo p -> HsDoFlavour -> XRec p [ExprLStmt p] -> HsExpr p
Ghc.HsDo XDo GhcRn
x HsDoFlavour
ctx XRec GhcRn [GuardLStmt GhcRn]
GenLocated
  SrcSpanAnnL
  [GenLocated
     SrcSpanAnnA (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
stmtsRes
hsDoCase HsExpr GhcRn
_ = Maybe (HsExpr GhcRn) -> EnvReader (Maybe (HsExpr GhcRn))
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (HsExpr GhcRn)
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 GhcRn body)) =>
[LStmt GhcRn body]
-> WriterT
     VarSet (WriterT Any (ReaderT Env TcM)) [LStmt GhcRn body]
dealWithStatements [] = [GenLocated (Anno (Stmt GhcRn body)) (Stmt GhcRn body)]
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env TcM))
     [GenLocated (Anno (Stmt GhcRn body)) (Stmt GhcRn body)]
forall a. a -> WriterT VarSet (WriterT Any (ReaderT Env TcM)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
dealWithStatements (LStmt GhcRn body
lstmt : [LStmt GhcRn body]
xs) = do
  (GenLocated (Anno (Stmt GhcRn body)) (Stmt GhcRn body)
stmtRes, VarSet
names) <- WriterT
  VarSet
  (WriterT Any (ReaderT Env TcM))
  (GenLocated (Anno (Stmt GhcRn body)) (Stmt GhcRn body))
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env TcM))
     (GenLocated (Anno (Stmt GhcRn body)) (Stmt GhcRn 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 GhcRn body)) (Stmt GhcRn body))
 -> WriterT
      VarSet
      (WriterT Any (ReaderT Env TcM))
      (GenLocated (Anno (Stmt GhcRn body)) (Stmt GhcRn body), VarSet))
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env TcM))
     (GenLocated (Anno (Stmt GhcRn body)) (Stmt GhcRn body))
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env TcM))
     (GenLocated (Anno (Stmt GhcRn body)) (Stmt GhcRn body), VarSet)
forall a b. (a -> b) -> a -> b
$ (Stmt GhcRn body
 -> WriterT
      VarSet (WriterT Any (ReaderT Env TcM)) (Stmt GhcRn body))
-> GenLocated (Anno (Stmt GhcRn body)) (Stmt GhcRn body)
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env TcM))
     (GenLocated (Anno (Stmt GhcRn body)) (Stmt GhcRn 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 GhcRn body)) a
-> f (GenLocated (Anno (Stmt GhcRn body)) b)
traverse Stmt GhcRn body
-> WriterT VarSet (WriterT Any (ReaderT Env TcM)) (Stmt GhcRn body)
forall body.
(Data (Stmt GhcRn body), Data body) =>
Stmt GhcRn body
-> WriterT VarSet (WriterT Any (ReaderT Env TcM)) (Stmt GhcRn body)
dealWithStmt LStmt GhcRn body
GenLocated (Anno (Stmt GhcRn body)) (Stmt GhcRn body)
lstmt
  (GenLocated (Anno (Stmt GhcRn body)) (Stmt GhcRn body)
stmtRes GenLocated (Anno (Stmt GhcRn body)) (Stmt GhcRn body)
-> [GenLocated (Anno (Stmt GhcRn body)) (Stmt GhcRn body)]
-> [GenLocated (Anno (Stmt GhcRn body)) (Stmt GhcRn body)]
forall a. a -> [a] -> [a]
:) ([GenLocated (Anno (Stmt GhcRn body)) (Stmt GhcRn body)]
 -> [GenLocated (Anno (Stmt GhcRn body)) (Stmt GhcRn body)])
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env TcM))
     [GenLocated (Anno (Stmt GhcRn body)) (Stmt GhcRn body)]
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env TcM))
     [GenLocated (Anno (Stmt GhcRn body)) (Stmt GhcRn body)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WriterT
   Any
   (ReaderT Env TcM)
   ([GenLocated (Anno (Stmt GhcRn body)) (Stmt GhcRn body)], VarSet)
 -> WriterT
      Any
      (ReaderT Env TcM)
      ([GenLocated (Anno (Stmt GhcRn body)) (Stmt GhcRn body)], VarSet))
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env TcM))
     [GenLocated (Anno (Stmt GhcRn body)) (Stmt GhcRn body)]
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env TcM))
     [GenLocated (Anno (Stmt GhcRn body)) (Stmt GhcRn 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 GhcRn body)) (Stmt GhcRn body)], VarSet)
-> WriterT
     Any
     (ReaderT Env TcM)
     ([GenLocated (Anno (Stmt GhcRn body)) (Stmt GhcRn body)], VarSet)
forall a. VarSet -> EnvReader a -> EnvReader a
addScopedVars VarSet
names) ([LStmt GhcRn body]
-> WriterT
     VarSet (WriterT Any (ReaderT Env TcM)) [LStmt GhcRn body]
forall body.
(Data body, Data (Stmt GhcRn body)) =>
[LStmt GhcRn body]
-> WriterT
     VarSet (WriterT Any (ReaderT Env TcM)) [LStmt GhcRn body]
dealWithStatements [LStmt GhcRn 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 GhcRn body), Data body) =>
Stmt GhcRn body
-> WriterT VarSet (WriterT Any (ReaderT Env TcM)) (Stmt GhcRn body)
dealWithStmt = \case
  Ghc.BindStmt XBindStmt GhcRn GhcRn body
x LPat GhcRn
lpat body
body -> do
    let names :: VarSet
names = LPat GhcRn -> VarSet
extractVarPats LPat GhcRn
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 GhcRn body
-> WriterT VarSet (WriterT Any (ReaderT Env TcM)) (Stmt GhcRn body)
forall a. a -> WriterT VarSet (WriterT Any (ReaderT Env TcM)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Stmt GhcRn body
 -> WriterT
      VarSet (WriterT Any (ReaderT Env TcM)) (Stmt GhcRn body))
-> Stmt GhcRn body
-> WriterT VarSet (WriterT Any (ReaderT Env TcM)) (Stmt GhcRn body)
forall a b. (a -> b) -> a -> b
$ XBindStmt GhcRn GhcRn body -> LPat GhcRn -> body -> Stmt GhcRn body
forall idL idR body.
XBindStmt idL idR body -> LPat idL -> body -> StmtLR idL idR body
Ghc.BindStmt XBindStmt GhcRn GhcRn body
x LPat GhcRn
lpat body
bodyRes

  Ghc.LetStmt XLetStmt GhcRn GhcRn body
x HsLocalBinds GhcRn
localBinds -> do
    (HsLocalBinds GhcRn
bindsRes, VarSet
names) <- EnvReader (HsLocalBinds GhcRn, VarSet)
-> WriterT
     VarSet (WriterT Any (ReaderT Env TcM)) (HsLocalBinds GhcRn, 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 GhcRn, VarSet)
 -> WriterT
      VarSet
      (WriterT Any (ReaderT Env TcM))
      (HsLocalBinds GhcRn, VarSet))
-> EnvReader (HsLocalBinds GhcRn, VarSet)
-> WriterT
     VarSet (WriterT Any (ReaderT Env TcM)) (HsLocalBinds GhcRn, VarSet)
forall a b. (a -> b) -> a -> b
$ HsLocalBinds GhcRn -> EnvReader (HsLocalBinds GhcRn, VarSet)
dealWithLocalBinds HsLocalBinds GhcRn
localBinds
    VarSet -> WriterT VarSet (WriterT Any (ReaderT Env TcM)) ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell VarSet
names
    Stmt GhcRn body
-> WriterT VarSet (WriterT Any (ReaderT Env TcM)) (Stmt GhcRn body)
forall a. a -> WriterT VarSet (WriterT Any (ReaderT Env TcM)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Stmt GhcRn body
 -> WriterT
      VarSet (WriterT Any (ReaderT Env TcM)) (Stmt GhcRn body))
-> Stmt GhcRn body
-> WriterT VarSet (WriterT Any (ReaderT Env TcM)) (Stmt GhcRn body)
forall a b. (a -> b) -> a -> b
$ XLetStmt GhcRn GhcRn body -> HsLocalBinds GhcRn -> Stmt GhcRn body
forall idL idR body.
XLetStmt idL idR body
-> HsLocalBindsLR idL idR -> StmtLR idL idR body
Ghc.LetStmt XLetStmt GhcRn GhcRn body
x HsLocalBinds GhcRn
bindsRes

#if MIN_VERSION_ghc(9,12,0)
  Ghc.XStmtLR (Ghc.ApplicativeStmt x pairs mbJoin) -> do
#else
  Ghc.ApplicativeStmt XApplicativeStmt GhcRn GhcRn body
x [(SyntaxExpr GhcRn, ApplicativeArg GhcRn)]
pairs Maybe (SyntaxExpr GhcRn)
mbJoin -> do
#endif
    let dealWithAppArg :: ApplicativeArg GhcRn
-> WriterT
     VarSet (WriterT Any (ReaderT Env TcM)) (ApplicativeArg GhcRn)
dealWithAppArg = \case
          a :: ApplicativeArg GhcRn
a@Ghc.ApplicativeArgOne{Bool
XApplicativeArgOne GhcRn
LPat GhcRn
LHsExpr GhcRn
xarg_app_arg_one :: XApplicativeArgOne GhcRn
app_arg_pattern :: LPat GhcRn
arg_expr :: LHsExpr GhcRn
is_body_stmt :: Bool
is_body_stmt :: forall idL. ApplicativeArg idL -> Bool
arg_expr :: forall idL. ApplicativeArg idL -> LHsExpr idL
app_arg_pattern :: forall idL. ApplicativeArg idL -> LPat idL
xarg_app_arg_one :: forall idL. ApplicativeArg idL -> XApplicativeArgOne idL
..} -> 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 GhcRn -> VarSet
extractVarPats LPat GhcRn
app_arg_pattern
            ApplicativeArg GhcRn
-> WriterT
     VarSet (WriterT Any (ReaderT Env TcM)) (ApplicativeArg GhcRn)
forall a. a -> WriterT VarSet (WriterT Any (ReaderT Env TcM)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ApplicativeArg GhcRn
a
          a :: ApplicativeArg GhcRn
a@Ghc.ApplicativeArgMany{[GuardLStmt GhcRn]
XApplicativeArgMany GhcRn
LPat GhcRn
HsExpr GhcRn
HsDoFlavour
xarg_app_arg_many :: XApplicativeArgMany GhcRn
app_stmts :: [GuardLStmt GhcRn]
final_expr :: HsExpr GhcRn
bv_pattern :: LPat GhcRn
stmt_context :: HsDoFlavour
stmt_context :: forall idL. ApplicativeArg idL -> HsDoFlavour
bv_pattern :: forall idL. ApplicativeArg idL -> LPat idL
final_expr :: forall idL. ApplicativeArg idL -> HsExpr idL
app_stmts :: forall idL. ApplicativeArg idL -> [ExprLStmt idL]
xarg_app_arg_many :: forall idL. ApplicativeArg idL -> XApplicativeArgMany idL
..} -> 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 GhcRn -> VarSet
extractVarPats LPat GhcRn
bv_pattern
            ([GenLocated
   (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
   (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
stmtsRes, VarSet
_) <- WriterT
  Any
  (ReaderT Env TcM)
  ([GenLocated
      (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
      (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))],
   VarSet)
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env TcM))
     ([GenLocated
         (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
         (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))],
      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 GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
       (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))],
    VarSet)
 -> WriterT
      VarSet
      (WriterT Any (ReaderT Env TcM))
      ([GenLocated
          (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
          (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))],
       VarSet))
-> (WriterT
      VarSet
      (WriterT Any (ReaderT Env TcM))
      [GenLocated
         (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
         (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
    -> WriterT
         Any
         (ReaderT Env TcM)
         ([GenLocated
             (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
             (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))],
          VarSet))
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env TcM))
     [GenLocated
        (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
        (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env TcM))
     ([GenLocated
         (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
         (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))],
      VarSet)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT
  VarSet
  (WriterT Any (ReaderT Env TcM))
  [GenLocated
     (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
     (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> WriterT
     Any
     (ReaderT Env TcM)
     ([GenLocated
         (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
         (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))],
      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 GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
      (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
 -> WriterT
      VarSet
      (WriterT Any (ReaderT Env TcM))
      ([GenLocated
          (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
          (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))],
       VarSet))
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env TcM))
     [GenLocated
        (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
        (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))]
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env TcM))
     ([GenLocated
         (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))))
         (Stmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn)))],
      VarSet)
forall a b. (a -> b) -> a -> b
$ [LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))]
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env TcM))
     [LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))]
forall body.
(Data body, Data (Stmt GhcRn body)) =>
[LStmt GhcRn body]
-> WriterT
     VarSet (WriterT Any (ReaderT Env TcM)) [LStmt GhcRn body]
dealWithStatements [GuardLStmt GhcRn]
[LStmt GhcRn (GenLocated SrcSpanAnnA (HsExpr GhcRn))]
app_stmts
            ApplicativeArg GhcRn
-> WriterT
     VarSet (WriterT Any (ReaderT Env TcM)) (ApplicativeArg GhcRn)
forall a. a -> WriterT VarSet (WriterT Any (ReaderT Env TcM)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ApplicativeArg GhcRn
a {Ghc.app_stmts = stmtsRes}
    [(SyntaxExprRn, ApplicativeArg GhcRn)]
pairsRes <- (((SyntaxExprRn, ApplicativeArg GhcRn)
 -> WriterT
      VarSet
      (WriterT Any (ReaderT Env TcM))
      (SyntaxExprRn, ApplicativeArg GhcRn))
-> [(SyntaxExprRn, ApplicativeArg GhcRn)]
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env TcM))
     [(SyntaxExprRn, ApplicativeArg GhcRn)]
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 GhcRn)
  -> WriterT
       VarSet
       (WriterT Any (ReaderT Env TcM))
       (SyntaxExprRn, ApplicativeArg GhcRn))
 -> [(SyntaxExprRn, ApplicativeArg GhcRn)]
 -> WriterT
      VarSet
      (WriterT Any (ReaderT Env TcM))
      [(SyntaxExprRn, ApplicativeArg GhcRn)])
-> ((ApplicativeArg GhcRn
     -> WriterT
          VarSet (WriterT Any (ReaderT Env TcM)) (ApplicativeArg GhcRn))
    -> (SyntaxExprRn, ApplicativeArg GhcRn)
    -> WriterT
         VarSet
         (WriterT Any (ReaderT Env TcM))
         (SyntaxExprRn, ApplicativeArg GhcRn))
-> (ApplicativeArg GhcRn
    -> WriterT
         VarSet (WriterT Any (ReaderT Env TcM)) (ApplicativeArg GhcRn))
-> [(SyntaxExprRn, ApplicativeArg GhcRn)]
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env TcM))
     [(SyntaxExprRn, ApplicativeArg GhcRn)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ApplicativeArg GhcRn
 -> WriterT
      VarSet (WriterT Any (ReaderT Env TcM)) (ApplicativeArg GhcRn))
-> (SyntaxExprRn, ApplicativeArg GhcRn)
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env TcM))
     (SyntaxExprRn, ApplicativeArg GhcRn)
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 GhcRn
-> WriterT
     VarSet (WriterT Any (ReaderT Env TcM)) (ApplicativeArg GhcRn)
dealWithAppArg [(SyntaxExpr GhcRn, ApplicativeArg GhcRn)]
[(SyntaxExprRn, ApplicativeArg GhcRn)]
pairs
#if MIN_VERSION_ghc(9,12,0)
    pure $ Ghc.XStmtLR (Ghc.ApplicativeStmt x pairsRes mbJoin)
#else
    Stmt GhcRn body
-> WriterT VarSet (WriterT Any (ReaderT Env TcM)) (Stmt GhcRn body)
forall a. a -> WriterT VarSet (WriterT Any (ReaderT Env TcM)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Stmt GhcRn body
 -> WriterT
      VarSet (WriterT Any (ReaderT Env TcM)) (Stmt GhcRn body))
-> Stmt GhcRn body
-> WriterT VarSet (WriterT Any (ReaderT Env TcM)) (Stmt GhcRn body)
forall a b. (a -> b) -> a -> b
$ XApplicativeStmt GhcRn GhcRn body
-> [(SyntaxExpr GhcRn, ApplicativeArg GhcRn)]
-> Maybe (SyntaxExpr GhcRn)
-> Stmt GhcRn body
forall idL idR body.
XApplicativeStmt idL idR body
-> [(SyntaxExpr idR, ApplicativeArg idL)]
-> Maybe (SyntaxExpr idR)
-> StmtLR idL idR body
Ghc.ApplicativeStmt XApplicativeStmt GhcRn GhcRn body
x [(SyntaxExpr GhcRn, ApplicativeArg GhcRn)]
[(SyntaxExprRn, ApplicativeArg GhcRn)]
pairsRes Maybe (SyntaxExpr GhcRn)
mbJoin
#endif

  Stmt GhcRn body
other -> EnvReader (Stmt GhcRn body)
-> WriterT VarSet (WriterT Any (ReaderT Env TcM)) (Stmt GhcRn 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 GhcRn body)
 -> WriterT
      VarSet (WriterT Any (ReaderT Env TcM)) (Stmt GhcRn body))
-> EnvReader (Stmt GhcRn body)
-> WriterT VarSet (WriterT Any (ReaderT Env TcM)) (Stmt GhcRn body)
forall a b. (a -> b) -> a -> b
$ (forall a. Data a => a -> EnvReader a)
-> Stmt GhcRn body -> EnvReader (Stmt GhcRn 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 GhcRn body -> m (Stmt GhcRn body)
gmapM d -> EnvReader d
forall a. Data a => a -> EnvReader a
recurse Stmt GhcRn body
other

--------------------------------------------------------------------------------
-- Arrow Notation
--------------------------------------------------------------------------------

hsProcCase :: Ghc.HsExpr Ghc.GhcRn
           -> EnvReader (Maybe (Ghc.HsExpr Ghc.GhcRn))
hsProcCase :: HsExpr GhcRn -> EnvReader (Maybe (HsExpr GhcRn))
hsProcCase (Ghc.HsProc XProc GhcRn
x1 LPat GhcRn
lpat LHsCmdTop GhcRn
cmdTop) = do
  let inputNames :: VarSet
inputNames = LPat GhcRn -> VarSet
extractVarPats LPat GhcRn
lpat
  MaybeT (WriterT Any (ReaderT Env TcM)) (HsExpr GhcRn)
-> EnvReader (Maybe (HsExpr GhcRn))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (WriterT Any (ReaderT Env TcM)) (HsExpr GhcRn)
 -> EnvReader (Maybe (HsExpr GhcRn)))
-> MaybeT (WriterT Any (ReaderT Env TcM)) (HsExpr GhcRn)
-> EnvReader (Maybe (HsExpr GhcRn))
forall a b. (a -> b) -> a -> b
$ do
    GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcRn)
cmdTopRes <- GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcRn)
-> (HsCmdTop GhcRn
    -> MaybeT (WriterT Any (ReaderT Env TcM)) (HsCmdTop GhcRn))
-> MaybeT
     (WriterT Any (ReaderT Env TcM))
     (GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcRn))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for LHsCmdTop GhcRn
GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcRn)
cmdTop ((HsCmdTop GhcRn
  -> MaybeT (WriterT Any (ReaderT Env TcM)) (HsCmdTop GhcRn))
 -> MaybeT
      (WriterT Any (ReaderT Env TcM))
      (GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcRn)))
-> (HsCmdTop GhcRn
    -> MaybeT (WriterT Any (ReaderT Env TcM)) (HsCmdTop GhcRn))
-> MaybeT
     (WriterT Any (ReaderT Env TcM))
     (GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcRn))
forall a b. (a -> b) -> a -> b
$ \case
      Ghc.HsCmdTop XCmdTop GhcRn
x2 LHsCmd GhcRn
lcmd -> do
        GenLocated SrcSpanAnnA (HsCmd GhcRn)
cmdRes <- GenLocated SrcSpanAnnA (HsCmd GhcRn)
-> (HsCmd GhcRn
    -> MaybeT (WriterT Any (ReaderT Env TcM)) (HsCmd GhcRn))
-> MaybeT
     (WriterT Any (ReaderT Env TcM))
     (GenLocated SrcSpanAnnA (HsCmd GhcRn))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for LHsCmd GhcRn
GenLocated SrcSpanAnnA (HsCmd GhcRn)
lcmd ((HsCmd GhcRn
  -> MaybeT (WriterT Any (ReaderT Env TcM)) (HsCmd GhcRn))
 -> MaybeT
      (WriterT Any (ReaderT Env TcM))
      (GenLocated SrcSpanAnnA (HsCmd GhcRn)))
-> (HsCmd GhcRn
    -> MaybeT (WriterT Any (ReaderT Env TcM)) (HsCmd GhcRn))
-> MaybeT
     (WriterT Any (ReaderT Env TcM))
     (GenLocated SrcSpanAnnA (HsCmd GhcRn))
forall a b. (a -> b) -> a -> b
$ \case
          Ghc.HsCmdDo XCmdDo GhcRn
x3 XRec GhcRn [CmdLStmt GhcRn]
lstmts -> do
            (GenLocated
  SrcSpanAnnL
  [GenLocated
     (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))))
     (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))]
stmtsRes, VarSet
_) <- WriterT
  Any
  (ReaderT Env TcM)
  (GenLocated
     SrcSpanAnnL
     [GenLocated
        (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))))
        (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))],
   VarSet)
-> MaybeT
     (WriterT Any (ReaderT Env TcM))
     (GenLocated
        SrcSpanAnnL
        [GenLocated
           (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))))
           (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))],
      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 GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))))
         (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))],
    VarSet)
 -> MaybeT
      (WriterT Any (ReaderT Env TcM))
      (GenLocated
         SrcSpanAnnL
         [GenLocated
            (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))))
            (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))],
       VarSet))
-> (([GenLocated
        SrcSpanAnnA (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))]
     -> WriterT
          VarSet
          (WriterT Any (ReaderT Env TcM))
          [GenLocated
             (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))))
             (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))])
    -> WriterT
         Any
         (ReaderT Env TcM)
         (GenLocated
            SrcSpanAnnL
            [GenLocated
               (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))))
               (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))],
          VarSet))
-> ([GenLocated
       SrcSpanAnnA (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))]
    -> WriterT
         VarSet
         (WriterT Any (ReaderT Env TcM))
         [GenLocated
            (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))))
            (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))])
-> MaybeT
     (WriterT Any (ReaderT Env TcM))
     (GenLocated
        SrcSpanAnnL
        [GenLocated
           (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))))
           (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))],
      VarSet)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT
  VarSet
  (WriterT Any (ReaderT Env TcM))
  (GenLocated
     SrcSpanAnnL
     [GenLocated
        (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))))
        (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))])
-> WriterT
     Any
     (ReaderT Env TcM)
     (GenLocated
        SrcSpanAnnL
        [GenLocated
           (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))))
           (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))],
      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 GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))))
         (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))])
 -> WriterT
      Any
      (ReaderT Env TcM)
      (GenLocated
         SrcSpanAnnL
         [GenLocated
            (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))))
            (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))],
       VarSet))
-> (([GenLocated
        SrcSpanAnnA (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))]
     -> WriterT
          VarSet
          (WriterT Any (ReaderT Env TcM))
          [GenLocated
             (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))))
             (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))])
    -> WriterT
         VarSet
         (WriterT Any (ReaderT Env TcM))
         (GenLocated
            SrcSpanAnnL
            [GenLocated
               (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))))
               (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))]))
-> ([GenLocated
       SrcSpanAnnA (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))]
    -> WriterT
         VarSet
         (WriterT Any (ReaderT Env TcM))
         [GenLocated
            (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))))
            (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))])
-> WriterT
     Any
     (ReaderT Env TcM)
     (GenLocated
        SrcSpanAnnL
        [GenLocated
           (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))))
           (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))],
      VarSet)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated
  SrcSpanAnnL
  [GenLocated
     SrcSpanAnnA (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))]
-> ([GenLocated
       SrcSpanAnnA (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))]
    -> WriterT
         VarSet
         (WriterT Any (ReaderT Env TcM))
         [GenLocated
            (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))))
            (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))])
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env TcM))
     (GenLocated
        SrcSpanAnnL
        [GenLocated
           (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))))
           (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for XRec GhcRn [CmdLStmt GhcRn]
GenLocated
  SrcSpanAnnL
  [GenLocated
     SrcSpanAnnA (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))]
lstmts (([GenLocated
     SrcSpanAnnA (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))]
  -> WriterT
       VarSet
       (WriterT Any (ReaderT Env TcM))
       [GenLocated
          (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))))
          (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))])
 -> MaybeT
      (WriterT Any (ReaderT Env TcM))
      (GenLocated
         SrcSpanAnnL
         [GenLocated
            (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))))
            (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))],
       VarSet))
-> ([GenLocated
       SrcSpanAnnA (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))]
    -> WriterT
         VarSet
         (WriterT Any (ReaderT Env TcM))
         [GenLocated
            (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))))
            (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))])
-> MaybeT
     (WriterT Any (ReaderT Env TcM))
     (GenLocated
        SrcSpanAnnL
        [GenLocated
           (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))))
           (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))],
      VarSet)
forall a b. (a -> b) -> a -> b
$ \[GenLocated
   SrcSpanAnnA (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))]
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 GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))))
       (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))],
    VarSet)
 -> WriterT
      Any
      (ReaderT Env TcM)
      ([GenLocated
          (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))))
          (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))],
       VarSet))
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env TcM))
     [GenLocated
        (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))))
        (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))]
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env TcM))
     [GenLocated
        (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))))
        (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))]
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 GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))))
         (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))],
      VarSet)
-> WriterT
     Any
     (ReaderT Env TcM)
     ([GenLocated
         (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))))
         (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))],
      VarSet)
forall a. VarSet -> EnvReader a -> EnvReader a
addScopedVars VarSet
inputNames) (WriterT
   VarSet
   (WriterT Any (ReaderT Env TcM))
   [GenLocated
      (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))))
      (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))]
 -> WriterT
      VarSet
      (WriterT Any (ReaderT Env TcM))
      [GenLocated
         (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))))
         (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))])
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env TcM))
     [GenLocated
        (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))))
        (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))]
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env TcM))
     [GenLocated
        (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))))
        (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))]
forall a b. (a -> b) -> a -> b
$ [LStmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))]
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env TcM))
     [LStmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))]
forall body.
(Data body, Data (Stmt GhcRn body)) =>
[LStmt GhcRn body]
-> WriterT
     VarSet (WriterT Any (ReaderT Env TcM)) [LStmt GhcRn body]
dealWithStatements [LStmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))]
[GenLocated
   SrcSpanAnnA (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))]
stmts
            HsCmd GhcRn -> MaybeT (WriterT Any (ReaderT Env TcM)) (HsCmd GhcRn)
forall a. a -> MaybeT (WriterT Any (ReaderT Env TcM)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsCmd GhcRn
 -> MaybeT (WriterT Any (ReaderT Env TcM)) (HsCmd GhcRn))
-> HsCmd GhcRn
-> MaybeT (WriterT Any (ReaderT Env TcM)) (HsCmd GhcRn)
forall a b. (a -> b) -> a -> b
$ XCmdDo GhcRn -> XRec GhcRn [CmdLStmt GhcRn] -> HsCmd GhcRn
forall id. XCmdDo id -> XRec id [CmdLStmt id] -> HsCmd id
Ghc.HsCmdDo XCmdDo GhcRn
x3 XRec GhcRn [CmdLStmt GhcRn]
GenLocated
  SrcSpanAnnL
  [GenLocated
     (Anno (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn))))
     (Stmt GhcRn (GenLocated SrcSpanAnnA (HsCmd GhcRn)))]
stmtsRes

          HsCmd GhcRn
_ -> MaybeT (WriterT Any (ReaderT Env TcM)) (HsCmd GhcRn)
forall a. MaybeT (WriterT Any (ReaderT Env TcM)) a
forall (f :: * -> *) a. Alternative f => f a
empty -- TODO what other cases should be handled?

        HsCmdTop GhcRn
-> MaybeT (WriterT Any (ReaderT Env TcM)) (HsCmdTop GhcRn)
forall a. a -> MaybeT (WriterT Any (ReaderT Env TcM)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsCmdTop GhcRn
 -> MaybeT (WriterT Any (ReaderT Env TcM)) (HsCmdTop GhcRn))
-> HsCmdTop GhcRn
-> MaybeT (WriterT Any (ReaderT Env TcM)) (HsCmdTop GhcRn)
forall a b. (a -> b) -> a -> b
$ XCmdTop GhcRn -> LHsCmd GhcRn -> HsCmdTop GhcRn
forall p. XCmdTop p -> LHsCmd p -> HsCmdTop p
Ghc.HsCmdTop XCmdTop GhcRn
x2 LHsCmd GhcRn
GenLocated SrcSpanAnnA (HsCmd GhcRn)
cmdRes
    HsExpr GhcRn
-> MaybeT (WriterT Any (ReaderT Env TcM)) (HsExpr GhcRn)
forall a. a -> MaybeT (WriterT Any (ReaderT Env TcM)) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsExpr GhcRn
 -> MaybeT (WriterT Any (ReaderT Env TcM)) (HsExpr GhcRn))
-> HsExpr GhcRn
-> MaybeT (WriterT Any (ReaderT Env TcM)) (HsExpr GhcRn)
forall a b. (a -> b) -> a -> b
$ XProc GhcRn -> LPat GhcRn -> LHsCmdTop GhcRn -> HsExpr GhcRn
forall p. XProc p -> LPat p -> LHsCmdTop p -> HsExpr p
Ghc.HsProc XProc GhcRn
x1 LPat GhcRn
lpat LHsCmdTop GhcRn
GenLocated (SrcAnn NoEpAnns) (HsCmdTop GhcRn)
cmdTopRes
hsProcCase HsExpr GhcRn
_ = Maybe (HsExpr GhcRn) -> EnvReader (Maybe (HsExpr GhcRn))
forall a. a -> WriterT Any (ReaderT Env TcM) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (HsExpr GhcRn)
forall a. Maybe a
Nothing

--------------------------------------------------------------------------------
-- Env
--------------------------------------------------------------------------------

-- The writer is for tracking if an inner expression contains the target name
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
<>))

--------------------------------------------------------------------------------
-- Vendored from GHC
--------------------------------------------------------------------------------

depAnalBinds :: [(Ghc.LHsBind Ghc.GhcRn, [Ghc.Name], Ghc.UniqSet Ghc.Name)]
             -> [(Ghc.RecFlag, Ghc.LHsBinds Ghc.GhcRn)]
depAnalBinds :: [(LHsBind GhcRn, [Name], UniqSet Name)]
-> [(RecFlag, LHsBinds GhcRn)]
depAnalBinds [(LHsBind GhcRn, [Name], UniqSet Name)]
binds_w_dus
  = (SCC
   (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn), [Name],
    UniqSet Name)
 -> (RecFlag, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn))))
-> [SCC
      (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn), [Name],
       UniqSet Name)]
-> [(RecFlag, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn)))]
forall a b. (a -> b) -> [a] -> [b]
map SCC
  (Item (Bag (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn))),
   [Name], UniqSet Name)
-> (RecFlag, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn)))
SCC
  (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn), [Name],
   UniqSet Name)
-> (RecFlag, Bag (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn)))
forall {b} {b} {c}. IsList b => SCC (Item b, b, c) -> (RecFlag, b)
get_binds [SCC
   (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn), [Name],
    UniqSet Name)]
sccs
  where
    sccs :: [SCC
   (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn), [Name],
    UniqSet Name)]
sccs = ((GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn), [Name],
  UniqSet Name)
 -> [Name])
-> ((GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn), [Name],
     UniqSet Name)
    -> [Name])
-> [(GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn), [Name],
     UniqSet Name)]
-> [SCC
      (GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn), [Name],
       UniqSet Name)]
forall node.
(node -> [Name]) -> (node -> [Name]) -> [node] -> [SCC node]
Ghc.depAnal
             (\(GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn)
_, [Name]
defs, UniqSet Name
_) -> [Name]
defs)
             (\(GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn)
_, [Name]
_, UniqSet Name
uses) -> UniqSet Name -> [Name]
forall elt. UniqSet elt -> [elt]
Ghc.nonDetEltsUniqSet UniqSet Name
uses)
             [(LHsBind GhcRn, [Name], UniqSet Name)]
[(GenLocated SrcSpanAnnA (HsBindLR GhcRn GhcRn), [Name],
  UniqSet Name)]
binds_w_dus

    get_binds :: SCC (Item b, b, c) -> (RecFlag, b)
get_binds (Graph.AcyclicSCC (Item b
bind, b
_, c
_)) =
      (RecFlag
Ghc.NonRecursive, [Item b] -> b
forall l. IsList l => [Item l] -> l
fromList [Item b
bind])
    get_binds (Graph.CyclicSCC  [(Item b, b, c)]
binds_w_dus') =
      (RecFlag
Ghc.Recursive, [Item b] -> b
forall l. IsList l => [Item l] -> l
fromList [Item b
b | (Item b
b,b
_,c
_) <- [(Item b, b, c)]
binds_w_dus'])