{-# LANGUAGE CPP #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ImplicitParams #-}
module Debug.Breakpoint
  ( -- * Plugin
    plugin
    -- * API
  , breakpoint
  , breakpointM
  , breakpointIO
  , queryVars
  , queryVarsM
  , queryVarsIO
  , excludeVars
    -- * Internals
  , captureVars
  , showLev
  , fromAscList
  , printAndWait
  , printAndWaitM
  , printAndWaitIO
  , runPrompt
  , runPromptM
  , runPromptIO
  , getSrcLoc
  ) where

import           Control.Applicative ((<|>), empty)
import           Control.Arrow ((&&&))
import           Control.Monad.IO.Class
import           Control.Monad.Reader
import           Control.Monad.Trans.Maybe
import           Control.Monad.Trans.Writer.CPS
import           Data.Char (isSpace)
import           Data.Data hiding (IntRep, FloatRep)
import           Data.Either
import           Data.Foldable
import           Data.Functor
import qualified Data.Graph as Graph
import qualified Data.List as L
import qualified Data.Map.Lazy as M
import           Data.Maybe
import           Data.Monoid (Any(..))
import qualified Data.Text.Lazy as T
import           Data.Traversable (for)
import           Debug.Trace (trace, traceIO, traceM)
import qualified GHC.Exts as Exts
import           GHC.Int
#if MIN_VERSION_ghc(9,0,0)
import qualified GHC.Tc.Plugin as Plugin
#else
import qualified TcPluginM as Plugin
#endif
import           GHC.Word
import qualified System.Console.ANSI as ANSI
import qualified System.Console.Haskeline as HL
import           System.Environment (lookupEnv)
import           System.IO (stdout)
import           System.IO.Unsafe (unsafePerformIO)
import qualified Text.Pretty.Simple as PS
import qualified Text.Pretty.Simple.Internal.Color as PS

import qualified Debug.Breakpoint.GhcFacade as Ghc
import qualified Debug.Breakpoint.TimerManager as TM

--------------------------------------------------------------------------------
-- API
--------------------------------------------------------------------------------

-- | Constructs a lazy 'Map' from the names of all visible variables at the call
-- site to a string representation of their value. Does not include any variables
-- whose definitions contain it. Be careful not to assign multiple variables to
-- `captureVars` in the same scope as this will result in an infinite recursion.
captureVars :: M.Map String String
captureVars :: Map String String
captureVars = Map String String
forall a. Monoid a => a
mempty

-- re-exported to avoid requiring the client to depend on the containers package
fromAscList :: Ord k => [(k, v)] -> M.Map k v
fromAscList :: forall k v. Ord k => [(k, v)] -> Map k v
fromAscList = [(k, v)] -> Map k v
forall k a. Eq k => [(k, a)] -> Map k a
M.fromAscList

printAndWait :: String -> M.Map String String -> a -> a
printAndWait :: forall a. String -> Map String String -> a -> a
printAndWait String
srcLoc Map String String
vars a
x =
  IO a -> a
forall a. IO a -> a
unsafePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ String -> Map String String -> IO ()
forall (m :: * -> *).
MonadIO m =>
String -> Map String String -> m ()
printAndWaitIO String
srcLoc Map String String
vars IO () -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
{-# NOINLINE printAndWait #-}

printAndWaitM :: Applicative m => String -> M.Map String String -> m ()
printAndWaitM :: forall (m :: * -> *).
Applicative m =>
String -> Map String String -> m ()
printAndWaitM String
srcLoc Map String String
vars = String -> Map String String -> m () -> m ()
forall a. String -> Map String String -> a -> a
printAndWait String
srcLoc Map String String
vars (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

printAndWaitIO :: MonadIO m => String -> M.Map String String -> m ()
printAndWaitIO :: forall (m :: * -> *).
MonadIO m =>
String -> Map String String -> m ()
printAndWaitIO String
srcLoc Map String String
vars = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
  Bool
useColor <- Handle -> IO Bool
ANSI.hSupportsANSIColor Handle
stdout
  let ?useColor = ?useColor::Bool
Bool
useColor
  Bool
prettyPrint <- IO Bool
usePrettyPrinting
  let ?prettyPrint = ?prettyPrint::Bool
Bool
prettyPrint
  IO () -> IO ()
forall a. IO a -> IO a
TM.suspendTimeouts (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    String -> IO ()
traceIO (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate String
"\n"
      [ (?useColor::Bool) => String -> String -> String
String -> String -> String
color String
red String
"### Breakpoint Hit ###"
      , (?useColor::Bool) => String -> String -> String
String -> String -> String
color String
grey String
"(" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
srcLoc String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")"
      , (?useColor::Bool, ?prettyPrint::Bool) =>
Map String String -> String
Map String String -> String
printVars Map String String
vars
      , (?useColor::Bool) => String -> String -> String
String -> String -> String
color String
green String
"Press enter to continue"
      ]
    IO Int -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void IO Int
blockOnInput

runPrompt :: String -> M.Map String String -> a -> a
runPrompt :: forall a. String -> Map String String -> a -> a
runPrompt String
srcLoc Map String String
vars a
x =
  IO a -> a
forall a. IO a -> a
unsafePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ String -> Map String String -> IO ()
forall (m :: * -> *).
MonadIO m =>
String -> Map String String -> m ()
runPromptIO String
srcLoc Map String String
vars IO () -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
{-# NOINLINE runPrompt #-}

runPromptM :: Applicative m => String -> M.Map String String -> m ()
runPromptM :: forall (m :: * -> *).
Applicative m =>
String -> Map String String -> m ()
runPromptM String
srcLoc Map String String
vars = String -> Map String String -> m () -> m ()
forall a. String -> Map String String -> a -> a
runPrompt String
srcLoc Map String String
vars (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

runPromptIO :: forall m. MonadIO m => String -> M.Map String String -> m ()
runPromptIO :: forall (m :: * -> *).
MonadIO m =>
String -> Map String String -> m ()
runPromptIO String
srcLoc Map String String
vars = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (InputT IO () -> IO ()) -> InputT IO () -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Behavior -> Settings IO -> InputT IO () -> IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Behavior -> Settings m -> InputT m a -> m a
HL.runInputTBehavior Behavior
HL.defaultBehavior Settings IO
settings (InputT IO () -> m ()) -> InputT IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    Bool
useColor <- IO Bool -> InputT IO Bool
forall a. IO a -> InputT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> InputT IO Bool) -> IO Bool -> InputT IO Bool
forall a b. (a -> b) -> a -> b
$ Handle -> IO Bool
ANSI.hSupportsANSIColor Handle
stdout
    let ?useColor = ?useColor::Bool
Bool
useColor
    Bool
prettyPrint <- IO Bool -> InputT IO Bool
forall a. IO a -> InputT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Bool
usePrettyPrinting
    let ?prettyPrint = ?prettyPrint::Bool
Bool
prettyPrint
    let printVar :: String -> String -> InputT m ()
printVar String
var String
val =
          String -> InputT m ()
forall (m :: * -> *). MonadIO m => String -> InputT m ()
HL.outputStrLn (String -> InputT m ()) -> String -> InputT m ()
forall a b. (a -> b) -> a -> b
$ (?useColor::Bool) => String -> String -> String
String -> String -> String
color String
cyan (String
var String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" =\n") String -> String -> String
forall a. [a] -> [a] -> [a]
++ (?prettyPrint::Bool) => String -> String
String -> String
prettify String
val
        inputLoop :: InputT IO ()
inputLoop = do
          Maybe String
mInp <- String -> InputT IO (Maybe String)
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> InputT m (Maybe String)
HL.getInputLine (String -> InputT IO (Maybe String))
-> String -> InputT IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ (?useColor::Bool) => String -> String -> String
String -> String -> String
color String
green String
"Enter variable name: "
          case Maybe String
mInp of
            Just ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
L.dropWhileEnd Char -> Bool
isSpace (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace -> String
inp)
              | Bool -> Bool
not (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
inp) -> do
                  (String -> InputT IO ()) -> Maybe String -> InputT IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (String -> String -> InputT IO ()
forall {m :: * -> *}.
(MonadIO m, ?useColor::Bool, ?prettyPrint::Bool) =>
String -> String -> InputT m ()
printVar String
inp) (Maybe String -> InputT IO ()) -> Maybe String -> InputT IO ()
forall a b. (a -> b) -> a -> b
$ String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
inp Map String String
vars
                  InputT IO ()
inputLoop
            Maybe String
_ -> () -> InputT IO ()
forall a. a -> InputT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    String -> InputT IO ()
forall (m :: * -> *). MonadIO m => String -> InputT m ()
HL.outputStrLn (String -> InputT IO ())
-> ([String] -> String) -> [String] -> InputT IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> InputT IO ()) -> [String] -> InputT IO ()
forall a b. (a -> b) -> a -> b
$
      [ (?useColor::Bool) => String -> String -> String
String -> String -> String
color String
red String
"### Breakpoint Hit ###"
      , (?useColor::Bool) => String -> String -> String
String -> String -> String
color String
grey (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"(" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
srcLoc String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")"
      ] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ((?useColor::Bool) => String -> String -> String
String -> String -> String
color String
cyan (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
varNames)
    InputT IO ()
inputLoop
  where
    settings :: Settings IO
settings = CompletionFunc IO -> Settings IO -> Settings IO
forall (m :: * -> *). CompletionFunc m -> Settings m -> Settings m
HL.setComplete CompletionFunc IO
completion Settings IO
forall (m :: * -> *). MonadIO m => Settings m
HL.defaultSettings
    completion :: CompletionFunc IO
completion = Maybe Char
-> (Char -> Bool)
-> (String -> IO [Completion])
-> CompletionFunc IO
forall (m :: * -> *).
Monad m =>
Maybe Char
-> (Char -> Bool) -> (String -> m [Completion]) -> CompletionFunc m
HL.completeWord' Maybe Char
forall a. Maybe a
Nothing Char -> Bool
isSpace ((String -> IO [Completion]) -> CompletionFunc IO)
-> (String -> IO [Completion]) -> CompletionFunc IO
forall a b. (a -> b) -> a -> b
$ \String
str ->
      [Completion] -> IO [Completion]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Completion] -> IO [Completion])
-> [Completion] -> IO [Completion]
forall a b. (a -> b) -> a -> b
$ String -> Completion
HL.simpleCompletion
        (String -> Completion) -> [String] -> [Completion]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String
str String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf`) [String]
varNames
    varNames :: [String]
varNames = Map String String -> [String]
forall k a. Map k a -> [k]
M.keys Map String String
vars

usePrettyPrinting :: IO Bool
usePrettyPrinting :: IO Bool
usePrettyPrinting = Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe String -> Bool) -> IO (Maybe String) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
lookupEnv String
"NO_PRETTY_PRINT"

color :: (?useColor :: Bool) => String -> String -> String
color :: (?useColor::Bool) => String -> String -> String
color String
c String
s =
  if ?useColor::Bool
Bool
?useColor
     then String
"\ESC[" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
c String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"m\STX" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
s String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\ESC[m\STX"
     else String
s

red, green, grey, cyan :: String
red :: String
red = String
"31"
green :: String
green = String
"32"
grey :: String
grey = String
"37"
cyan :: String
cyan = String
"36"

printVars :: (?useColor :: Bool, ?prettyPrint :: Bool)
          => M.Map String String -> String
printVars :: (?useColor::Bool, ?prettyPrint::Bool) =>
Map String String -> String
printVars Map String String
vars =
  let eqSign :: String
eqSign | ?prettyPrint::Bool
Bool
?prettyPrint = String
" =\n"
             | Bool
otherwise = String
" = "
      mkLine :: (String, String) -> String
mkLine (String
k, String
v) = (?useColor::Bool) => String -> String -> String
String -> String -> String
color String
cyan (String
k String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
eqSign) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (?prettyPrint::Bool) => String -> String
String -> String
prettify String
v
   in [String] -> String
unlines ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
forall a. a -> [a] -> [a]
L.intersperse String
"" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (?useColor::Bool, ?prettyPrint::Bool) => (String, String) -> String
(String, String) -> String
mkLine ((String, String) -> String) -> [(String, String)] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map String String -> [(String, String)]
forall k a. Map k a -> [(k, a)]
M.toList Map String String
vars

-- TODO don't apply parsing to things inside angle brackets
prettify :: (?prettyPrint :: Bool) => String -> String
prettify :: (?prettyPrint::Bool) => String -> String
prettify =
  if ?prettyPrint::Bool
Bool
?prettyPrint
  then Text -> String
T.unpack
     (Text -> String) -> (String -> Text) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OutputOptions -> String -> Text
PS.pStringOpt
         OutputOptions
PS.defaultOutputOptionsDarkBg
           { outputOptionsInitialIndent :: Int
PS.outputOptionsInitialIndent = Int
2
           , outputOptionsIndentAmount :: Int
PS.outputOptionsIndentAmount = Int
2
           , outputOptionsColorOptions :: Maybe ColorOptions
PS.outputOptionsColorOptions = ColorOptions -> Maybe ColorOptions
forall a. a -> Maybe a
Just PS.ColorOptions
             { colorQuote :: Style
PS.colorQuote = Style
PS.colorNull
             , colorString :: Style
PS.colorString = Intensity -> Color -> Style
PS.colorBold Intensity
PS.Vivid Color
PS.Blue
             , colorError :: Style
PS.colorError = Intensity -> Color -> Style
PS.colorBold Intensity
PS.Vivid Color
PS.Red
             , colorNum :: Style
PS.colorNum = Intensity -> Color -> Style
PS.colorBold Intensity
PS.Vivid Color
PS.Green
             , colorRainbowParens :: [Style]
PS.colorRainbowParens = [Intensity -> Color -> Style
PS.colorBold Intensity
PS.Vivid Color
PS.Cyan]
             }
           }
  else String -> String
forall a. a -> a
id

inactivePluginStr :: String
inactivePluginStr :: String
inactivePluginStr =
  String
"Cannot set breakpoint: the Debug.Trace plugin is not active"

-- | Sets a breakpoint in pure code
breakpoint :: a -> a
breakpoint :: forall a. a -> a
breakpoint = String -> a -> a
forall a. String -> a -> a
trace String
inactivePluginStr

-- | When evaluated, displays the names of variables visible from the callsite
-- and starts a prompt where entering a variable will display its value. You
-- may want to use this instead of 'breakpoint' if there are value which should
-- stay unevaluated or you are only interested in certain values. Only the
-- current thread is blocked while the prompt is active. To resume execution,
-- press enter with a blank prompt.
queryVars :: a -> a
queryVars :: forall a. a -> a
queryVars = String -> a -> a
forall a. String -> a -> a
trace String
inactivePluginStr

-- | Similar to 'queryVars' but for use in an arbitrary 'Applicative' context.
-- This uses 'unsafePerformIO' which means that laziness and common sub-expression
-- elimination can result in unexpected behavior. For this reason you should
-- prefer 'queryVarsIO' if a 'MonadIO' instance is available.
queryVarsM :: Applicative m => m ()
queryVarsM :: forall (m :: * -> *). Applicative m => m ()
queryVarsM = String -> m ()
forall (f :: * -> *). Applicative f => String -> f ()
traceM String
inactivePluginStr

-- | Similar to 'queryVars' but specialized to an 'IO' context. You should favor
-- this over 'queryVarsM' if a 'MonadIO' instance is available.
queryVarsIO :: MonadIO m => m ()
queryVarsIO :: forall (m :: * -> *). MonadIO m => m ()
queryVarsIO =
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO ()
traceIO String
inactivePluginStr)

-- | Sets a breakpoint in an arbitrary 'Applicative'. Uses 'unsafePerformIO'
-- which means that laziness and common sub-expression elimination can result
-- in the breakpoint not being hit as expected. For this reason, you should
-- prefer 'breakpointIO' if a `MonadIO` instance is available.
breakpointM :: Applicative m => m ()
breakpointM :: forall (m :: * -> *). Applicative m => m ()
breakpointM = String -> m ()
forall (f :: * -> *). Applicative f => String -> f ()
traceM String
inactivePluginStr

-- | Sets a breakpoint in an 'IO' based 'Monad'. You should favor this over
-- 'breakpointM' if the monad can perform IO.
breakpointIO :: MonadIO m => m ()
breakpointIO :: forall (m :: * -> *). MonadIO m => m ()
breakpointIO =
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO ()
traceIO String
inactivePluginStr)

-- | Pretty prints the source code location of its call site
getSrcLoc :: String
getSrcLoc :: String
getSrcLoc = String
""

#if MIN_VERSION_ghc(9,2,0)
-- Use an "unsafe" foreign function to more or less stop the runtime.
-- In older GHCs this can cause out of control CPU usage so settle for getLine instead
foreign import ccall unsafe "stdio.h getchar" blockOnInput :: IO Int
#else
blockOnInput :: IO Int
blockOnInput = 1 <$ getLine
#endif

-- | Excludes the given variable names from appearing in the output of any
-- breakpoints occurring in the given expression.
excludeVars :: [String] -> a -> a
excludeVars :: forall a. [String] -> a -> a
excludeVars [String]
_ = a -> a
forall a. a -> a
id

--------------------------------------------------------------------------------
-- Plugin
--------------------------------------------------------------------------------

plugin :: Ghc.Plugin
plugin :: Plugin
plugin = Plugin
Ghc.defaultPlugin
  { pluginRecompile :: [String] -> IO PluginRecompile
Ghc.pluginRecompile = [String] -> IO PluginRecompile
Ghc.purePlugin
  , renamedResultAction :: [String]
-> TcGblEnv
-> HsGroup (GhcPass 'Renamed)
-> TcM (TcGblEnv, HsGroup (GhcPass 'Renamed))
Ghc.renamedResultAction = (TcGblEnv
 -> HsGroup (GhcPass 'Renamed)
 -> TcM (TcGblEnv, HsGroup (GhcPass 'Renamed)))
-> [String]
-> TcGblEnv
-> HsGroup (GhcPass 'Renamed)
-> TcM (TcGblEnv, HsGroup (GhcPass 'Renamed))
forall a b. a -> b -> a
const TcGblEnv
-> HsGroup (GhcPass 'Renamed)
-> TcM (TcGblEnv, HsGroup (GhcPass 'Renamed))
renameAction
  , tcPlugin :: TcPlugin
Ghc.tcPlugin = Maybe TcPlugin -> TcPlugin
forall a b. a -> b -> a
const (Maybe TcPlugin -> TcPlugin) -> Maybe TcPlugin -> TcPlugin
forall a b. (a -> b) -> a -> b
$ TcPlugin -> Maybe TcPlugin
forall a. a -> Maybe a
Just TcPlugin
tcPlugin
  }

renameAction
  :: Ghc.TcGblEnv
  -> Ghc.HsGroup Ghc.GhcRn
  -> Ghc.TcM (Ghc.TcGblEnv, Ghc.HsGroup Ghc.GhcRn)
renameAction :: TcGblEnv
-> HsGroup (GhcPass 'Renamed)
-> TcM (TcGblEnv, HsGroup (GhcPass 'Renamed))
renameAction TcGblEnv
gblEnv HsGroup (GhcPass 'Renamed)
group = do
  Ghc.Found ModLocation
_ Module
breakpointMod <-
    ModuleName -> TcM FindResult
Ghc.findPluginModule' (String -> ModuleName
Ghc.mkModuleName String
"Debug.Breakpoint")

  Name
captureVarsName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"captureVars")
  Name
showLevName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"showLev")
  Name
fromListName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"fromAscList")
  Name
breakpointName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"breakpoint")
  Name
queryVarsName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"queryVars")
  Name
breakpointMName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"breakpointM")
  Name
queryVarsMName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"queryVarsM")
  Name
breakpointIOName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"breakpointIO")
  Name
queryVarsIOName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"queryVarsIO")
  Name
printAndWaitName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"printAndWait")
  Name
printAndWaitMName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"printAndWaitM")
  Name
printAndWaitIOName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"printAndWaitIO")
  Name
runPromptIOName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"runPromptIO")
  Name
runPromptMName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"runPromptM")
  Name
runPromptName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"runPrompt")
  Name
getSrcLocName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"getSrcLoc")
  Name
excludeVarsName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"excludeVars")

  (HsGroup (GhcPass 'Renamed)
group', Any
_) <-
    ReaderT
  Env
  (IOEnv (Env TcGblEnv TcLclEnv))
  (HsGroup (GhcPass 'Renamed), Any)
-> Env
-> IOEnv (Env TcGblEnv TcLclEnv) (HsGroup (GhcPass 'Renamed), Any)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (WriterT
  Any
  (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
  (HsGroup (GhcPass 'Renamed))
-> ReaderT
     Env
     (IOEnv (Env TcGblEnv TcLclEnv))
     (HsGroup (GhcPass 'Renamed), Any)
forall w (m :: * -> *) a. Monoid w => WriterT w m a -> m (a, w)
runWriterT (WriterT
   Any
   (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
   (HsGroup (GhcPass 'Renamed))
 -> ReaderT
      Env
      (IOEnv (Env TcGblEnv TcLclEnv))
      (HsGroup (GhcPass 'Renamed), Any))
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     (HsGroup (GhcPass 'Renamed))
-> ReaderT
     Env
     (IOEnv (Env TcGblEnv TcLclEnv))
     (HsGroup (GhcPass 'Renamed), Any)
forall a b. (a -> b) -> a -> b
$ HsGroup (GhcPass 'Renamed)
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     (HsGroup (GhcPass 'Renamed))
forall a. Data a => a -> EnvReader a
recurse HsGroup (GhcPass 'Renamed)
group)
      MkEnv { varSet :: VarSet
varSet = VarSet
forall a. Monoid a => a
mempty, Name
captureVarsName :: Name
showLevName :: Name
fromListName :: Name
breakpointName :: Name
queryVarsName :: Name
breakpointMName :: Name
queryVarsMName :: Name
breakpointIOName :: Name
queryVarsIOName :: Name
printAndWaitName :: Name
printAndWaitMName :: Name
printAndWaitIOName :: Name
runPromptIOName :: Name
runPromptMName :: Name
runPromptName :: Name
getSrcLocName :: Name
excludeVarsName :: Name
captureVarsName :: Name
showLevName :: Name
fromListName :: Name
breakpointName :: Name
queryVarsName :: Name
breakpointMName :: Name
queryVarsMName :: Name
breakpointIOName :: Name
queryVarsIOName :: Name
printAndWaitName :: Name
printAndWaitMName :: Name
printAndWaitIOName :: Name
runPromptIOName :: Name
runPromptName :: Name
runPromptMName :: Name
getSrcLocName :: Name
excludeVarsName :: Name
.. }

  (TcGblEnv, HsGroup (GhcPass 'Renamed))
-> TcM (TcGblEnv, HsGroup (GhcPass 'Renamed))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TcGblEnv
gblEnv, HsGroup (GhcPass 'Renamed)
group')

recurse :: Data a => a -> EnvReader a
recurse :: forall a. Data a => a -> EnvReader a
recurse a
a =
  WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
-> (a
    -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a)
-> Maybe a
-> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((forall a. Data a => a -> EnvReader a)
-> a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) 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 (IOEnv (Env TcGblEnv TcLclEnv))) a
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Maybe a
 -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a)
-> WriterT
     Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) (Maybe a)
-> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< a
-> WriterT
     Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) (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 (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> WriterT
     Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) (Maybe a)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT
      (MaybeT
   (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
 -> WriterT
      Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) (Maybe a))
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> WriterT
     Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) (Maybe a)
forall a b. (a -> b) -> a -> b
$ (HsExpr (GhcPass 'Renamed)
 -> EnvReader (Maybe (HsExpr (GhcPass 'Renamed))))
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall b.
Data b =>
(b -> EnvReader (Maybe b))
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
wrap HsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
hsVarCase
    MaybeT
  (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall a.
MaybeT
  (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
 -> EnvReader
      (Maybe (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall b.
Data b =>
(b -> EnvReader (Maybe b))
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
wrap GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> EnvReader
     (Maybe (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
LHsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (LHsExpr (GhcPass 'Renamed)))
hsAppCase
    MaybeT
  (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall a.
MaybeT
  (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Match
   (GhcPass 'Renamed)
   (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
 -> EnvReader
      (Maybe
         (Match
            (GhcPass 'Renamed)
            (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))))
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall b.
Data b =>
(b -> EnvReader (Maybe b))
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
wrap Match
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader
     (Maybe
        (Match
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
Match (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
-> EnvReader
     (Maybe (Match (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))))
matchCase
    MaybeT
  (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall a.
MaybeT
  (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (GRHSs
   (GhcPass 'Renamed)
   (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
 -> EnvReader
      (Maybe
         (GRHSs
            (GhcPass 'Renamed)
            (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))))
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall b.
Data b =>
(b -> EnvReader (Maybe b))
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
wrap GRHSs
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader
     (Maybe
        (GRHSs
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
-> EnvReader
     (Maybe (GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))))
grhssCase
    MaybeT
  (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall a.
MaybeT
  (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (HsExpr (GhcPass 'Renamed)
 -> EnvReader (Maybe (HsExpr (GhcPass 'Renamed))))
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall b.
Data b =>
(b -> EnvReader (Maybe b))
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
wrap HsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
hsLetCase
    MaybeT
  (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall a.
MaybeT
  (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (GRHS
   (GhcPass 'Renamed)
   (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
 -> EnvReader
      (Maybe
         (GRHS
            (GhcPass 'Renamed)
            (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))))
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall b.
Data b =>
(b -> EnvReader (Maybe b))
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
wrap GRHS
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader
     (Maybe
        (GRHS
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
GRHS (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
-> EnvReader
     (Maybe (GRHS (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))))
grhsCase
    MaybeT
  (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall a.
MaybeT
  (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (HsExpr (GhcPass 'Renamed)
 -> EnvReader (Maybe (HsExpr (GhcPass 'Renamed))))
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall b.
Data b =>
(b -> EnvReader (Maybe b))
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
wrap HsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
hsDoCase
    MaybeT
  (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall a.
MaybeT
  (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (HsExpr (GhcPass 'Renamed)
 -> EnvReader (Maybe (HsExpr (GhcPass 'Renamed))))
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall b.
Data b =>
(b -> EnvReader (Maybe b))
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
wrap HsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
hsProcCase
  where
    wrap :: forall b. Data b
         => (b -> EnvReader (Maybe b))
         -> MaybeT EnvReader a
    wrap :: forall b.
Data b =>
(b -> EnvReader (Maybe b))
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) 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 (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall a.
MaybeT
  (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall (f :: * -> *) a. Alternative f => f a
empty
        Just (T a
-> WriterT
     Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) (Maybe a)
f') -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) (Maybe a)
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (WriterT
   Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) (Maybe a)
 -> MaybeT
      (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a)
-> WriterT
     Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) (Maybe a)
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall a b. (a -> b) -> a -> b
$ a
-> WriterT
     Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) (Maybe a)
f' a
a

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

hsVarCase :: Ghc.HsExpr Ghc.GhcRn
          -> EnvReader (Maybe (Ghc.HsExpr Ghc.GhcRn))
hsVarCase :: HsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
hsVarCase (Ghc.HsVar XVar (GhcPass 'Renamed)
_ (Ghc.L SrcSpanAnnN
loc Name
name)) = do
  MkEnv{Name
VarSet
varSet :: Env -> VarSet
captureVarsName :: Env -> Name
showLevName :: Env -> Name
fromListName :: Env -> Name
breakpointName :: Env -> Name
queryVarsName :: Env -> Name
breakpointMName :: Env -> Name
queryVarsMName :: Env -> Name
breakpointIOName :: Env -> Name
queryVarsIOName :: Env -> Name
printAndWaitName :: Env -> Name
printAndWaitMName :: Env -> Name
printAndWaitIOName :: Env -> Name
runPromptIOName :: Env -> Name
runPromptName :: Env -> Name
runPromptMName :: Env -> Name
getSrcLocName :: Env -> Name
excludeVarsName :: Env -> Name
varSet :: VarSet
captureVarsName :: Name
showLevName :: Name
fromListName :: Name
breakpointName :: Name
queryVarsName :: Name
breakpointMName :: Name
queryVarsMName :: Name
breakpointIOName :: Name
queryVarsIOName :: Name
printAndWaitName :: Name
printAndWaitMName :: Name
printAndWaitIOName :: Name
runPromptIOName :: Name
runPromptName :: Name
runPromptMName :: Name
getSrcLocName :: Name
excludeVarsName :: Name
..} <- ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)) Env
-> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) 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 (IOEnv (Env TcGblEnv TcLclEnv)) Env
forall r (m :: * -> *). MonadReader r m => m r
ask

  let srcLocStringExpr :: GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
srcLocStringExpr
        = HsLit (GhcPass 'Renamed)
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
HsLit (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (p :: Pass). HsLit (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsLit (HsLit (GhcPass 'Renamed)
 -> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> (SrcSpan -> HsLit (GhcPass 'Renamed))
-> SrcSpan
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> HsLit (GhcPass 'Renamed)
forall (p :: Pass). String -> HsLit (GhcPass p)
Ghc.mkHsString
        (String -> HsLit (GhcPass 'Renamed))
-> (SrcSpan -> String) -> SrcSpan -> HsLit (GhcPass 'Renamed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SDoc -> String
Ghc.showSDocUnsafe
        (SDoc -> String) -> (SrcSpan -> SDoc) -> SrcSpan -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
Ghc.ppr
        (SrcSpan -> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> SrcSpan -> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnN -> SrcSpan
forall ann. SrcSpanAnn' ann -> SrcSpan
Ghc.locA' SrcSpanAnnN
loc

      captureVarsExpr :: Maybe Name -> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
captureVarsExpr Maybe Name
mResultName =
        let mkTuple :: (LexicalFastString', Name) -> LHsExpr (GhcPass 'Renamed)
mkTuple (LexicalFastString' -> FastString
Ghc.fromLexicalFastString -> FastString
varStr, Name
n) =
              [LHsExpr (GhcPass 'Renamed)]
-> XExplicitTuple (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (p :: Pass).
[LHsExpr (GhcPass p)]
-> XExplicitTuple (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.mkLHsTupleExpr
                [ HsLit (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (p :: Pass). HsLit (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsLit (HsLit (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed))
-> (String -> HsLit (GhcPass 'Renamed))
-> String
-> LHsExpr (GhcPass 'Renamed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> HsLit (GhcPass 'Renamed)
forall (p :: Pass). String -> HsLit (GhcPass p)
Ghc.mkHsString (String -> LHsExpr (GhcPass 'Renamed))
-> String -> LHsExpr (GhcPass 'Renamed)
forall a b. (a -> b) -> a -> b
$ FastString -> String
Ghc.unpackFS FastString
varStr
                , LHsExpr (GhcPass 'Renamed)
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp (IdP (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsVar Name
IdP (GhcPass 'Renamed)
showLevName) (IdP (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsVar Name
IdP (GhcPass 'Renamed)
n)
                ]
#if MIN_VERSION_ghc(9,2,0)
                NoExtField
XExplicitTuple (GhcPass 'Renamed)
Ghc.NoExtField
#endif

            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' NoExtField
XExplicitList p
Ghc.NoExtField [XRec p (HsExpr p)]
exprs)

            varSetWithResult :: VarSet
varSetWithResult
              | Just Name
resName <- Maybe Name
mResultName =
                  LexicalFastString' -> Name -> VarSet -> VarSet
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (FastString -> LexicalFastString'
Ghc.mkLexicalFastString (FastString -> LexicalFastString')
-> FastString -> LexicalFastString'
forall a b. (a -> b) -> a -> b
$ String -> FastString
Ghc.mkFastString String
"*result")
                           Name
resName
                           VarSet
varSet
              | Bool
otherwise = VarSet
varSet

         in LHsExpr (GhcPass 'Renamed)
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp (IdP (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsVar Name
IdP (GhcPass 'Renamed)
fromListName) (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
 -> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> ([GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))]
    -> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> [GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))]
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))]
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
[LHsExpr (GhcPass 'Renamed)]
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
forall {p} {an}.
(XExplicitList p ~ NoExtField) =>
[XRec p (HsExpr p)] -> LocatedAn an (HsExpr p)
mkList
              ([GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))]
 -> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> [GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))]
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ (LexicalFastString', Name)
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
(LexicalFastString', Name) -> LHsExpr (GhcPass 'Renamed)
mkTuple ((LexicalFastString', Name)
 -> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> [(LexicalFastString', Name)]
-> [GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VarSet -> [(LexicalFastString', Name)]
forall k a. Map k a -> [(k, a)]
M.toList VarSet
varSetWithResult

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

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

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

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

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

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

  if | Name
captureVarsName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name -> do
         Any -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell (Any
 -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) ())
-> Any
-> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) ()
forall a b. (a -> b) -> a -> b
$ Bool -> Any
Any Bool
True
         Maybe (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed))
forall a. a -> Maybe a
Just (HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed)))
-> (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
    -> HsExpr (GhcPass 'Renamed))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> Maybe (HsExpr (GhcPass 'Renamed))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> HsExpr (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
Ghc.unLoc (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
 -> Maybe (HsExpr (GhcPass 'Renamed)))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> Maybe (HsExpr (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ Maybe Name -> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
captureVarsExpr Maybe Name
forall a. Maybe a
Nothing)

     | Name
breakpointName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name -> do
         Any -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell (Any
 -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) ())
-> Any
-> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) ()
forall a b. (a -> b) -> a -> b
$ Bool -> Any
Any Bool
True
         HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed))
forall a. a -> Maybe a
Just (HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed)))
-> (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
    -> HsExpr (GhcPass 'Renamed))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> Maybe (HsExpr (GhcPass 'Renamed))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> HsExpr (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
Ghc.unLoc (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
 -> Maybe (HsExpr (GhcPass 'Renamed)))
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
  Env
  (IOEnv (Env TcGblEnv TcLclEnv))
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall (m :: * -> *) a. Monad m => m a -> WriterT Any m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IOEnv
  (Env TcGblEnv TcLclEnv)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> ReaderT
     Env
     (IOEnv (Env TcGblEnv TcLclEnv))
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall (m :: * -> *) a. Monad m => m a -> ReaderT Env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift IOEnv
  (Env TcGblEnv TcLclEnv)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
bpExpr)

     | Name
breakpointMName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name -> do
         Any -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell (Any
 -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) ())
-> Any
-> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) ()
forall a b. (a -> b) -> a -> b
$ Bool -> Any
Any Bool
True
         Maybe (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed))
forall a. a -> Maybe a
Just (HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed)))
-> HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> HsExpr (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
Ghc.unLoc GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
LHsExpr (GhcPass 'Renamed)
bpMExpr)

     | Name
breakpointIOName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name -> do
         Any -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell (Any
 -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) ())
-> Any
-> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) ()
forall a b. (a -> b) -> a -> b
$ Bool -> Any
Any Bool
True
         Maybe (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed))
forall a. a -> Maybe a
Just (HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed)))
-> HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> HsExpr (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
Ghc.unLoc GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
LHsExpr (GhcPass 'Renamed)
bpIOExpr)

     | Name
queryVarsIOName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name -> do
         Any -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell (Any
 -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) ())
-> Any
-> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) ()
forall a b. (a -> b) -> a -> b
$ Bool -> Any
Any Bool
True
         Maybe (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed))
forall a. a -> Maybe a
Just (HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed)))
-> HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> HsExpr (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
Ghc.unLoc GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
LHsExpr (GhcPass 'Renamed)
queryVarsIOExpr)

     | Name
queryVarsName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name -> do
         Any -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell (Any
 -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) ())
-> Any
-> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) ()
forall a b. (a -> b) -> a -> b
$ Bool -> Any
Any Bool
True
         HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed))
forall a. a -> Maybe a
Just (HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed)))
-> (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
    -> HsExpr (GhcPass 'Renamed))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> Maybe (HsExpr (GhcPass 'Renamed))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> HsExpr (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
Ghc.unLoc (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
 -> Maybe (HsExpr (GhcPass 'Renamed)))
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
  Env
  (IOEnv (Env TcGblEnv TcLclEnv))
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall (m :: * -> *) a. Monad m => m a -> WriterT Any m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IOEnv
  (Env TcGblEnv TcLclEnv)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> ReaderT
     Env
     (IOEnv (Env TcGblEnv TcLclEnv))
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall (m :: * -> *) a. Monad m => m a -> ReaderT Env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift IOEnv
  (Env TcGblEnv TcLclEnv)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
queryVarsExpr)

     | Name
queryVarsMName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name -> do
         Any -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell (Any
 -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) ())
-> Any
-> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) ()
forall a b. (a -> b) -> a -> b
$ Bool -> Any
Any Bool
True
         Maybe (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed))
forall a. a -> Maybe a
Just (HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed)))
-> HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> HsExpr (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
Ghc.unLoc GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
LHsExpr (GhcPass 'Renamed)
queryVarsMExpr)

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

     | Bool
otherwise -> Maybe (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (HsExpr (GhcPass 'Renamed))
forall a. Maybe a
Nothing
hsVarCase HsExpr (GhcPass 'Renamed)
_ = Maybe (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (HsExpr (GhcPass 'Renamed))
forall a. Maybe a
Nothing

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

hsAppCase :: Ghc.LHsExpr Ghc.GhcRn
          -> EnvReader (Maybe (Ghc.LHsExpr Ghc.GhcRn))
hsAppCase :: LHsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (LHsExpr (GhcPass 'Renamed)))
hsAppCase (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> HsExpr (GhcPass 'Renamed)
LHsExpr (GhcPass 'Renamed) -> HsExpr (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
Ghc.unLoc -> Ghc.HsApp XApp (GhcPass 'Renamed)
_ LHsExpr (GhcPass 'Renamed)
f LHsExpr (GhcPass 'Renamed)
innerExpr)
  | Ghc.HsApp XApp (GhcPass 'Renamed)
_ (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> HsExpr (GhcPass 'Renamed)
LHsExpr (GhcPass 'Renamed) -> HsExpr (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
Ghc.unLoc -> Ghc.HsVar XVar (GhcPass 'Renamed)
_ (GenLocated SrcSpanAnnN Name -> Name
LIdP (GhcPass 'Renamed) -> Name
forall l e. GenLocated l e -> e
Ghc.unLoc -> Name
name))
                (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> HsExpr (GhcPass 'Renamed)
LHsExpr (GhcPass 'Renamed) -> HsExpr (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
Ghc.unLoc -> Ghc.ExplicitList' XExplicitList (GhcPass 'Renamed)
_ [LHsExpr (GhcPass 'Renamed)]
exprsToExclude)
      <- GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> HsExpr (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
Ghc.unLoc GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
LHsExpr (GhcPass 'Renamed)
f
  = do
    MkEnv{Name
VarSet
varSet :: Env -> VarSet
captureVarsName :: Env -> Name
showLevName :: Env -> Name
fromListName :: Env -> Name
breakpointName :: Env -> Name
queryVarsName :: Env -> Name
breakpointMName :: Env -> Name
queryVarsMName :: Env -> Name
breakpointIOName :: Env -> Name
queryVarsIOName :: Env -> Name
printAndWaitName :: Env -> Name
printAndWaitMName :: Env -> Name
printAndWaitIOName :: Env -> Name
runPromptIOName :: Env -> Name
runPromptName :: Env -> Name
runPromptMName :: Env -> Name
getSrcLocName :: Env -> Name
excludeVarsName :: Env -> Name
varSet :: VarSet
captureVarsName :: Name
showLevName :: Name
fromListName :: Name
breakpointName :: Name
queryVarsName :: Name
breakpointMName :: Name
queryVarsMName :: Name
breakpointIOName :: Name
queryVarsIOName :: Name
printAndWaitName :: Name
printAndWaitMName :: Name
printAndWaitIOName :: Name
runPromptIOName :: Name
runPromptName :: Name
runPromptMName :: Name
getSrcLocName :: Name
excludeVarsName :: Name
..} <- ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)) Env
-> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) 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 (IOEnv (Env TcGblEnv TcLclEnv)) Env
forall r (m :: * -> *). MonadReader r m => m r
ask
    if Name
excludeVarsName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= Name
name
       then Maybe (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader
     (Maybe (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall a. Maybe a
Nothing
       else do
         let extractVarName :: HsExpr (GhcPass 'Renamed) -> Maybe LexicalFastString'
extractVarName (Ghc.HsLit XLitE (GhcPass 'Renamed)
_ (Ghc.HsString XHsString (GhcPass 'Renamed)
_ FastString
fs)) =
               LexicalFastString' -> Maybe LexicalFastString'
forall a. a -> Maybe a
Just (LexicalFastString' -> Maybe LexicalFastString')
-> LexicalFastString' -> Maybe LexicalFastString'
forall a b. (a -> b) -> a -> b
$ FastString -> LexicalFastString'
Ghc.mkLexicalFastString FastString
fs
             extractVarName (Ghc.HsOverLit XOverLitE (GhcPass 'Renamed)
_ (Ghc.OverLit' (Ghc.HsIsString SourceText
_ FastString
fs))) =
               LexicalFastString' -> Maybe LexicalFastString'
forall a. a -> Maybe a
Just (LexicalFastString' -> Maybe LexicalFastString')
-> LexicalFastString' -> Maybe LexicalFastString'
forall a b. (a -> b) -> a -> b
$ FastString -> LexicalFastString'
Ghc.mkLexicalFastString FastString
fs
             extractVarName HsExpr (GhcPass 'Renamed)
_ = Maybe LexicalFastString'
forall a. Maybe a
Nothing

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

         GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> Maybe (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall a. a -> Maybe a
Just (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
 -> Maybe (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader
     (Maybe (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
           (ReaderT
   Env
   (IOEnv (Env TcGblEnv TcLclEnv))
   (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)), Any)
 -> ReaderT
      Env
      (IOEnv (Env TcGblEnv TcLclEnv))
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)), Any))
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall (n :: * -> *) w w' (m :: * -> *) a b.
(Monad n, Monoid w, Monoid w') =>
(m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
mapWriterT
            ((Env -> Env)
-> ReaderT
     Env
     (IOEnv (Env TcGblEnv TcLclEnv))
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)), Any)
-> ReaderT
     Env
     (IOEnv (Env TcGblEnv TcLclEnv))
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)), Any)
forall a.
(Env -> Env)
-> ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)) a
-> ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ((VarSet -> VarSet) -> Env -> Env
overVarSet ((VarSet -> VarSet) -> Env -> Env)
-> (VarSet -> VarSet) -> Env -> Env
forall a b. (a -> b) -> a -> b
$ \VarSet
vs -> (LexicalFastString' -> VarSet -> VarSet)
-> VarSet -> [LexicalFastString'] -> VarSet
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr LexicalFastString' -> VarSet -> VarSet
forall k a. Ord k => k -> Map k a -> Map k a
M.delete VarSet
vs [LexicalFastString']
varsToExclude))
            (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall a. Data a => a -> EnvReader a
recurse GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
LHsExpr (GhcPass 'Renamed)
innerExpr)
hsAppCase LHsExpr (GhcPass 'Renamed)
_ = Maybe (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader
     (Maybe (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
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 (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
-> EnvReader
     (Maybe (Match (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))))
matchCase Ghc.Match {[LPat (GhcPass 'Renamed)]
GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
HsMatchContext (GhcPass 'Renamed)
XCMatch (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
m_ext :: XCMatch (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
m_ctxt :: HsMatchContext (GhcPass 'Renamed)
m_pats :: [LPat (GhcPass 'Renamed)]
m_grhss :: GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
m_ctxt :: forall p body. Match p body -> HsMatchContext p
m_ext :: forall p body. Match p body -> XCMatch p body
m_grhss :: forall p body. Match p body -> GRHSs p body
m_pats :: forall p body. Match p body -> [LPat p]
..} = do
  let names :: VarSet
names = (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)) -> VarSet)
-> [GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))] -> VarSet
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)) -> VarSet
LPat (GhcPass 'Renamed) -> VarSet
extractVarPats [GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))]
[LPat (GhcPass 'Renamed)]
m_pats
  GRHSs
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
grhRes <- VarSet
-> EnvReader
     (GRHSs
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> EnvReader
     (GRHSs
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
forall a. VarSet -> EnvReader a -> EnvReader a
addScopedVars VarSet
names (EnvReader
   (GRHSs
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
 -> EnvReader
      (GRHSs
         (GhcPass 'Renamed)
         (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
-> EnvReader
     (GRHSs
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> EnvReader
     (GRHSs
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
forall a b. (a -> b) -> a -> b
$ GRHSs
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader
     (GRHSs
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
forall a. Data a => a -> EnvReader a
recurse GRHSs
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
m_grhss
  Maybe
  (Match
     (GhcPass 'Renamed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> EnvReader
     (Maybe
        (Match
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe
   (Match
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
 -> EnvReader
      (Maybe
         (Match
            (GhcPass 'Renamed)
            (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))))
-> Maybe
     (Match
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> EnvReader
     (Maybe
        (Match
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
forall a b. (a -> b) -> a -> b
$ Match
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> Maybe
     (Match
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
forall a. a -> Maybe a
Just
    Ghc.Match { m_grhss :: GRHSs
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
Ghc.m_grhss = GRHSs
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
grhRes, [LPat (GhcPass 'Renamed)]
HsMatchContext (GhcPass 'Renamed)
XCMatch
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
XCMatch (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
m_ext :: XCMatch (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
m_ctxt :: HsMatchContext (GhcPass 'Renamed)
m_pats :: [LPat (GhcPass 'Renamed)]
m_ctxt :: HsMatchContext (GhcPass 'Renamed)
m_ext :: XCMatch
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
m_pats :: [LPat (GhcPass 'Renamed)]
.. }
#if !MIN_VERSION_ghc(9,0,0)
matchCase _ = pure Nothing
#endif

extractVarPats :: Ghc.LPat Ghc.GhcRn -> VarSet
extractVarPats :: LPat (GhcPass 'Renamed) -> VarSet
extractVarPats = [Name] -> VarSet
mkVarSet ([Name] -> VarSet)
-> (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)) -> [Name])
-> GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
-> VarSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)) -> [Name]
LPat (GhcPass 'Renamed) -> [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 (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
-> EnvReader
     (Maybe (GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))))
grhssCase Ghc.GRHSs {[LGRHS (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))]
HsLocalBinds (GhcPass 'Renamed)
XCGRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
grhssExt :: XCGRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
grhssGRHSs :: [LGRHS (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))]
grhssLocalBinds :: HsLocalBinds (GhcPass 'Renamed)
grhssExt :: forall p body. GRHSs p body -> XCGRHSs p body
grhssGRHSs :: forall p body. GRHSs p body -> [LGRHS p body]
grhssLocalBinds :: forall p body. GRHSs p body -> HsLocalBinds p
..} = do
  (HsLocalBinds (GhcPass 'Renamed)
localBindsRes, VarSet
names)
    <- HsLocalBinds (GhcPass 'Renamed)
-> EnvReader (HsLocalBinds (GhcPass 'Renamed), VarSet)
dealWithLocalBinds
#if MIN_VERSION_ghc(9,2,0)
         HsLocalBinds (GhcPass 'Renamed)
grhssLocalBinds
#else
         (Ghc.unLoc grhssLocalBinds)
#endif

  [GenLocated
   (SrcAnn NoEpAnns)
   (GRHS
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
grhsRes <- VarSet
-> EnvReader
     [GenLocated
        (SrcAnn NoEpAnns)
        (GRHS
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> EnvReader
     [GenLocated
        (SrcAnn NoEpAnns)
        (GRHS
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
forall a. VarSet -> EnvReader a -> EnvReader a
addScopedVars VarSet
names (EnvReader
   [GenLocated
      (SrcAnn NoEpAnns)
      (GRHS
         (GhcPass 'Renamed)
         (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
 -> EnvReader
      [GenLocated
         (SrcAnn NoEpAnns)
         (GRHS
            (GhcPass 'Renamed)
            (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))])
-> EnvReader
     [GenLocated
        (SrcAnn NoEpAnns)
        (GRHS
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> EnvReader
     [GenLocated
        (SrcAnn NoEpAnns)
        (GRHS
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
forall a b. (a -> b) -> a -> b
$ [GenLocated
   (SrcAnn NoEpAnns)
   (GRHS
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> EnvReader
     [GenLocated
        (SrcAnn NoEpAnns)
        (GRHS
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
forall a. Data a => a -> EnvReader a
recurse [GenLocated
   (SrcAnn NoEpAnns)
   (GRHS
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
[LGRHS (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))]
grhssGRHSs
  Maybe
  (GRHSs
     (GhcPass 'Renamed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> EnvReader
     (Maybe
        (GRHSs
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe
   (GRHSs
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
 -> EnvReader
      (Maybe
         (GRHSs
            (GhcPass 'Renamed)
            (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))))
-> Maybe
     (GRHSs
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> EnvReader
     (Maybe
        (GRHSs
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
forall a b. (a -> b) -> a -> b
$ GRHSs
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> Maybe
     (GRHSs
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
forall a. a -> Maybe a
Just
    Ghc.GRHSs { grhssGRHSs :: [LGRHS
   (GhcPass 'Renamed)
   (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))]
Ghc.grhssGRHSs = [GenLocated
   (SrcAnn NoEpAnns)
   (GRHS
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
[LGRHS
   (GhcPass 'Renamed)
   (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))]
grhsRes
#if MIN_VERSION_ghc(9,2,0)
              , grhssLocalBinds :: HsLocalBinds (GhcPass 'Renamed)
grhssLocalBinds = HsLocalBinds (GhcPass 'Renamed)
localBindsRes
#else
              , grhssLocalBinds = localBindsRes <$ grhssLocalBinds
#endif
              , XCGRHSs
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
XCGRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
grhssExt :: XCGRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
grhssExt :: XCGRHSs
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
..
              }
#if !MIN_VERSION_ghc(9,0,0)
grhssCase _ = pure Nothing
#endif

dealWithBind :: VarSet
             -> Ghc.LHsBind Ghc.GhcRn
             -> EnvReader (Ghc.LHsBind Ghc.GhcRn)
dealWithBind :: VarSet
-> LHsBind (GhcPass 'Renamed)
-> EnvReader (LHsBind (GhcPass 'Renamed))
dealWithBind VarSet
resultNames LHsBind (GhcPass 'Renamed)
lbind = GenLocated
  SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
-> (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    -> WriterT
         Any
         (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
         (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     (GenLocated
        SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for GenLocated
  SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
LHsBind (GhcPass 'Renamed)
lbind ((HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
  -> WriterT
       Any
       (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
       (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
 -> WriterT
      Any
      (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
      (GenLocated
         SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))))
-> (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    -> WriterT
         Any
         (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
         (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     (GenLocated
        SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
forall a b. (a -> b) -> a -> b
$ \case
  Ghc.FunBind {[CoreTickish]
LIdP (GhcPass 'Renamed)
MatchGroup (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
XFunBind (GhcPass 'Renamed) (GhcPass 'Renamed)
fun_ext :: XFunBind (GhcPass 'Renamed) (GhcPass 'Renamed)
fun_id :: LIdP (GhcPass 'Renamed)
fun_matches :: MatchGroup (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
fun_tick :: [CoreTickish]
fun_ext :: forall idL idR. HsBindLR idL idR -> XFunBind idL idR
fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_tick :: forall idL idR. HsBindLR idL idR -> [CoreTickish]
..} -> 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 GenLocated SrcSpanAnnN Name
LIdP (GhcPass 'Renamed)
fun_id) VarSet
resultNames
    (MatchGroup
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
matchesRes, Any Bool
containsTarget)
      <- WriterT
  Any
  (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
  (MatchGroup
     (GhcPass 'Renamed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     (MatchGroup
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))),
      Any)
forall w (m :: * -> *) a.
(Monoid w, Monad m) =>
WriterT w m a -> WriterT w m (a, w)
listen
       (WriterT
   Any
   (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
   (MatchGroup
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
 -> WriterT
      Any
      (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
      (MatchGroup
         (GhcPass 'Renamed)
         (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))),
       Any))
-> (WriterT
      Any
      (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
      (MatchGroup
         (GhcPass 'Renamed)
         (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
    -> WriterT
         Any
         (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
         (MatchGroup
            (GhcPass 'Renamed)
            (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     (MatchGroup
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     (MatchGroup
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))),
      Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarSet
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     (MatchGroup
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     (MatchGroup
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
forall a. VarSet -> EnvReader a -> EnvReader a
addScopedVars VarSet
resultNamesSansSelf
       (WriterT
   Any
   (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
   (MatchGroup
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
 -> WriterT
      Any
      (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
      (MatchGroup
         (GhcPass 'Renamed)
         (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))),
       Any))
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     (MatchGroup
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     (MatchGroup
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))),
      Any)
forall a b. (a -> b) -> a -> b
$ MatchGroup
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     (MatchGroup
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
forall a. Data a => a -> EnvReader a
recurse MatchGroup
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
MatchGroup (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
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 (GhcPass 'Renamed) (GhcPass 'Renamed)
UniqSet Name
fun_ext
          | Bool
otherwise = XFunBind (GhcPass 'Renamed) (GhcPass 'Renamed)
UniqSet Name
fun_ext
    HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ghc.FunBind { fun_matches :: MatchGroup (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
Ghc.fun_matches = MatchGroup
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
MatchGroup (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
matchesRes, fun_ext :: XFunBind (GhcPass 'Renamed) (GhcPass 'Renamed)
Ghc.fun_ext = XFunBind (GhcPass 'Renamed) (GhcPass 'Renamed)
UniqSet Name
rhsVars, [CoreTickish]
LIdP (GhcPass 'Renamed)
fun_id :: LIdP (GhcPass 'Renamed)
fun_tick :: [CoreTickish]
fun_id :: LIdP (GhcPass 'Renamed)
fun_tick :: [CoreTickish]
.. }

  Ghc.PatBind {([CoreTickish], [[CoreTickish]])
LPat (GhcPass 'Renamed)
GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
XPatBind (GhcPass 'Renamed) (GhcPass 'Renamed)
pat_ext :: XPatBind (GhcPass 'Renamed) (GhcPass 'Renamed)
pat_lhs :: LPat (GhcPass 'Renamed)
pat_rhs :: GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
pat_ticks :: ([CoreTickish], [[CoreTickish]])
pat_ext :: forall idL idR. HsBindLR idL idR -> XPatBind idL idR
pat_lhs :: forall idL idR. HsBindLR idL idR -> LPat idL
pat_rhs :: forall idL idR. HsBindLR idL idR -> GRHSs idR (LHsExpr idR)
pat_ticks :: forall idL idR.
HsBindLR idL idR -> ([CoreTickish], [[CoreTickish]])
..} -> do
    (GRHSs
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
rhsRes, Any Bool
containsTarget)
      <- EnvReader
  (GRHSs
     (GhcPass 'Renamed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     (GRHSs
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))),
      Any)
forall w (m :: * -> *) a.
(Monoid w, Monad m) =>
WriterT w m a -> WriterT w m (a, w)
listen
       (EnvReader
   (GRHSs
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
 -> WriterT
      Any
      (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
      (GRHSs
         (GhcPass 'Renamed)
         (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))),
       Any))
-> (EnvReader
      (GRHSs
         (GhcPass 'Renamed)
         (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
    -> EnvReader
         (GRHSs
            (GhcPass 'Renamed)
            (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
-> EnvReader
     (GRHSs
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     (GRHSs
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))),
      Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarSet
-> EnvReader
     (GRHSs
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> EnvReader
     (GRHSs
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
forall a. VarSet -> EnvReader a -> EnvReader a
addScopedVars VarSet
resultNames
       (EnvReader
   (GRHSs
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
 -> WriterT
      Any
      (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
      (GRHSs
         (GhcPass 'Renamed)
         (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))),
       Any))
-> EnvReader
     (GRHSs
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     (GRHSs
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))),
      Any)
forall a b. (a -> b) -> a -> b
$ GRHSs
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader
     (GRHSs
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
forall a. Data a => a -> EnvReader a
recurse GRHSs
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
pat_rhs
    let rhsVars :: UniqSet Name
rhsVars
          | Bool
containsTarget
          = [Name] -> UniqSet Name
forall a. Uniquable a => [a] -> UniqSet a
Ghc.mkUniqSet ([Name] -> UniqSet Name)
-> ([Name] -> [Name]) -> [Name] -> UniqSet Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarSet -> [Name]
forall k a. Map k a -> [a]
M.elems
            (VarSet -> [Name]) -> ([Name] -> VarSet) -> [Name] -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VarSet -> VarSet -> VarSet
forall a. Semigroup a => a -> a -> a
<> VarSet
resultNames) (VarSet -> VarSet) -> ([Name] -> VarSet) -> [Name] -> VarSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Name] -> VarSet
mkVarSet
            ([Name] -> UniqSet Name) -> [Name] -> UniqSet Name
forall a b. (a -> b) -> a -> b
$ UniqSet Name -> [Name]
forall elt. UniqSet elt -> [elt]
Ghc.nonDetEltsUniqSet XPatBind (GhcPass 'Renamed) (GhcPass 'Renamed)
UniqSet Name
pat_ext
          | Bool
otherwise = XPatBind (GhcPass 'Renamed) (GhcPass 'Renamed)
UniqSet Name
pat_ext
    HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ghc.PatBind { pat_rhs :: GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
Ghc.pat_rhs = GRHSs
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
rhsRes, pat_ext :: XPatBind (GhcPass 'Renamed) (GhcPass 'Renamed)
pat_ext = XPatBind (GhcPass 'Renamed) (GhcPass 'Renamed)
UniqSet Name
rhsVars, ([CoreTickish], [[CoreTickish]])
LPat (GhcPass 'Renamed)
pat_lhs :: LPat (GhcPass 'Renamed)
pat_ticks :: ([CoreTickish], [[CoreTickish]])
pat_lhs :: LPat (GhcPass 'Renamed)
pat_ticks :: ([CoreTickish], [[CoreTickish]])
.. }

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

  Ghc.PatSynBind XPatSynBind (GhcPass 'Renamed) (GhcPass 'Renamed)
x Ghc.PSB {LIdP (GhcPass 'Renamed)
LPat (GhcPass 'Renamed)
HsPatSynDir (GhcPass 'Renamed)
XPSB (GhcPass 'Renamed) (GhcPass 'Renamed)
HsPatSynDetails (GhcPass 'Renamed)
psb_ext :: XPSB (GhcPass 'Renamed) (GhcPass 'Renamed)
psb_id :: LIdP (GhcPass 'Renamed)
psb_args :: HsPatSynDetails (GhcPass 'Renamed)
psb_def :: LPat (GhcPass 'Renamed)
psb_dir :: HsPatSynDir (GhcPass 'Renamed)
psb_args :: forall idL idR. PatSynBind idL idR -> HsPatSynDetails idR
psb_def :: forall idL idR. PatSynBind idL idR -> LPat idR
psb_dir :: forall idL idR. PatSynBind idL idR -> HsPatSynDir idR
psb_ext :: forall idL idR. PatSynBind idL idR -> XPSB idL idR
psb_id :: forall idL idR. PatSynBind idL idR -> LIdP idL
..} -> do
    (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
defRes, Any Bool
containsTarget)
      <- WriterT
  Any
  (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
  (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)), Any)
forall w (m :: * -> *) a.
(Monoid w, Monad m) =>
WriterT w m a -> WriterT w m (a, w)
listen
       (WriterT
   Any
   (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
   (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
 -> WriterT
      Any
      (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
      (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)), Any))
-> (WriterT
      Any
      (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
      (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
    -> WriterT
         Any
         (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
         (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))))
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)), Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarSet
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
forall a. VarSet -> EnvReader a -> EnvReader a
addScopedVars VarSet
resultNames
       (WriterT
   Any
   (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
   (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
 -> WriterT
      Any
      (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
      (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)), Any))
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)), Any)
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
forall a. Data a => a -> EnvReader a
recurse GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
LPat (GhcPass 'Renamed)
psb_def
    let rhsVars :: UniqSet Name
rhsVars
          | Bool
containsTarget
          = [Name] -> UniqSet Name
forall a. Uniquable a => [a] -> UniqSet a
Ghc.mkUniqSet ([Name] -> UniqSet Name)
-> ([Name] -> [Name]) -> [Name] -> UniqSet Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarSet -> [Name]
forall k a. Map k a -> [a]
M.elems
            (VarSet -> [Name]) -> ([Name] -> VarSet) -> [Name] -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VarSet -> VarSet -> VarSet
forall a. Semigroup a => a -> a -> a
<> VarSet
resultNames) (VarSet -> VarSet) -> ([Name] -> VarSet) -> [Name] -> VarSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Name] -> VarSet
mkVarSet
            ([Name] -> UniqSet Name) -> [Name] -> UniqSet Name
forall a b. (a -> b) -> a -> b
$ UniqSet Name -> [Name]
forall elt. UniqSet elt -> [elt]
Ghc.nonDetEltsUniqSet XPSB (GhcPass 'Renamed) (GhcPass 'Renamed)
UniqSet Name
psb_ext
          | Bool
otherwise = XPSB (GhcPass 'Renamed) (GhcPass 'Renamed)
UniqSet Name
psb_ext
    HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
 -> WriterT
      Any
      (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
      (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
-> HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ XPatSynBind (GhcPass 'Renamed) (GhcPass 'Renamed)
-> PatSynBind (GhcPass 'Renamed) (GhcPass 'Renamed)
-> HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
forall idL idR.
XPatSynBind idL idR -> PatSynBind idL idR -> HsBindLR idL idR
Ghc.PatSynBind XPatSynBind (GhcPass 'Renamed) (GhcPass 'Renamed)
x Ghc.PSB { psb_def :: LPat (GhcPass 'Renamed)
psb_def = GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
LPat (GhcPass 'Renamed)
defRes, psb_ext :: XPSB (GhcPass 'Renamed) (GhcPass 'Renamed)
psb_ext = XPSB (GhcPass 'Renamed) (GhcPass 'Renamed)
UniqSet Name
rhsVars, LIdP (GhcPass 'Renamed)
HsPatSynDir (GhcPass 'Renamed)
HsPatSynDetails (GhcPass 'Renamed)
psb_id :: LIdP (GhcPass 'Renamed)
psb_args :: HsPatSynDetails (GhcPass 'Renamed)
psb_dir :: HsPatSynDir (GhcPass 'Renamed)
psb_args :: HsPatSynDetails (GhcPass 'Renamed)
psb_dir :: HsPatSynDir (GhcPass 'Renamed)
psb_id :: LIdP (GhcPass 'Renamed)
.. }

#if !MIN_VERSION_ghc(9,4,0)
  other -> pure other
#endif

grhsCase :: Ghc.GRHS Ghc.GhcRn (Ghc.LHsExpr Ghc.GhcRn)
         -> EnvReader (Maybe (Ghc.GRHS Ghc.GhcRn (Ghc.LHsExpr Ghc.GhcRn)))
grhsCase :: GRHS (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
-> EnvReader
     (Maybe (GRHS (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))))
grhsCase (Ghc.GRHS XCGRHS (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
x [GuardLStmt (GhcPass 'Renamed)]
guards LHsExpr (GhcPass 'Renamed)
body) = do
  ([GenLocated
   (Anno
      (Stmt
         (GhcPass 'Renamed)
         (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
   (Stmt
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
guardsRes, VarSet
names) <- WriterT
  VarSet
  (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
  [GenLocated
     (Anno
        (Stmt
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
     (Stmt
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     ([GenLocated
         (Anno
            (Stmt
               (GhcPass 'Renamed)
               (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
         (Stmt
            (GhcPass 'Renamed)
            (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
      VarSet)
forall w (m :: * -> *) a. Monoid w => WriterT w m a -> m (a, w)
runWriterT (WriterT
   VarSet
   (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
   [GenLocated
      (Anno
         (Stmt
            (GhcPass 'Renamed)
            (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
      (Stmt
         (GhcPass 'Renamed)
         (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
 -> WriterT
      Any
      (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
      ([GenLocated
          (Anno
             (Stmt
                (GhcPass 'Renamed)
                (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
          (Stmt
             (GhcPass 'Renamed)
             (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
       VarSet))
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     [GenLocated
        (Anno
           (Stmt
              (GhcPass 'Renamed)
              (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
        (Stmt
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     ([GenLocated
         (Anno
            (Stmt
               (GhcPass 'Renamed)
               (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
         (Stmt
            (GhcPass 'Renamed)
            (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
      VarSet)
forall a b. (a -> b) -> a -> b
$ [LStmt
   (GhcPass 'Renamed)
   (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))]
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     [LStmt
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))]
forall body.
(Data body, Data (Stmt (GhcPass 'Renamed) body)) =>
[LStmt (GhcPass 'Renamed) body]
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     [LStmt (GhcPass 'Renamed) body]
dealWithStatements [LStmt
   (GhcPass 'Renamed)
   (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))]
[GuardLStmt (GhcPass 'Renamed)]
guards
  GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
bodyRes <- VarSet
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall a. VarSet -> EnvReader a -> EnvReader a
addScopedVars VarSet
names (WriterT
   Any
   (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
   (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
 -> WriterT
      Any
      (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall a. Data a => a -> EnvReader a
recurse GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
LHsExpr (GhcPass 'Renamed)
body
  Maybe
  (GRHS
     (GhcPass 'Renamed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> EnvReader
     (Maybe
        (GRHS
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe
   (GRHS
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
 -> EnvReader
      (Maybe
         (GRHS
            (GhcPass 'Renamed)
            (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))))
-> (GRHS
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
    -> Maybe
         (GRHS
            (GhcPass 'Renamed)
            (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
-> GRHS
     (GhcPass 'Renamed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader
     (Maybe
        (GRHS
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GRHS
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> Maybe
     (GRHS
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
forall a. a -> Maybe a
Just (GRHS
   (GhcPass 'Renamed)
   (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
 -> EnvReader
      (Maybe
         (GRHS
            (GhcPass 'Renamed)
            (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))))
-> GRHS
     (GhcPass 'Renamed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader
     (Maybe
        (GRHS
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
forall a b. (a -> b) -> a -> b
$ XCGRHS
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> [GuardLStmt (GhcPass 'Renamed)]
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> GRHS
     (GhcPass 'Renamed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
Ghc.GRHS XCGRHS
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
XCGRHS (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
x [GenLocated
   (Anno
      (Stmt
         (GhcPass 'Renamed)
         (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
   (Stmt
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
[GuardLStmt (GhcPass 'Renamed)]
guardsRes GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
bodyRes
#if !MIN_VERSION_ghc(9,0,0)
grhsCase _ = pure Nothing
#endif

--------------------------------------------------------------------------------
-- 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 (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
hsLetCase (Ghc.HsLet' XLet (GhcPass 'Renamed)
x LetToken
letToken (Ghc.L SrcSpan
loc HsLocalBinds (GhcPass 'Renamed)
localBinds) InToken
inToken LHsExpr (GhcPass 'Renamed)
inExpr) = do
  (HsLocalBinds (GhcPass 'Renamed)
bindsRes, VarSet
names) <- HsLocalBinds (GhcPass 'Renamed)
-> EnvReader (HsLocalBinds (GhcPass 'Renamed), VarSet)
dealWithLocalBinds HsLocalBinds (GhcPass 'Renamed)
localBinds

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

dealWithLocalBinds
  :: Ghc.HsLocalBinds Ghc.GhcRn
  -> EnvReader (Ghc.HsLocalBinds Ghc.GhcRn, VarSet)
dealWithLocalBinds :: HsLocalBinds (GhcPass 'Renamed)
-> EnvReader (HsLocalBinds (GhcPass 'Renamed), VarSet)
dealWithLocalBinds = \case
  hlb :: HsLocalBinds (GhcPass 'Renamed)
hlb@(Ghc.HsValBinds XHsValBinds (GhcPass 'Renamed) (GhcPass 'Renamed)
x HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
valBinds) -> case HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
valBinds of
    Ghc.ValBinds{} -> (HsLocalBinds (GhcPass 'Renamed), VarSet)
-> EnvReader (HsLocalBinds (GhcPass 'Renamed), VarSet)
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsLocalBinds (GhcPass 'Renamed)
hlb, VarSet
forall a. Monoid a => a
mempty)
    Ghc.XValBindsLR (Ghc.NValBinds [(RecFlag, LHsBinds (GhcPass 'Renamed))]
bindPairs [LSig (GhcPass 'Renamed)]
sigs) -> do
      let binds :: [LHsBind (GhcPass 'Renamed)]
binds = Bag
  (GenLocated
     SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
-> [GenLocated
      SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
Bag
  (GenLocated
     SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
-> [LHsBind (GhcPass 'Renamed)]
forall a. Bag a -> [a]
Ghc.bagToList
                (Bag
   (GenLocated
      SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
 -> [LHsBind (GhcPass 'Renamed)])
-> ([Bag
       (GenLocated
          SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))]
    -> Bag
         (GenLocated
            SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))))
-> [Bag
      (GenLocated
         SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))]
-> [LHsBind (GhcPass 'Renamed)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Bag
   (GenLocated
      SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))]
-> Bag
     (GenLocated
        SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
forall a. [Bag a] -> Bag a
Ghc.unionManyBags
                ([Bag
    (GenLocated
       SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))]
 -> [LHsBind (GhcPass 'Renamed)])
-> [Bag
      (GenLocated
         SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))]
-> [LHsBind (GhcPass 'Renamed)]
forall a b. (a -> b) -> a -> b
$ ((RecFlag,
  Bag
    (GenLocated
       SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))))
 -> Bag
      (GenLocated
         SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))))
-> [(RecFlag,
     Bag
       (GenLocated
          SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))))]
-> [Bag
      (GenLocated
         SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))]
forall a b. (a -> b) -> [a] -> [b]
map (RecFlag,
 Bag
   (GenLocated
      SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))))
-> Bag
     (GenLocated
        SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
forall a b. (a, b) -> b
snd [(RecFlag,
  Bag
    (GenLocated
       SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))))]
[(RecFlag, LHsBinds (GhcPass 'Renamed))]
bindPairs :: [Ghc.LHsBind Ghc.GhcRn]
          names :: [[Name]]
names = (GenLocated
   SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
 -> [Name])
-> [GenLocated
      SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
-> [[Name]]
forall a b. (a -> b) -> [a] -> [b]
map ((HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed) -> [Name])
-> GenLocated
     SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
-> [Name]
forall m a. Monoid m => (a -> m) -> GenLocated SrcSpanAnnA a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed) -> [Name]
forall idR. HsBindLR (GhcPass 'Renamed) idR -> [Name]
Ghc.collectHsBindBinders')
                      [GenLocated
   SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
[LHsBind (GhcPass 'Renamed)]
binds
          resultNames :: VarSet
resultNames = [Name] -> VarSet
mkVarSet ([Name] -> VarSet) -> [Name] -> VarSet
forall a b. (a -> b) -> a -> b
$ [[Name]] -> [Name]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Name]]
names

      ([(GenLocated
    SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
  [Name])]
resBindsWithNames, Any Bool
containsTarget)
        <- WriterT
  Any
  (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
  [(GenLocated
      SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
    [Name])]
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     ([(GenLocated
          SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
        [Name])],
      Any)
forall w (m :: * -> *) a.
(Monoid w, Monad m) =>
WriterT w m a -> WriterT w m (a, w)
listen
         (WriterT
   Any
   (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
   [(GenLocated
       SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
     [Name])]
 -> WriterT
      Any
      (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
      ([(GenLocated
           SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
         [Name])],
       Any))
-> (WriterT
      Any
      (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
      [GenLocated
         SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
    -> WriterT
         Any
         (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
         [(GenLocated
             SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
           [Name])])
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     [GenLocated
        SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     ([(GenLocated
          SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
        [Name])],
      Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([GenLocated
    SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
 -> [(GenLocated
        SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
      [Name])])
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     [GenLocated
        SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     [(GenLocated
         SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
       [Name])]
forall a b.
(a -> b)
-> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
-> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([GenLocated
   SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
-> [[Name]]
-> [(GenLocated
       SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
     [Name])]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [[Name]]
names)
         (WriterT
   Any
   (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
   [GenLocated
      SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
 -> WriterT
      Any
      (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
      ([(GenLocated
           SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
         [Name])],
       Any))
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     [GenLocated
        SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     ([(GenLocated
          SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
        [Name])],
      Any)
forall a b. (a -> b) -> a -> b
$ (GenLocated
   SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
 -> WriterT
      Any
      (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
      (GenLocated
         SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))))
-> [GenLocated
      SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     [GenLocated
        SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (VarSet
-> LHsBind (GhcPass 'Renamed)
-> EnvReader (LHsBind (GhcPass 'Renamed))
dealWithBind VarSet
resultNames) [GenLocated
   SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
[LHsBind (GhcPass 'Renamed)]
binds

      if Bool -> Bool
not Bool
containsTarget
         then (HsLocalBinds (GhcPass 'Renamed), VarSet)
-> EnvReader (HsLocalBinds (GhcPass 'Renamed), VarSet)
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsLocalBinds (GhcPass 'Renamed)
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 (GhcPass 'Renamed) (GhcPass 'Renamed)), b)
-> (t (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)), b,
    UniqSet Name)
mkTuple (t (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
bind, b
ns)
                 = (t (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
bind, b
ns, (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed) -> UniqSet Name)
-> t (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
-> UniqSet Name
forall m a. Monoid m => (a -> m) -> t a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed) -> UniqSet Name
getRhsFreeVars t (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
bind)

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

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

  x :: HsLocalBinds (GhcPass 'Renamed)
x@(Ghc.HsIPBinds XHsIPBinds (GhcPass 'Renamed) (GhcPass 'Renamed)
_ HsIPBinds (GhcPass 'Renamed)
_) -> (HsLocalBinds (GhcPass 'Renamed), VarSet)
-> EnvReader (HsLocalBinds (GhcPass 'Renamed), VarSet)
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsLocalBinds (GhcPass 'Renamed)
x, VarSet
forall a. Monoid a => a
mempty) -- TODO ImplicitParams

  HsLocalBinds (GhcPass 'Renamed)
other -> (HsLocalBinds (GhcPass 'Renamed), VarSet)
-> EnvReader (HsLocalBinds (GhcPass 'Renamed), VarSet)
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsLocalBinds (GhcPass 'Renamed)
other, VarSet
forall a. Monoid a => a
mempty)

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

--------------------------------------------------------------------------------
-- 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 (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
hsDoCase (Ghc.HsDo XDo (GhcPass 'Renamed)
x HsDoFlavour
ctx XRec (GhcPass 'Renamed) [GuardLStmt (GhcPass 'Renamed)]
lStmts) = do
  (GenLocated
  SrcSpanAnnL
  [GenLocated
     SrcSpanAnnA
     (Stmt
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
stmtsRes, VarSet
_) <- WriterT
  VarSet
  (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
  (GenLocated
     SrcSpanAnnL
     [GenLocated
        SrcSpanAnnA
        (Stmt
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))])
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     (GenLocated
        SrcSpanAnnL
        [GenLocated
           SrcSpanAnnA
           (Stmt
              (GhcPass 'Renamed)
              (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
      VarSet)
forall w (m :: * -> *) a. Monoid w => WriterT w m a -> m (a, w)
runWriterT (WriterT
   VarSet
   (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
   (GenLocated
      SrcSpanAnnL
      [GenLocated
         SrcSpanAnnA
         (Stmt
            (GhcPass 'Renamed)
            (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))])
 -> WriterT
      Any
      (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
      (GenLocated
         SrcSpanAnnL
         [GenLocated
            SrcSpanAnnA
            (Stmt
               (GhcPass 'Renamed)
               (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
       VarSet))
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     (GenLocated
        SrcSpanAnnL
        [GenLocated
           SrcSpanAnnA
           (Stmt
              (GhcPass 'Renamed)
              (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))])
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     (GenLocated
        SrcSpanAnnL
        [GenLocated
           SrcSpanAnnA
           (Stmt
              (GhcPass 'Renamed)
              (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
      VarSet)
forall a b. (a -> b) -> a -> b
$ GenLocated
  SrcSpanAnnL
  [GenLocated
     SrcSpanAnnA
     (Stmt
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> ([GenLocated
       SrcSpanAnnA
       (Stmt
          (GhcPass 'Renamed)
          (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
    -> WriterT
         VarSet
         (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
         [GenLocated
            SrcSpanAnnA
            (Stmt
               (GhcPass 'Renamed)
               (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))])
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     (GenLocated
        SrcSpanAnnL
        [GenLocated
           SrcSpanAnnA
           (Stmt
              (GhcPass 'Renamed)
              (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for GenLocated
  SrcSpanAnnL
  [GenLocated
     SrcSpanAnnA
     (Stmt
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
XRec (GhcPass 'Renamed) [GuardLStmt (GhcPass 'Renamed)]
lStmts [GenLocated
   SrcSpanAnnA
   (Stmt
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     [GenLocated
        SrcSpanAnnA
        (Stmt
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
[LStmt
   (GhcPass 'Renamed)
   (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))]
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     [LStmt
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))]
forall body.
(Data body, Data (Stmt (GhcPass 'Renamed) body)) =>
[LStmt (GhcPass 'Renamed) body]
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     [LStmt (GhcPass 'Renamed) body]
dealWithStatements
  Maybe (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (HsExpr (GhcPass 'Renamed))
 -> EnvReader (Maybe (HsExpr (GhcPass 'Renamed))))
-> (HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed)))
-> HsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed))
forall a. a -> Maybe a
Just (HsExpr (GhcPass 'Renamed)
 -> EnvReader (Maybe (HsExpr (GhcPass 'Renamed))))
-> HsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall a b. (a -> b) -> a -> b
$ XDo (GhcPass 'Renamed)
-> HsDoFlavour
-> XRec (GhcPass 'Renamed) [GuardLStmt (GhcPass 'Renamed)]
-> HsExpr (GhcPass 'Renamed)
forall p. XDo p -> HsDoFlavour -> XRec p [ExprLStmt p] -> HsExpr p
Ghc.HsDo XDo (GhcPass 'Renamed)
x HsDoFlavour
ctx GenLocated
  SrcSpanAnnL
  [GenLocated
     SrcSpanAnnA
     (Stmt
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
XRec (GhcPass 'Renamed) [GuardLStmt (GhcPass 'Renamed)]
stmtsRes
hsDoCase HsExpr (GhcPass 'Renamed)
_ = Maybe (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (HsExpr (GhcPass 'Renamed))
forall a. Maybe a
Nothing

dealWithStatements
  :: (Data body, Data (Ghc.Stmt Ghc.GhcRn body))
  => [Ghc.LStmt Ghc.GhcRn body]
  -> WriterT VarSet EnvReader [Ghc.LStmt Ghc.GhcRn body]
dealWithStatements :: forall body.
(Data body, Data (Stmt (GhcPass 'Renamed) body)) =>
[LStmt (GhcPass 'Renamed) body]
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     [LStmt (GhcPass 'Renamed) body]
dealWithStatements [] = [GenLocated
   (Anno (Stmt (GhcPass 'Renamed) body))
   (Stmt (GhcPass 'Renamed) body)]
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     [GenLocated
        (Anno (Stmt (GhcPass 'Renamed) body))
        (Stmt (GhcPass 'Renamed) body)]
forall a.
a
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
dealWithStatements (LStmt (GhcPass 'Renamed) body
lstmt : [LStmt (GhcPass 'Renamed) body]
xs) = do
  (GenLocated
  (Anno (Stmt (GhcPass 'Renamed) body))
  (Stmt (GhcPass 'Renamed) body)
stmtRes, VarSet
names) <- WriterT
  VarSet
  (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
  (GenLocated
     (Anno (Stmt (GhcPass 'Renamed) body))
     (Stmt (GhcPass 'Renamed) body))
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     (GenLocated
        (Anno (Stmt (GhcPass 'Renamed) body))
        (Stmt (GhcPass 'Renamed) body),
      VarSet)
forall w (m :: * -> *) a.
(Monoid w, Monad m) =>
WriterT w m a -> WriterT w m (a, w)
listen (WriterT
   VarSet
   (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
   (GenLocated
      (Anno (Stmt (GhcPass 'Renamed) body))
      (Stmt (GhcPass 'Renamed) body))
 -> WriterT
      VarSet
      (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
      (GenLocated
         (Anno (Stmt (GhcPass 'Renamed) body))
         (Stmt (GhcPass 'Renamed) body),
       VarSet))
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     (GenLocated
        (Anno (Stmt (GhcPass 'Renamed) body))
        (Stmt (GhcPass 'Renamed) body))
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     (GenLocated
        (Anno (Stmt (GhcPass 'Renamed) body))
        (Stmt (GhcPass 'Renamed) body),
      VarSet)
forall a b. (a -> b) -> a -> b
$ (Stmt (GhcPass 'Renamed) body
 -> WriterT
      VarSet
      (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
      (Stmt (GhcPass 'Renamed) body))
-> GenLocated
     (Anno (Stmt (GhcPass 'Renamed) body))
     (Stmt (GhcPass 'Renamed) body)
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     (GenLocated
        (Anno (Stmt (GhcPass 'Renamed) body))
        (Stmt (GhcPass 'Renamed) body))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> GenLocated (Anno (Stmt (GhcPass 'Renamed) body)) a
-> f (GenLocated (Anno (Stmt (GhcPass 'Renamed) body)) b)
traverse Stmt (GhcPass 'Renamed) body
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     (Stmt (GhcPass 'Renamed) body)
forall body.
(Data (Stmt (GhcPass 'Renamed) body), Data body) =>
Stmt (GhcPass 'Renamed) body
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     (Stmt (GhcPass 'Renamed) body)
dealWithStmt GenLocated
  (Anno (Stmt (GhcPass 'Renamed) body))
  (Stmt (GhcPass 'Renamed) body)
LStmt (GhcPass 'Renamed) body
lstmt
  (GenLocated
  (Anno (Stmt (GhcPass 'Renamed) body))
  (Stmt (GhcPass 'Renamed) body)
stmtRes GenLocated
  (Anno (Stmt (GhcPass 'Renamed) body))
  (Stmt (GhcPass 'Renamed) body)
-> [GenLocated
      (Anno (Stmt (GhcPass 'Renamed) body))
      (Stmt (GhcPass 'Renamed) body)]
-> [GenLocated
      (Anno (Stmt (GhcPass 'Renamed) body))
      (Stmt (GhcPass 'Renamed) body)]
forall a. a -> [a] -> [a]
:) ([GenLocated
    (Anno (Stmt (GhcPass 'Renamed) body))
    (Stmt (GhcPass 'Renamed) body)]
 -> [GenLocated
       (Anno (Stmt (GhcPass 'Renamed) body))
       (Stmt (GhcPass 'Renamed) body)])
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     [GenLocated
        (Anno (Stmt (GhcPass 'Renamed) body))
        (Stmt (GhcPass 'Renamed) body)]
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     [GenLocated
        (Anno (Stmt (GhcPass 'Renamed) body))
        (Stmt (GhcPass 'Renamed) body)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WriterT
   Any
   (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
   ([GenLocated
       (Anno (Stmt (GhcPass 'Renamed) body))
       (Stmt (GhcPass 'Renamed) body)],
    VarSet)
 -> WriterT
      Any
      (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
      ([GenLocated
          (Anno (Stmt (GhcPass 'Renamed) body))
          (Stmt (GhcPass 'Renamed) body)],
       VarSet))
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     [GenLocated
        (Anno (Stmt (GhcPass 'Renamed) body))
        (Stmt (GhcPass 'Renamed) body)]
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     [GenLocated
        (Anno (Stmt (GhcPass 'Renamed) body))
        (Stmt (GhcPass 'Renamed) body)]
forall (n :: * -> *) w w' (m :: * -> *) a b.
(Monad n, Monoid w, Monoid w') =>
(m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
mapWriterT (VarSet
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     ([GenLocated
         (Anno (Stmt (GhcPass 'Renamed) body))
         (Stmt (GhcPass 'Renamed) body)],
      VarSet)
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     ([GenLocated
         (Anno (Stmt (GhcPass 'Renamed) body))
         (Stmt (GhcPass 'Renamed) body)],
      VarSet)
forall a. VarSet -> EnvReader a -> EnvReader a
addScopedVars VarSet
names) ([LStmt (GhcPass 'Renamed) body]
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     [LStmt (GhcPass 'Renamed) body]
forall body.
(Data body, Data (Stmt (GhcPass 'Renamed) body)) =>
[LStmt (GhcPass 'Renamed) body]
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     [LStmt (GhcPass 'Renamed) body]
dealWithStatements [LStmt (GhcPass 'Renamed) body]
xs)

dealWithStmt :: (Data (Ghc.Stmt Ghc.GhcRn body), Data body)
             => Ghc.Stmt Ghc.GhcRn body
             -> WriterT VarSet EnvReader (Ghc.Stmt Ghc.GhcRn body)
dealWithStmt :: forall body.
(Data (Stmt (GhcPass 'Renamed) body), Data body) =>
Stmt (GhcPass 'Renamed) body
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     (Stmt (GhcPass 'Renamed) body)
dealWithStmt = \case
  Ghc.BindStmt' XBindStmt (GhcPass 'Renamed) (GhcPass 'Renamed) body
x LPat (GhcPass 'Renamed)
lpat body
body SyntaxExpr (GhcPass 'Renamed)
bindExpr SyntaxExpr (GhcPass 'Renamed)
failExpr -> do
    let names :: VarSet
names = LPat (GhcPass 'Renamed) -> VarSet
extractVarPats LPat (GhcPass 'Renamed)
lpat
    VarSet
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell VarSet
names
    body
bodyRes <- EnvReader body
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     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 (IOEnv (Env TcGblEnv TcLclEnv))))
      body)
-> EnvReader body
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     body
forall a b. (a -> b) -> a -> b
$ body -> EnvReader body
forall a. Data a => a -> EnvReader a
recurse body
body
    Stmt (GhcPass 'Renamed) body
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     (Stmt (GhcPass 'Renamed) body)
forall a.
a
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Stmt (GhcPass 'Renamed) body
 -> WriterT
      VarSet
      (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
      (Stmt (GhcPass 'Renamed) body))
-> Stmt (GhcPass 'Renamed) body
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     (Stmt (GhcPass 'Renamed) body)
forall a b. (a -> b) -> a -> b
$ XBindStmt (GhcPass 'Renamed) (GhcPass 'Renamed) body
-> LPat (GhcPass 'Renamed)
-> body
-> SyntaxExpr (GhcPass 'Renamed)
-> SyntaxExpr (GhcPass 'Renamed)
-> Stmt (GhcPass 'Renamed) body
forall body.
XBindStmt (GhcPass 'Renamed) (GhcPass 'Renamed) body
-> LPat (GhcPass 'Renamed)
-> body
-> SyntaxExpr (GhcPass 'Renamed)
-> SyntaxExpr (GhcPass 'Renamed)
-> Stmt (GhcPass 'Renamed) body
Ghc.BindStmt' XBindStmt (GhcPass 'Renamed) (GhcPass 'Renamed) body
x LPat (GhcPass 'Renamed)
lpat body
bodyRes SyntaxExpr (GhcPass 'Renamed)
bindExpr SyntaxExpr (GhcPass 'Renamed)
failExpr

  Ghc.LetStmt' XLetStmt (GhcPass 'Renamed) (GhcPass 'Renamed) body
x (Ghc.L SrcSpan
loc HsLocalBinds (GhcPass 'Renamed)
localBinds) -> do
    (HsLocalBinds (GhcPass 'Renamed)
bindsRes, VarSet
names) <- EnvReader (HsLocalBinds (GhcPass 'Renamed), VarSet)
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     (HsLocalBinds (GhcPass 'Renamed), VarSet)
forall (m :: * -> *) a. Monad m => m a -> WriterT VarSet m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (EnvReader (HsLocalBinds (GhcPass 'Renamed), VarSet)
 -> WriterT
      VarSet
      (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
      (HsLocalBinds (GhcPass 'Renamed), VarSet))
-> EnvReader (HsLocalBinds (GhcPass 'Renamed), VarSet)
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     (HsLocalBinds (GhcPass 'Renamed), VarSet)
forall a b. (a -> b) -> a -> b
$ HsLocalBinds (GhcPass 'Renamed)
-> EnvReader (HsLocalBinds (GhcPass 'Renamed), VarSet)
dealWithLocalBinds HsLocalBinds (GhcPass 'Renamed)
localBinds
    VarSet
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell VarSet
names
    Stmt (GhcPass 'Renamed) body
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     (Stmt (GhcPass 'Renamed) body)
forall a.
a
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Stmt (GhcPass 'Renamed) body
 -> WriterT
      VarSet
      (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
      (Stmt (GhcPass 'Renamed) body))
-> Stmt (GhcPass 'Renamed) body
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     (Stmt (GhcPass 'Renamed) body)
forall a b. (a -> b) -> a -> b
$ XLetStmt (GhcPass 'Renamed) (GhcPass 'Renamed) body
-> GenLocated SrcSpan (HsLocalBinds (GhcPass 'Renamed))
-> Stmt (GhcPass 'Renamed) body
forall body.
XLetStmt (GhcPass 'Renamed) (GhcPass 'Renamed) body
-> GenLocated SrcSpan (HsLocalBinds (GhcPass 'Renamed))
-> StmtLR (GhcPass 'Renamed) (GhcPass 'Renamed) body
Ghc.LetStmt' XLetStmt (GhcPass 'Renamed) (GhcPass 'Renamed) body
x (SrcSpan
-> HsLocalBinds (GhcPass 'Renamed)
-> GenLocated SrcSpan (HsLocalBinds (GhcPass 'Renamed))
forall l e. l -> e -> GenLocated l e
Ghc.L SrcSpan
loc HsLocalBinds (GhcPass 'Renamed)
bindsRes)

  Ghc.ApplicativeStmt XApplicativeStmt (GhcPass 'Renamed) (GhcPass 'Renamed) body
x [(SyntaxExpr (GhcPass 'Renamed),
  ApplicativeArg (GhcPass 'Renamed))]
pairs Maybe (SyntaxExpr (GhcPass 'Renamed))
mbJoin -> do
    let dealWithAppArg :: ApplicativeArg (GhcPass 'Renamed)
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     (ApplicativeArg (GhcPass 'Renamed))
dealWithAppArg = \case
          a :: ApplicativeArg (GhcPass 'Renamed)
a@Ghc.ApplicativeArgOne{Bool
LHsExpr (GhcPass 'Renamed)
LPat (GhcPass 'Renamed)
XApplicativeArgOne (GhcPass 'Renamed)
xarg_app_arg_one :: XApplicativeArgOne (GhcPass 'Renamed)
app_arg_pattern :: LPat (GhcPass 'Renamed)
arg_expr :: LHsExpr (GhcPass 'Renamed)
is_body_stmt :: Bool
app_arg_pattern :: forall idL. ApplicativeArg idL -> LPat idL
arg_expr :: forall idL. ApplicativeArg idL -> LHsExpr idL
is_body_stmt :: forall idL. ApplicativeArg idL -> Bool
xarg_app_arg_one :: forall idL. ApplicativeArg idL -> XApplicativeArgOne idL
..} -> do
            VarSet
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell (VarSet
 -> WriterT
      VarSet
      (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
      ())
-> VarSet
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     ()
forall a b. (a -> b) -> a -> b
$ LPat (GhcPass 'Renamed) -> VarSet
extractVarPats LPat (GhcPass 'Renamed)
app_arg_pattern
            ApplicativeArg (GhcPass 'Renamed)
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     (ApplicativeArg (GhcPass 'Renamed))
forall a.
a
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ApplicativeArg (GhcPass 'Renamed)
a
          a :: ApplicativeArg (GhcPass 'Renamed)
a@Ghc.ApplicativeArgMany{[GuardLStmt (GhcPass 'Renamed)]
HsExpr (GhcPass 'Renamed)
LPat (GhcPass 'Renamed)
HsDoFlavour
XApplicativeArgMany (GhcPass 'Renamed)
xarg_app_arg_many :: XApplicativeArgMany (GhcPass 'Renamed)
app_stmts :: [GuardLStmt (GhcPass 'Renamed)]
final_expr :: HsExpr (GhcPass 'Renamed)
bv_pattern :: LPat (GhcPass 'Renamed)
stmt_context :: HsDoFlavour
app_stmts :: forall idL. ApplicativeArg idL -> [ExprLStmt idL]
bv_pattern :: forall idL. ApplicativeArg idL -> LPat idL
final_expr :: forall idL. ApplicativeArg idL -> HsExpr idL
stmt_context :: forall idL. ApplicativeArg idL -> HsDoFlavour
xarg_app_arg_many :: forall idL. ApplicativeArg idL -> XApplicativeArgMany idL
..} -> do
            VarSet
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell (VarSet
 -> WriterT
      VarSet
      (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
      ())
-> VarSet
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     ()
forall a b. (a -> b) -> a -> b
$ LPat (GhcPass 'Renamed) -> VarSet
extractVarPats LPat (GhcPass 'Renamed)
bv_pattern
            ([GenLocated
   (Anno
      (Stmt
         (GhcPass 'Renamed)
         (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
   (Stmt
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
stmtsRes, VarSet
_) <- WriterT
  Any
  (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
  ([GenLocated
      (Anno
         (Stmt
            (GhcPass 'Renamed)
            (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
      (Stmt
         (GhcPass 'Renamed)
         (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
   VarSet)
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     ([GenLocated
         (Anno
            (Stmt
               (GhcPass 'Renamed)
               (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
         (Stmt
            (GhcPass 'Renamed)
            (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
      VarSet)
forall (m :: * -> *) a. Monad m => m a -> WriterT VarSet m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WriterT
   Any
   (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
   ([GenLocated
       (Anno
          (Stmt
             (GhcPass 'Renamed)
             (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
       (Stmt
          (GhcPass 'Renamed)
          (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
    VarSet)
 -> WriterT
      VarSet
      (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
      ([GenLocated
          (Anno
             (Stmt
                (GhcPass 'Renamed)
                (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
          (Stmt
             (GhcPass 'Renamed)
             (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
       VarSet))
-> (WriterT
      VarSet
      (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
      [GenLocated
         (Anno
            (Stmt
               (GhcPass 'Renamed)
               (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
         (Stmt
            (GhcPass 'Renamed)
            (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
    -> WriterT
         Any
         (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
         ([GenLocated
             (Anno
                (Stmt
                   (GhcPass 'Renamed)
                   (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
             (Stmt
                (GhcPass 'Renamed)
                (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
          VarSet))
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     [GenLocated
        (Anno
           (Stmt
              (GhcPass 'Renamed)
              (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
        (Stmt
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     ([GenLocated
         (Anno
            (Stmt
               (GhcPass 'Renamed)
               (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
         (Stmt
            (GhcPass 'Renamed)
            (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
      VarSet)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT
  VarSet
  (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
  [GenLocated
     (Anno
        (Stmt
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
     (Stmt
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     ([GenLocated
         (Anno
            (Stmt
               (GhcPass 'Renamed)
               (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
         (Stmt
            (GhcPass 'Renamed)
            (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
      VarSet)
forall w (m :: * -> *) a. Monoid w => WriterT w m a -> m (a, w)
runWriterT (WriterT
   VarSet
   (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
   [GenLocated
      (Anno
         (Stmt
            (GhcPass 'Renamed)
            (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
      (Stmt
         (GhcPass 'Renamed)
         (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
 -> WriterT
      VarSet
      (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
      ([GenLocated
          (Anno
             (Stmt
                (GhcPass 'Renamed)
                (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
          (Stmt
             (GhcPass 'Renamed)
             (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
       VarSet))
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     [GenLocated
        (Anno
           (Stmt
              (GhcPass 'Renamed)
              (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
        (Stmt
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     ([GenLocated
         (Anno
            (Stmt
               (GhcPass 'Renamed)
               (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
         (Stmt
            (GhcPass 'Renamed)
            (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
      VarSet)
forall a b. (a -> b) -> a -> b
$ [LStmt
   (GhcPass 'Renamed)
   (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))]
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     [LStmt
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))]
forall body.
(Data body, Data (Stmt (GhcPass 'Renamed) body)) =>
[LStmt (GhcPass 'Renamed) body]
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     [LStmt (GhcPass 'Renamed) body]
dealWithStatements [LStmt
   (GhcPass 'Renamed)
   (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))]
[GuardLStmt (GhcPass 'Renamed)]
app_stmts
            ApplicativeArg (GhcPass 'Renamed)
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     (ApplicativeArg (GhcPass 'Renamed))
forall a.
a
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ApplicativeArg (GhcPass 'Renamed)
a {app_stmts :: [GuardLStmt (GhcPass 'Renamed)]
Ghc.app_stmts = [GenLocated
   (Anno
      (Stmt
         (GhcPass 'Renamed)
         (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
   (Stmt
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
[GuardLStmt (GhcPass 'Renamed)]
stmtsRes}
#if !MIN_VERSION_ghc(9,0,0)
          a -> lift $ gmapM recurse a
#endif
    [(SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))]
pairsRes <- (((SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))
 -> WriterT
      VarSet
      (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
      (SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed)))
-> [(SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))]
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     [(SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (((SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))
  -> WriterT
       VarSet
       (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
       (SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed)))
 -> [(SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))]
 -> WriterT
      VarSet
      (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
      [(SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))])
-> ((ApplicativeArg (GhcPass 'Renamed)
     -> WriterT
          VarSet
          (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
          (ApplicativeArg (GhcPass 'Renamed)))
    -> (SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))
    -> WriterT
         VarSet
         (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
         (SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed)))
-> (ApplicativeArg (GhcPass 'Renamed)
    -> WriterT
         VarSet
         (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
         (ApplicativeArg (GhcPass 'Renamed)))
-> [(SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))]
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     [(SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ApplicativeArg (GhcPass 'Renamed)
 -> WriterT
      VarSet
      (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
      (ApplicativeArg (GhcPass 'Renamed)))
-> (SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     (SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> (SyntaxExprRn, a) -> f (SyntaxExprRn, b)
traverse) ApplicativeArg (GhcPass 'Renamed)
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     (ApplicativeArg (GhcPass 'Renamed))
dealWithAppArg [(SyntaxExpr (GhcPass 'Renamed),
  ApplicativeArg (GhcPass 'Renamed))]
[(SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))]
pairs
    Stmt (GhcPass 'Renamed) body
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     (Stmt (GhcPass 'Renamed) body)
forall a.
a
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Stmt (GhcPass 'Renamed) body
 -> WriterT
      VarSet
      (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
      (Stmt (GhcPass 'Renamed) body))
-> Stmt (GhcPass 'Renamed) body
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     (Stmt (GhcPass 'Renamed) body)
forall a b. (a -> b) -> a -> b
$ XApplicativeStmt (GhcPass 'Renamed) (GhcPass 'Renamed) body
-> [(SyntaxExpr (GhcPass 'Renamed),
     ApplicativeArg (GhcPass 'Renamed))]
-> Maybe (SyntaxExpr (GhcPass 'Renamed))
-> Stmt (GhcPass 'Renamed) body
forall idL idR body.
XApplicativeStmt idL idR body
-> [(SyntaxExpr idR, ApplicativeArg idL)]
-> Maybe (SyntaxExpr idR)
-> StmtLR idL idR body
Ghc.ApplicativeStmt XApplicativeStmt (GhcPass 'Renamed) (GhcPass 'Renamed) body
x [(SyntaxExpr (GhcPass 'Renamed),
  ApplicativeArg (GhcPass 'Renamed))]
[(SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))]
pairsRes Maybe (SyntaxExpr (GhcPass 'Renamed))
mbJoin

  Stmt (GhcPass 'Renamed) body
other -> EnvReader (Stmt (GhcPass 'Renamed) body)
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     (Stmt (GhcPass 'Renamed) body)
forall (m :: * -> *) a. Monad m => m a -> WriterT VarSet m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (EnvReader (Stmt (GhcPass 'Renamed) body)
 -> WriterT
      VarSet
      (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
      (Stmt (GhcPass 'Renamed) body))
-> EnvReader (Stmt (GhcPass 'Renamed) body)
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     (Stmt (GhcPass 'Renamed) body)
forall a b. (a -> b) -> a -> b
$ (forall a. Data a => a -> EnvReader a)
-> Stmt (GhcPass 'Renamed) body
-> EnvReader (Stmt (GhcPass 'Renamed) body)
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> a -> m a
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Stmt (GhcPass 'Renamed) body -> m (Stmt (GhcPass 'Renamed) body)
gmapM d -> EnvReader d
forall a. Data a => a -> EnvReader a
recurse Stmt (GhcPass 'Renamed) body
other

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

hsProcCase :: Ghc.HsExpr Ghc.GhcRn
           -> EnvReader (Maybe (Ghc.HsExpr Ghc.GhcRn))
hsProcCase :: HsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
hsProcCase (Ghc.HsProc XProc (GhcPass 'Renamed)
x1 LPat (GhcPass 'Renamed)
lpat LHsCmdTop (GhcPass 'Renamed)
cmdTop) = do
  let inputNames :: VarSet
inputNames = LPat (GhcPass 'Renamed) -> VarSet
extractVarPats LPat (GhcPass 'Renamed)
lpat
  MaybeT
  (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
  (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT
   (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
   (HsExpr (GhcPass 'Renamed))
 -> EnvReader (Maybe (HsExpr (GhcPass 'Renamed))))
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall a b. (a -> b) -> a -> b
$ do
    GenLocated (SrcAnn NoEpAnns) (HsCmdTop (GhcPass 'Renamed))
cmdTopRes <- GenLocated (SrcAnn NoEpAnns) (HsCmdTop (GhcPass 'Renamed))
-> (HsCmdTop (GhcPass 'Renamed)
    -> MaybeT
         (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
         (HsCmdTop (GhcPass 'Renamed)))
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     (GenLocated (SrcAnn NoEpAnns) (HsCmdTop (GhcPass 'Renamed)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for GenLocated (SrcAnn NoEpAnns) (HsCmdTop (GhcPass 'Renamed))
LHsCmdTop (GhcPass 'Renamed)
cmdTop ((HsCmdTop (GhcPass 'Renamed)
  -> MaybeT
       (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
       (HsCmdTop (GhcPass 'Renamed)))
 -> MaybeT
      (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
      (GenLocated (SrcAnn NoEpAnns) (HsCmdTop (GhcPass 'Renamed))))
-> (HsCmdTop (GhcPass 'Renamed)
    -> MaybeT
         (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
         (HsCmdTop (GhcPass 'Renamed)))
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     (GenLocated (SrcAnn NoEpAnns) (HsCmdTop (GhcPass 'Renamed)))
forall a b. (a -> b) -> a -> b
$ \case
      Ghc.HsCmdTop XCmdTop (GhcPass 'Renamed)
x2 LHsCmd (GhcPass 'Renamed)
lcmd -> do
        GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))
cmdRes <- GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))
-> (HsCmd (GhcPass 'Renamed)
    -> MaybeT
         (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
         (HsCmd (GhcPass 'Renamed)))
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))
LHsCmd (GhcPass 'Renamed)
lcmd ((HsCmd (GhcPass 'Renamed)
  -> MaybeT
       (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
       (HsCmd (GhcPass 'Renamed)))
 -> MaybeT
      (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
      (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))
-> (HsCmd (GhcPass 'Renamed)
    -> MaybeT
         (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
         (HsCmd (GhcPass 'Renamed)))
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))
forall a b. (a -> b) -> a -> b
$ \case
          Ghc.HsCmdDo XCmdDo (GhcPass 'Renamed)
x3 XRec (GhcPass 'Renamed) [CmdLStmt (GhcPass 'Renamed)]
lstmts -> do
            (GenLocated
  SrcSpanAnnL
  [GenLocated
     (Anno
        (Stmt
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
     (Stmt
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
stmtsRes, VarSet
_) <- WriterT
  Any
  (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
  (GenLocated
     SrcSpanAnnL
     [GenLocated
        (Anno
           (Stmt
              (GhcPass 'Renamed)
              (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
        (Stmt
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
   VarSet)
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     (GenLocated
        SrcSpanAnnL
        [GenLocated
           (Anno
              (Stmt
                 (GhcPass 'Renamed)
                 (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
           (Stmt
              (GhcPass 'Renamed)
              (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
      VarSet)
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WriterT
   Any
   (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
   (GenLocated
      SrcSpanAnnL
      [GenLocated
         (Anno
            (Stmt
               (GhcPass 'Renamed)
               (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
         (Stmt
            (GhcPass 'Renamed)
            (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
    VarSet)
 -> MaybeT
      (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
      (GenLocated
         SrcSpanAnnL
         [GenLocated
            (Anno
               (Stmt
                  (GhcPass 'Renamed)
                  (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
            (Stmt
               (GhcPass 'Renamed)
               (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
       VarSet))
-> (([GenLocated
        SrcSpanAnnA
        (Stmt
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
     -> WriterT
          VarSet
          (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
          [GenLocated
             (Anno
                (Stmt
                   (GhcPass 'Renamed)
                   (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
             (Stmt
                (GhcPass 'Renamed)
                (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))])
    -> WriterT
         Any
         (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
         (GenLocated
            SrcSpanAnnL
            [GenLocated
               (Anno
                  (Stmt
                     (GhcPass 'Renamed)
                     (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
               (Stmt
                  (GhcPass 'Renamed)
                  (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
          VarSet))
-> ([GenLocated
       SrcSpanAnnA
       (Stmt
          (GhcPass 'Renamed)
          (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
    -> WriterT
         VarSet
         (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
         [GenLocated
            (Anno
               (Stmt
                  (GhcPass 'Renamed)
                  (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
            (Stmt
               (GhcPass 'Renamed)
               (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))])
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     (GenLocated
        SrcSpanAnnL
        [GenLocated
           (Anno
              (Stmt
                 (GhcPass 'Renamed)
                 (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
           (Stmt
              (GhcPass 'Renamed)
              (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
      VarSet)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT
  VarSet
  (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
  (GenLocated
     SrcSpanAnnL
     [GenLocated
        (Anno
           (Stmt
              (GhcPass 'Renamed)
              (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
        (Stmt
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))])
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     (GenLocated
        SrcSpanAnnL
        [GenLocated
           (Anno
              (Stmt
                 (GhcPass 'Renamed)
                 (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
           (Stmt
              (GhcPass 'Renamed)
              (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
      VarSet)
forall w (m :: * -> *) a. Monoid w => WriterT w m a -> m (a, w)
runWriterT (WriterT
   VarSet
   (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
   (GenLocated
      SrcSpanAnnL
      [GenLocated
         (Anno
            (Stmt
               (GhcPass 'Renamed)
               (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
         (Stmt
            (GhcPass 'Renamed)
            (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))])
 -> WriterT
      Any
      (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
      (GenLocated
         SrcSpanAnnL
         [GenLocated
            (Anno
               (Stmt
                  (GhcPass 'Renamed)
                  (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
            (Stmt
               (GhcPass 'Renamed)
               (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
       VarSet))
-> (([GenLocated
        SrcSpanAnnA
        (Stmt
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
     -> WriterT
          VarSet
          (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
          [GenLocated
             (Anno
                (Stmt
                   (GhcPass 'Renamed)
                   (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
             (Stmt
                (GhcPass 'Renamed)
                (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))])
    -> WriterT
         VarSet
         (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
         (GenLocated
            SrcSpanAnnL
            [GenLocated
               (Anno
                  (Stmt
                     (GhcPass 'Renamed)
                     (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
               (Stmt
                  (GhcPass 'Renamed)
                  (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]))
-> ([GenLocated
       SrcSpanAnnA
       (Stmt
          (GhcPass 'Renamed)
          (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
    -> WriterT
         VarSet
         (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
         [GenLocated
            (Anno
               (Stmt
                  (GhcPass 'Renamed)
                  (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
            (Stmt
               (GhcPass 'Renamed)
               (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))])
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     (GenLocated
        SrcSpanAnnL
        [GenLocated
           (Anno
              (Stmt
                 (GhcPass 'Renamed)
                 (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
           (Stmt
              (GhcPass 'Renamed)
              (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
      VarSet)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated
  SrcSpanAnnL
  [GenLocated
     SrcSpanAnnA
     (Stmt
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
-> ([GenLocated
       SrcSpanAnnA
       (Stmt
          (GhcPass 'Renamed)
          (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
    -> WriterT
         VarSet
         (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
         [GenLocated
            (Anno
               (Stmt
                  (GhcPass 'Renamed)
                  (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
            (Stmt
               (GhcPass 'Renamed)
               (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))])
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     (GenLocated
        SrcSpanAnnL
        [GenLocated
           (Anno
              (Stmt
                 (GhcPass 'Renamed)
                 (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
           (Stmt
              (GhcPass 'Renamed)
              (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for GenLocated
  SrcSpanAnnL
  [GenLocated
     SrcSpanAnnA
     (Stmt
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
XRec (GhcPass 'Renamed) [CmdLStmt (GhcPass 'Renamed)]
lstmts (([GenLocated
     SrcSpanAnnA
     (Stmt
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
  -> WriterT
       VarSet
       (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
       [GenLocated
          (Anno
             (Stmt
                (GhcPass 'Renamed)
                (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
          (Stmt
             (GhcPass 'Renamed)
             (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))])
 -> MaybeT
      (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
      (GenLocated
         SrcSpanAnnL
         [GenLocated
            (Anno
               (Stmt
                  (GhcPass 'Renamed)
                  (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
            (Stmt
               (GhcPass 'Renamed)
               (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
       VarSet))
-> ([GenLocated
       SrcSpanAnnA
       (Stmt
          (GhcPass 'Renamed)
          (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
    -> WriterT
         VarSet
         (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
         [GenLocated
            (Anno
               (Stmt
                  (GhcPass 'Renamed)
                  (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
            (Stmt
               (GhcPass 'Renamed)
               (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))])
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     (GenLocated
        SrcSpanAnnL
        [GenLocated
           (Anno
              (Stmt
                 (GhcPass 'Renamed)
                 (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
           (Stmt
              (GhcPass 'Renamed)
              (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
      VarSet)
forall a b. (a -> b) -> a -> b
$ \[GenLocated
   SrcSpanAnnA
   (Stmt
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
stmts -> do
              VarSet
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell VarSet
inputNames
              (WriterT
   Any
   (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
   ([GenLocated
       (Anno
          (Stmt
             (GhcPass 'Renamed)
             (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
       (Stmt
          (GhcPass 'Renamed)
          (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
    VarSet)
 -> WriterT
      Any
      (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
      ([GenLocated
          (Anno
             (Stmt
                (GhcPass 'Renamed)
                (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
          (Stmt
             (GhcPass 'Renamed)
             (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
       VarSet))
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     [GenLocated
        (Anno
           (Stmt
              (GhcPass 'Renamed)
              (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
        (Stmt
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     [GenLocated
        (Anno
           (Stmt
              (GhcPass 'Renamed)
              (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
        (Stmt
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
forall (n :: * -> *) w w' (m :: * -> *) a b.
(Monad n, Monoid w, Monoid w') =>
(m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
mapWriterT (VarSet
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     ([GenLocated
         (Anno
            (Stmt
               (GhcPass 'Renamed)
               (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
         (Stmt
            (GhcPass 'Renamed)
            (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
      VarSet)
-> WriterT
     Any
     (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
     ([GenLocated
         (Anno
            (Stmt
               (GhcPass 'Renamed)
               (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
         (Stmt
            (GhcPass 'Renamed)
            (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
      VarSet)
forall a. VarSet -> EnvReader a -> EnvReader a
addScopedVars VarSet
inputNames) (WriterT
   VarSet
   (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
   [GenLocated
      (Anno
         (Stmt
            (GhcPass 'Renamed)
            (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
      (Stmt
         (GhcPass 'Renamed)
         (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
 -> WriterT
      VarSet
      (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
      [GenLocated
         (Anno
            (Stmt
               (GhcPass 'Renamed)
               (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
         (Stmt
            (GhcPass 'Renamed)
            (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))])
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     [GenLocated
        (Anno
           (Stmt
              (GhcPass 'Renamed)
              (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
        (Stmt
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     [GenLocated
        (Anno
           (Stmt
              (GhcPass 'Renamed)
              (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
        (Stmt
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
forall a b. (a -> b) -> a -> b
$ [LStmt
   (GhcPass 'Renamed)
   (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))]
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     [LStmt
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))]
forall body.
(Data body, Data (Stmt (GhcPass 'Renamed) body)) =>
[LStmt (GhcPass 'Renamed) body]
-> WriterT
     VarSet
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     [LStmt (GhcPass 'Renamed) body]
dealWithStatements [GenLocated
   SrcSpanAnnA
   (Stmt
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
[LStmt
   (GhcPass 'Renamed)
   (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))]
stmts
            HsCmd (GhcPass 'Renamed)
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     (HsCmd (GhcPass 'Renamed))
forall a.
a
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsCmd (GhcPass 'Renamed)
 -> MaybeT
      (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
      (HsCmd (GhcPass 'Renamed)))
-> HsCmd (GhcPass 'Renamed)
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     (HsCmd (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ XCmdDo (GhcPass 'Renamed)
-> XRec (GhcPass 'Renamed) [CmdLStmt (GhcPass 'Renamed)]
-> HsCmd (GhcPass 'Renamed)
forall id. XCmdDo id -> XRec id [CmdLStmt id] -> HsCmd id
Ghc.HsCmdDo XCmdDo (GhcPass 'Renamed)
x3 GenLocated
  SrcSpanAnnL
  [GenLocated
     (Anno
        (Stmt
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
     (Stmt
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
XRec (GhcPass 'Renamed) [CmdLStmt (GhcPass 'Renamed)]
stmtsRes

          HsCmd (GhcPass 'Renamed)
_ -> MaybeT
  (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
  (HsCmd (GhcPass 'Renamed))
forall a.
MaybeT
  (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall (f :: * -> *) a. Alternative f => f a
empty -- TODO what other cases should be handled?

        HsCmdTop (GhcPass 'Renamed)
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     (HsCmdTop (GhcPass 'Renamed))
forall a.
a
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsCmdTop (GhcPass 'Renamed)
 -> MaybeT
      (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
      (HsCmdTop (GhcPass 'Renamed)))
-> HsCmdTop (GhcPass 'Renamed)
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     (HsCmdTop (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ XCmdTop (GhcPass 'Renamed)
-> LHsCmd (GhcPass 'Renamed) -> HsCmdTop (GhcPass 'Renamed)
forall p. XCmdTop p -> LHsCmd p -> HsCmdTop p
Ghc.HsCmdTop XCmdTop (GhcPass 'Renamed)
x2 GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))
LHsCmd (GhcPass 'Renamed)
cmdRes
#if !MIN_VERSION_ghc(9,0,0)
      _ -> empty
#endif
    HsExpr (GhcPass 'Renamed)
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     (HsExpr (GhcPass 'Renamed))
forall a.
a
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsExpr (GhcPass 'Renamed)
 -> MaybeT
      (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
      (HsExpr (GhcPass 'Renamed)))
-> HsExpr (GhcPass 'Renamed)
-> MaybeT
     (WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
     (HsExpr (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ XProc (GhcPass 'Renamed)
-> LPat (GhcPass 'Renamed)
-> LHsCmdTop (GhcPass 'Renamed)
-> HsExpr (GhcPass 'Renamed)
forall p. XProc p -> LPat p -> LHsCmdTop p -> HsExpr p
Ghc.HsProc XProc (GhcPass 'Renamed)
x1 LPat (GhcPass 'Renamed)
lpat GenLocated (SrcAnn NoEpAnns) (HsCmdTop (GhcPass 'Renamed))
LHsCmdTop (GhcPass 'Renamed)
cmdTopRes
hsProcCase HsExpr (GhcPass 'Renamed)
_ = Maybe (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (HsExpr (GhcPass 'Renamed))
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 :: VarSet
varSet = VarSet -> VarSet
f (VarSet -> VarSet) -> VarSet -> VarSet
forall a b. (a -> b) -> a -> b
$ Env -> VarSet
varSet Env
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 v. Ord k => [(k, v)] -> Map k v
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 (IOEnv (Env TcGblEnv TcLclEnv)) (a, Any)
 -> ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)) (a, Any))
-> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
-> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) 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 (IOEnv (Env TcGblEnv TcLclEnv)) (a, Any)
  -> ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)) (a, Any))
 -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
 -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a)
-> (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)) (a, Any)
    -> ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)) (a, Any))
-> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
-> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall a b. (a -> b) -> a -> b
$ (Env -> Env)
-> ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)) (a, Any)
-> ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)) (a, Any)
forall a.
(Env -> Env)
-> ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)) a
-> ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)) 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 (GhcPass 'Renamed), [Name], UniqSet Name)]
-> [(RecFlag, LHsBinds (GhcPass 'Renamed))]
depAnalBinds [(LHsBind (GhcPass 'Renamed), [Name], UniqSet Name)]
binds_w_dus
  = (SCC
   (GenLocated
      SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
    [Name], UniqSet Name)
 -> (RecFlag,
     Bag
       (GenLocated
          SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))))
-> [SCC
      (GenLocated
         SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
       [Name], UniqSet Name)]
-> [(RecFlag,
     Bag
       (GenLocated
          SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))))]
forall a b. (a -> b) -> [a] -> [b]
map SCC
  (GenLocated
     SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
   [Name], UniqSet Name)
-> (RecFlag,
    Bag
      (GenLocated
         SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))))
forall {a} {b} {c}. SCC (a, b, c) -> (RecFlag, Bag a)
get_binds [SCC
   (GenLocated
      SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
    [Name], UniqSet Name)]
sccs
  where
    sccs :: [SCC
   (GenLocated
      SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
    [Name], UniqSet Name)]
sccs = ((GenLocated
    SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
  [Name], UniqSet Name)
 -> [Name])
-> ((GenLocated
       SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
     [Name], UniqSet Name)
    -> [Name])
-> [(GenLocated
       SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
     [Name], UniqSet Name)]
-> [SCC
      (GenLocated
         SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
       [Name], UniqSet Name)]
forall node.
(node -> [Name]) -> (node -> [Name]) -> [node] -> [SCC node]
Ghc.depAnal
             (\(GenLocated
  SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
_, [Name]
defs, UniqSet Name
_) -> [Name]
defs)
             (\(GenLocated
  SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
_, [Name]
_, UniqSet Name
uses) -> UniqSet Name -> [Name]
forall elt. UniqSet elt -> [elt]
Ghc.nonDetEltsUniqSet UniqSet Name
uses)
             [(GenLocated
    SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
  [Name], UniqSet Name)]
[(LHsBind (GhcPass 'Renamed), [Name], UniqSet Name)]
binds_w_dus

    get_binds :: SCC (a, b, c) -> (RecFlag, Bag a)
get_binds (Graph.AcyclicSCC (a
bind, b
_, c
_)) =
      (RecFlag
Ghc.NonRecursive, a -> Bag a
forall a. a -> Bag a
Ghc.unitBag a
bind)
    get_binds (Graph.CyclicSCC  [(a, b, c)]
binds_w_dus') =
      (RecFlag
Ghc.Recursive, [a] -> Bag a
forall a. [a] -> Bag a
Ghc.listToBag [a
b | (a
b,b
_,c
_) <- [(a, b, c)]
binds_w_dus'])

--------------------------------------------------------------------------------
-- Type Checker Plugin
--------------------------------------------------------------------------------

data TcPluginNames =
  MkTcPluginNames
    { TcPluginNames -> Name
showLevClassName :: !Ghc.Name
    , TcPluginNames -> Class
showClass :: !Ghc.Class
    , TcPluginNames -> Class
succeedClass :: !Ghc.Class
    , TcPluginNames -> TyCon
showWrapperTyCon :: !Ghc.TyCon
    }

tcPlugin :: Ghc.TcPlugin
tcPlugin :: TcPlugin
tcPlugin = Ghc.TcPlugin
  { tcPluginInit :: TcPluginM TcPluginNames
Ghc.tcPluginInit  = TcPluginM TcPluginNames
initTcPlugin
  , tcPluginSolve :: TcPluginNames -> TcPluginSolver
Ghc.tcPluginSolve = TcPluginNames -> TcPluginSolver
solver
  , tcPluginStop :: TcPluginNames -> TcPluginM ()
Ghc.tcPluginStop = TcPluginM () -> TcPluginNames -> TcPluginM ()
forall a b. a -> b -> a
const (TcPluginM () -> TcPluginNames -> TcPluginM ())
-> TcPluginM () -> TcPluginNames -> TcPluginM ()
forall a b. (a -> b) -> a -> b
$ () -> TcPluginM ()
forall a. a -> TcPluginM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
#if MIN_VERSION_ghc(9,4,0)
  , tcPluginRewrite :: TcPluginNames -> UniqFM TyCon TcPluginRewriter
Ghc.tcPluginRewrite = TcPluginNames -> UniqFM TyCon TcPluginRewriter
forall a. Monoid a => a
mempty
#endif
  }

initTcPlugin :: Ghc.TcPluginM TcPluginNames
initTcPlugin :: TcPluginM TcPluginNames
initTcPlugin = do
  Ghc.Found ModLocation
_ Module
breakpointMod <-
    ModuleName -> TcPluginM FindResult
Ghc.findImportedModule' (String -> ModuleName
Ghc.mkModuleName String
"Debug.Breakpoint")
  Ghc.Found ModLocation
_ Module
showMod <-
    ModuleName -> TcPluginM FindResult
Ghc.findImportedModule' (String -> ModuleName
Ghc.mkModuleName String
"GHC.Show")

  Name
showLevClassName <- Module -> OccName -> TcPluginM Name
Plugin.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkClsOcc String
"ShowLev")
  Class
showClass <- Name -> TcPluginM Class
Plugin.tcLookupClass (Name -> TcPluginM Class) -> TcPluginM Name -> TcPluginM Class
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Module -> OccName -> TcPluginM Name
Plugin.lookupOrig Module
showMod (String -> OccName
Ghc.mkClsOcc String
"Show")
  Class
succeedClass <- Name -> TcPluginM Class
Plugin.tcLookupClass (Name -> TcPluginM Class) -> TcPluginM Name -> TcPluginM Class
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Module -> OccName -> TcPluginM Name
Plugin.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkClsOcc String
"Succeed")
  TyCon
showWrapperTyCon <- Name -> TcPluginM TyCon
Plugin.tcLookupTyCon (Name -> TcPluginM TyCon) -> TcPluginM Name -> TcPluginM TyCon
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Module -> OccName -> TcPluginM Name
Plugin.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkClsOcc String
"ShowWrapper")

  TcPluginNames -> TcPluginM TcPluginNames
forall a. a -> TcPluginM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MkTcPluginNames{Name
TyCon
Class
showLevClassName :: Name
showClass :: Class
succeedClass :: Class
showWrapperTyCon :: TyCon
showLevClassName :: Name
showClass :: Class
succeedClass :: Class
showWrapperTyCon :: TyCon
..}

findShowLevWanted
  :: TcPluginNames
  -> Ghc.Ct
  -> Maybe (Either (Ghc.Type, Ghc.Ct) (Ghc.Type, Ghc.Ct))
findShowLevWanted :: TcPluginNames -> Ct -> Maybe (Either (Type, Ct) (Type, Ct))
findShowLevWanted TcPluginNames
names Ct
ct
  | Ghc.CDictCan{Bool
[Type]
CtEvidence
Class
cc_ev :: CtEvidence
cc_class :: Class
cc_tyargs :: [Type]
cc_pend_sc :: Bool
cc_fundeps :: Bool
cc_class :: Ct -> Class
cc_ev :: Ct -> CtEvidence
cc_fundeps :: Ct -> Bool
cc_pend_sc :: Ct -> Bool
cc_tyargs :: Ct -> [Type]
..} <- Ct
ct
  , TcPluginNames -> Name
showLevClassName TcPluginNames
names Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Class -> Name
forall a. NamedThing a => a -> Name
Ghc.getName Class
cc_class
  , [Ghc.TyConApp TyCon
tyCon [], Type
arg2] <- [Type]
cc_tyargs
  = Either (Type, Ct) (Type, Ct)
-> Maybe (Either (Type, Ct) (Type, Ct))
forall a. a -> Maybe a
Just (Either (Type, Ct) (Type, Ct)
 -> Maybe (Either (Type, Ct) (Type, Ct)))
-> Either (Type, Ct) (Type, Ct)
-> Maybe (Either (Type, Ct) (Type, Ct))
forall a b. (a -> b) -> a -> b
$ if TyCon -> Name
forall a. NamedThing a => a -> Name
Ghc.getName TyCon
tyCon Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
Ghc.liftedRepName
       then (Type, Ct) -> Either (Type, Ct) (Type, Ct)
forall a b. b -> Either a b
Right (Type
arg2, Ct
ct)
       else (Type, Ct) -> Either (Type, Ct) (Type, Ct)
forall a b. a -> Either a b
Left (Type
arg2, Ct
ct)
  | Bool
otherwise = Maybe (Either (Type, Ct) (Type, Ct))
forall a. Maybe a
Nothing

solver :: TcPluginNames -> Ghc.TcPluginSolver
solver :: TcPluginNames -> TcPluginSolver
solver TcPluginNames
names EvBindsVar
_given [Ct]
_derived [Ct]
wanted = do
  InstEnvs
instEnvs <- TcPluginM InstEnvs
Plugin.getInstEnvs
  [Maybe (EvTerm, Ct)]
solved <- [Either (Type, Ct) (Type, Ct)]
-> (Either (Type, Ct) (Type, Ct) -> TcPluginM (Maybe (EvTerm, Ct)))
-> TcPluginM [Maybe (EvTerm, Ct)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (TcPluginNames -> Ct -> Maybe (Either (Type, Ct) (Type, Ct))
findShowLevWanted TcPluginNames
names (Ct -> Maybe (Either (Type, Ct) (Type, Ct)))
-> [Ct] -> [Either (Type, Ct) (Type, Ct)]
forall a b. (a -> Maybe b) -> [a] -> [b]
`mapMaybe` [Ct]
wanted) ((Either (Type, Ct) (Type, Ct) -> TcPluginM (Maybe (EvTerm, Ct)))
 -> TcPluginM [Maybe (EvTerm, Ct)])
-> (Either (Type, Ct) (Type, Ct) -> TcPluginM (Maybe (EvTerm, Ct)))
-> TcPluginM [Maybe (EvTerm, Ct)]
forall a b. (a -> b) -> a -> b
$ \case
    Left (Type
ty, Ct
ct) -> do -- unlifted type
      EvTerm
unshowableDict <- TcM EvTerm -> TcPluginM EvTerm
forall a. TcM a -> TcPluginM a
Ghc.unsafeTcPluginTcM (TcM EvTerm -> TcPluginM EvTerm) -> TcM EvTerm -> TcPluginM EvTerm
forall a b. (a -> b) -> a -> b
$ Type -> TcM EvTerm
buildUnshowableDict Type
ty
      Maybe (EvTerm, Ct) -> TcPluginM (Maybe (EvTerm, Ct))
forall a. a -> TcPluginM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (EvTerm, Ct) -> TcPluginM (Maybe (EvTerm, Ct)))
-> Maybe (EvTerm, Ct) -> TcPluginM (Maybe (EvTerm, Ct))
forall a b. (a -> b) -> a -> b
$ (EvTerm, Ct) -> Maybe (EvTerm, Ct)
forall a. a -> Maybe a
Just (EvTerm
unshowableDict, Ct
ct)
    Right (Type
ty, Ct
ct) -> do
      Maybe EvTerm
mShowDict <- TcPluginNames -> Class -> [Type] -> TcPluginM (Maybe EvTerm)
buildDict TcPluginNames
names (TcPluginNames -> Class
showClass TcPluginNames
names) [Type
ty]
      Maybe (EvTerm, Ct) -> TcPluginM (Maybe (EvTerm, Ct))
forall a. a -> TcPluginM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (EvTerm, Ct) -> TcPluginM (Maybe (EvTerm, Ct)))
-> Maybe (EvTerm, Ct) -> TcPluginM (Maybe (EvTerm, Ct))
forall a b. (a -> b) -> a -> b
$ Maybe EvTerm
mShowDict Maybe EvTerm -> (EvTerm -> (EvTerm, Ct)) -> Maybe (EvTerm, Ct)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \EvTerm
showDict ->
        let (ClsInst
succInst, [Type]
_) = (ClsInst, [Type])
-> Either SDoc (ClsInst, [Type]) -> (ClsInst, [Type])
forall b a. b -> Either a b -> b
fromRight (String -> (ClsInst, [Type])
forall a. HasCallStack => String -> a
error String
"impossible: no Succeed instance") (Either SDoc (ClsInst, [Type]) -> (ClsInst, [Type]))
-> Either SDoc (ClsInst, [Type]) -> (ClsInst, [Type])
forall a b. (a -> b) -> a -> b
$
              InstEnvs -> Class -> [Type] -> Either SDoc (ClsInst, [Type])
Ghc.lookupUniqueInstEnv InstEnvs
instEnvs (TcPluginNames -> Class
succeedClass TcPluginNames
names) [Type
ty]
         in (ClsInst -> Type -> EvExpr -> EvTerm
liftDict ClsInst
succInst Type
ty (EvTerm -> EvExpr
getEvExprFromDict EvTerm
showDict), Ct
ct)
  TcPluginSolveResult -> TcPluginM TcPluginSolveResult
forall a. a -> TcPluginM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TcPluginSolveResult -> TcPluginM TcPluginSolveResult)
-> TcPluginSolveResult -> TcPluginM TcPluginSolveResult
forall a b. (a -> b) -> a -> b
$ [(EvTerm, Ct)] -> [Ct] -> TcPluginSolveResult
Ghc.TcPluginOk ([Maybe (EvTerm, Ct)] -> [(EvTerm, Ct)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (EvTerm, Ct)]
solved) []

buildDict
  :: TcPluginNames
  -> Ghc.Class
  -> [Ghc.Type]
  -> Ghc.TcPluginM (Maybe Ghc.EvTerm)
buildDict :: TcPluginNames -> Class -> [Type] -> TcPluginM (Maybe EvTerm)
buildDict TcPluginNames
names Class
cls [Type]
tys = do
  InstEnvs
instEnvs <- TcPluginM InstEnvs
Plugin.getInstEnvs
  case InstEnvs -> Class -> [Type] -> Either SDoc (ClsInst, [Type])
Ghc.lookupUniqueInstEnv InstEnvs
instEnvs Class
cls [Type]
tys of
    Right (ClsInst
clsInst, [Type]
_) -> do
      let dfun :: TyVar
dfun = ClsInst -> TyVar
Ghc.is_dfun ClsInst
clsInst
          ([TyVar]
vars, [Type]
subclasses, Type
inst) = Type -> ([TyVar], [Type], Type)
Ghc.tcSplitSigmaTy (Type -> ([TyVar], [Type], Type))
-> Type -> ([TyVar], [Type], Type)
forall a b. (a -> b) -> a -> b
$ TyVar -> Type
Ghc.idType TyVar
dfun
      if [Type] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Type]
subclasses
         then Maybe EvTerm -> TcPluginM (Maybe EvTerm)
forall a. a -> TcPluginM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe EvTerm -> TcPluginM (Maybe EvTerm))
-> (EvTerm -> Maybe EvTerm) -> EvTerm -> TcPluginM (Maybe EvTerm)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvTerm -> Maybe EvTerm
forall a. a -> Maybe a
Just (EvTerm -> TcPluginM (Maybe EvTerm))
-> EvTerm -> TcPluginM (Maybe EvTerm)
forall a b. (a -> b) -> a -> b
$ TyVar -> [Type] -> [EvExpr] -> EvTerm
Ghc.evDFunApp TyVar
dfun [] [] -- why no use of vars here?
         else do
           let tyVarMap :: Map TyVar Type
tyVarMap = Type -> [Type] -> Map TyVar Type
mkTyVarMapping Type
inst [Type]
tys
           Maybe [EvTerm]
mSolvedSubClassDicts <- ([Maybe EvTerm] -> Maybe [EvTerm])
-> TcPluginM [Maybe EvTerm] -> TcPluginM (Maybe [EvTerm])
forall a b. (a -> b) -> TcPluginM a -> TcPluginM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe EvTerm] -> Maybe [EvTerm]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence (TcPluginM [Maybe EvTerm] -> TcPluginM (Maybe [EvTerm]))
-> ((Type -> TcPluginM (Maybe EvTerm)) -> TcPluginM [Maybe EvTerm])
-> (Type -> TcPluginM (Maybe EvTerm))
-> TcPluginM (Maybe [EvTerm])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Type]
-> (Type -> TcPluginM (Maybe EvTerm)) -> TcPluginM [Maybe EvTerm]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Type]
subclasses ((Type -> TcPluginM (Maybe EvTerm)) -> TcPluginM (Maybe [EvTerm]))
-> (Type -> TcPluginM (Maybe EvTerm)) -> TcPluginM (Maybe [EvTerm])
forall a b. (a -> b) -> a -> b
$ \Type
subclass -> do
             let (Class
subCls, [Type]
subTys) = Type -> (Class, [Type])
Ghc.tcSplitDFunHead Type
subclass
                 subTys' :: [Type]
subTys' = Map TyVar Type -> [Type] -> [Type]
instantiateVars Map TyVar Type
tyVarMap [Type]
subTys
             TcPluginNames -> Class -> [Type] -> TcPluginM (Maybe EvTerm)
buildDict TcPluginNames
names Class
subCls [Type]
subTys'
           Maybe EvTerm -> TcPluginM (Maybe EvTerm)
forall a. a -> TcPluginM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe EvTerm -> TcPluginM (Maybe EvTerm))
-> Maybe EvTerm -> TcPluginM (Maybe EvTerm)
forall a b. (a -> b) -> a -> b
$ do
             [Type]
vars' <- (TyVar -> Maybe Type) -> [TyVar] -> Maybe [Type]
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 (Map TyVar Type
tyVarMap Map TyVar Type -> TyVar -> Maybe Type
forall k a. Ord k => Map k a -> k -> Maybe a
M.!?) [TyVar]
vars
             TyVar -> [Type] -> [EvExpr] -> EvTerm
Ghc.evDFunApp TyVar
dfun [Type]
vars' ([EvExpr] -> EvTerm)
-> ([EvTerm] -> [EvExpr]) -> [EvTerm] -> EvTerm
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EvTerm -> EvExpr) -> [EvTerm] -> [EvExpr]
forall a b. (a -> b) -> [a] -> [b]
map EvTerm -> EvExpr
getEvExprFromDict
               ([EvTerm] -> EvTerm) -> Maybe [EvTerm] -> Maybe EvTerm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [EvTerm]
mSolvedSubClassDicts
    Left SDoc
_
      | Class
cls Class -> Class -> Bool
forall a. Eq a => a -> a -> Bool
== TcPluginNames -> Class
showClass TcPluginNames
names
      , [Type
ty] <- [Type]
tys -> do
          EvTerm
unshowableDict <- TcM EvTerm -> TcPluginM EvTerm
forall a. TcM a -> TcPluginM a
Ghc.unsafeTcPluginTcM (TcM EvTerm -> TcPluginM EvTerm) -> TcM EvTerm -> TcPluginM EvTerm
forall a b. (a -> b) -> a -> b
$ Type -> TcM EvTerm
buildUnshowableDict Type
ty
          let (ClsInst
inst, [Type]
_) = (ClsInst, [Type])
-> Either SDoc (ClsInst, [Type]) -> (ClsInst, [Type])
forall b a. b -> Either a b -> b
fromRight (String -> (ClsInst, [Type])
forall a. HasCallStack => String -> a
error String
"impossible: no Show instance for ShowWrapper") (Either SDoc (ClsInst, [Type]) -> (ClsInst, [Type]))
-> Either SDoc (ClsInst, [Type]) -> (ClsInst, [Type])
forall a b. (a -> b) -> a -> b
$
                InstEnvs -> Class -> [Type] -> Either SDoc (ClsInst, [Type])
Ghc.lookupUniqueInstEnv
                  InstEnvs
instEnvs
                  (TcPluginNames -> Class
showClass TcPluginNames
names)
                  [TyCon -> [Type] -> Type
Ghc.mkTyConApp (TcPluginNames -> TyCon
showWrapperTyCon TcPluginNames
names) [Type
ty]]
              liftedDict :: EvTerm
liftedDict =
                ClsInst -> Type -> EvExpr -> EvTerm
liftDict ClsInst
inst Type
ty (EvTerm -> EvExpr
getEvExprFromDict EvTerm
unshowableDict)
          Maybe EvTerm -> TcPluginM (Maybe EvTerm)
forall a. a -> TcPluginM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe EvTerm -> TcPluginM (Maybe EvTerm))
-> Maybe EvTerm -> TcPluginM (Maybe EvTerm)
forall a b. (a -> b) -> a -> b
$ EvTerm -> Maybe EvTerm
forall a. a -> Maybe a
Just EvTerm
liftedDict
      | Bool
otherwise -> Maybe EvTerm -> TcPluginM (Maybe EvTerm)
forall a. a -> TcPluginM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe EvTerm
forall a. Maybe a
Nothing

getEvExprFromDict :: Ghc.EvTerm -> Ghc.EvExpr
getEvExprFromDict :: EvTerm -> EvExpr
getEvExprFromDict = \case
  Ghc.EvExpr EvExpr
expr -> EvExpr
expr
  EvTerm
_ -> String -> EvExpr
forall a. HasCallStack => String -> a
error String
"invalid argument to getEvExprFromDict"

mkTyVarMapping
  :: Ghc.Type -- Wanted instance
  -> [Ghc.Type] -- Concrete types
  -> M.Map Ghc.TyVar Ghc.Type
mkTyVarMapping :: Type -> [Type] -> Map TyVar Type
mkTyVarMapping Type
wanted [Type]
tys =
  let wantedHead :: [Type]
wantedHead = (Type, [Type]) -> [Type]
forall a b. (a, b) -> b
snd ((Type, [Type]) -> [Type]) -> (Type, [Type]) -> [Type]
forall a b. (a -> b) -> a -> b
$ Type -> (Type, [Type])
Ghc.splitAppTys Type
wanted
      wantedTyVars :: [Type]
wantedTyVars = (Type -> [Type]) -> [Type] -> [Type]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Type, [Type]) -> [Type]
forall a b. (a, b) -> b
snd ((Type, [Type]) -> [Type])
-> (Type -> (Type, [Type])) -> Type -> [Type]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> (Type, [Type])
Ghc.splitAppTys) [Type]
wantedHead
      concreteTys :: [Type]
concreteTys = (Type -> [Type]) -> [Type] -> [Type]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Type, [Type]) -> [Type]
forall a b. (a, b) -> b
snd ((Type, [Type]) -> [Type])
-> (Type -> (Type, [Type])) -> Type -> [Type]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> (Type, [Type])
Ghc.splitAppTys) [Type]
tys
   in [(TyVar, Type)] -> Map TyVar Type
forall k v. Ord k => [(k, v)] -> Map k v
M.fromList ([(TyVar, Type)] -> Map TyVar Type)
-> [(TyVar, Type)] -> Map TyVar Type
forall a b. (a -> b) -> a -> b
$ do
     (Type
a, Type
b) <- [Type] -> [Type] -> [(Type, Type)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Type]
wantedTyVars [Type]
concreteTys
     Just TyVar
tyVar <- [Type -> Maybe TyVar
Ghc.getTyVar_maybe Type
a]
     (TyVar, Type) -> [(TyVar, Type)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TyVar
tyVar, Type
b)

instantiateVars :: M.Map Ghc.TyVar Ghc.Type -> [Ghc.Type] -> [Ghc.Type]
instantiateVars :: Map TyVar Type -> [Type] -> [Type]
instantiateVars Map TyVar Type
tyVarMap [Type]
tys = Type -> Type
replace (Type -> Type) -> [Type] -> [Type]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Type]
tys
  where
    replace :: Type -> Type
replace Type
arg = Type -> Maybe Type -> Type
forall a. a -> Maybe a -> a
fromMaybe Type
arg (Maybe Type -> Type) -> Maybe Type -> Type
forall a b. (a -> b) -> a -> b
$ do
      TyVar
tyVar <- Type -> Maybe TyVar
Ghc.getTyVar_maybe Type
arg
      TyVar -> Map TyVar Type -> Maybe Type
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup TyVar
tyVar Map TyVar Type
tyVarMap -- this lookup shouldn't fail

buildUnshowableDict :: Ghc.Type -> Ghc.TcM Ghc.EvTerm
buildUnshowableDict :: Type -> TcM EvTerm
buildUnshowableDict Type
ty = do
  let tyString :: String
tyString = SDoc -> String
Ghc.showSDocOneLine' (SDoc -> String) -> SDoc -> String
forall a b. (a -> b) -> a -> b
$ Type -> SDoc
Ghc.pprTypeForUser' Type
ty
  EvExpr
str <- String -> IOEnv (Env TcGblEnv TcLclEnv) EvExpr
forall (m :: * -> *). MonadThings m => String -> m EvExpr
Ghc.mkStringExpr (String -> IOEnv (Env TcGblEnv TcLclEnv) EvExpr)
-> String -> IOEnv (Env TcGblEnv TcLclEnv) EvExpr
forall a b. (a -> b) -> a -> b
$ String
"<" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
tyString String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
">"
  EvTerm -> TcM EvTerm
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EvTerm -> TcM EvTerm)
-> (EvExpr -> EvTerm) -> EvExpr -> TcM EvTerm
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvExpr -> EvTerm
Ghc.EvExpr (EvExpr -> TcM EvTerm) -> EvExpr -> TcM EvTerm
forall a b. (a -> b) -> a -> b
$
    [TyVar] -> EvExpr -> EvExpr
Ghc.mkCoreLams [Type -> TyVar
Ghc.mkWildValBinder' Type
ty] EvExpr
str

liftDict :: Ghc.ClsInst -> Ghc.Type -> Ghc.EvExpr -> Ghc.EvTerm
liftDict :: ClsInst -> Type -> EvExpr -> EvTerm
liftDict ClsInst
succ_inst Type
ty EvExpr
dict = TyVar -> [Type] -> [EvExpr] -> EvTerm
Ghc.evDFunApp (ClsInst -> TyVar
Ghc.is_dfun ClsInst
succ_inst) [Type
ty] [EvExpr
dict]

--------------------------------------------------------------------------------
-- Showing
--------------------------------------------------------------------------------

-- | Levity polymorphic 'Show'
class ShowLev (rep :: Exts.RuntimeRep) (a :: Exts.TYPE rep) where
  showLev :: a -> String

instance ShowLev 'Exts.IntRep Exts.Int# where
  showLev :: Int# -> String
showLev Int#
i = Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
i

#if MIN_VERSION_base(4,16,0)
instance ShowLev 'Exts.Int8Rep Exts.Int8# where
  showLev :: Int8# -> String
showLev Int8#
i = Int8 -> String
forall a. Show a => a -> String
show (Int8 -> String) -> Int8 -> String
forall a b. (a -> b) -> a -> b
$ Int8# -> Int8
I8# Int8#
i

instance ShowLev 'Exts.Int16Rep Exts.Int16# where
  showLev :: Int16# -> String
showLev Int16#
i = Int16 -> String
forall a. Show a => a -> String
show (Int16 -> String) -> Int16 -> String
forall a b. (a -> b) -> a -> b
$ Int16# -> Int16
I16# Int16#
i

instance ShowLev 'Exts.Int32Rep Exts.Int32# where
  showLev :: Int32# -> String
showLev Int32#
i = Int32 -> String
forall a. Show a => a -> String
show (Int32 -> String) -> Int32 -> String
forall a b. (a -> b) -> a -> b
$ Int32# -> Int32
I32# Int32#
i
#endif

#if MIN_VERSION_base(4,17,0)
instance ShowLev 'Exts.Int64Rep Exts.Int64# where
  showLev :: Int64# -> String
showLev Int64#
i = Int64 -> String
forall a. Show a => a -> String
show (Int64 -> String) -> Int64 -> String
forall a b. (a -> b) -> a -> b
$ Int64# -> Int64
I64# Int64#
i
#endif

instance ShowLev 'Exts.WordRep Exts.Word# where
  showLev :: Word# -> String
showLev Word#
w = Word -> String
forall a. Show a => a -> String
show (Word -> String) -> Word -> String
forall a b. (a -> b) -> a -> b
$ Word# -> Word
W# Word#
w

#if MIN_VERSION_base(4,16,0)
instance ShowLev 'Exts.Word8Rep Exts.Word8# where
  showLev :: Word8# -> String
showLev Word8#
w = Word8 -> String
forall a. Show a => a -> String
show (Word8 -> String) -> Word8 -> String
forall a b. (a -> b) -> a -> b
$ Word8# -> Word8
W8# Word8#
w

instance ShowLev 'Exts.Word16Rep Exts.Word16# where
  showLev :: Word16# -> String
showLev Word16#
w = Word16 -> String
forall a. Show a => a -> String
show (Word16 -> String) -> Word16 -> String
forall a b. (a -> b) -> a -> b
$ Word16# -> Word16
W16# Word16#
w

instance ShowLev 'Exts.Word32Rep Exts.Word32# where
  showLev :: Word32# -> String
showLev Word32#
w = Word32 -> String
forall a. Show a => a -> String
show (Word32 -> String) -> Word32 -> String
forall a b. (a -> b) -> a -> b
$ Word32# -> Word32
W32# Word32#
w
#endif

#if MIN_VERSION_base(4,17,0)
instance ShowLev 'Exts.Word64Rep Exts.Word64# where
  showLev :: Word64# -> String
showLev Word64#
w = Word64 -> String
forall a. Show a => a -> String
show (Word64 -> String) -> Word64 -> String
forall a b. (a -> b) -> a -> b
$ Word64# -> Word64
W64# Word64#
w
#endif

instance ShowLev 'Exts.FloatRep Exts.Float# where
  showLev :: Float# -> String
showLev Float#
f = Float -> String
forall a. Show a => a -> String
show (Float -> String) -> Float -> String
forall a b. (a -> b) -> a -> b
$ Float# -> Float
Exts.F# Float#
f

instance ShowLev 'Exts.DoubleRep Exts.Double# where
  showLev :: Double# -> String
showLev Double#
d = Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ Double# -> Double
Exts.D# Double#
d

newtype ShowWrapper a = MkShowWrapper a

instance ShowLev Exts.LiftedRep a => Show (ShowWrapper a) where
  show :: ShowWrapper a -> String
show (MkShowWrapper a
a) = a -> String
forall a. ShowLev LiftedRep a => a -> String
showLev a
a

class Succeed a where
  _succeed :: a -> String

-- Looking up an instance of this class for any type will always succeed. To
-- produce actual evidence, a Show dict must be provided.
instance Show a => Succeed a where
  _succeed :: a -> String
_succeed = a -> String
forall a. Show a => a -> String
show