{-# LANGUAGE ForeignFunctionInterface #-}
{-# 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 #-}
module Debug.Breakpoint
  ( -- * Plugin
    plugin
    -- * API
  , breakpoint
  , breakpointM
  , breakpointIO
  , queryVars
  , queryVarsM
  , queryVarsIO
    -- * 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           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.Haskeline as HL
import           System.IO.Unsafe (unsafePerformIO)

import qualified Debug.Breakpoint.GhcFacade as Ghc

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

-- | Constructs a lazy 'Map' from the names of all visible variables at the call
-- site to a string representation of their value. Be careful about binding this
-- to a variable because that variable will also be captured, resulting in an
-- infinite loop if that element of the Map is evaluated.
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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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 (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 (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
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"
    [ String -> String -> String
color String
"31" String
"### Breakpoint Hit ###"
    , String -> String -> String
color String
"37" String
"(" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
srcLoc String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")"
    , Map String String -> String
printVars Map String String
vars
    , String -> String -> String
color String
"32" String
"Press enter to continue"
    ]
  Int
_ <- IO Int
blockOnInput
  () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> 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 (f :: * -> *) a. Applicative f => a -> f a
pure ()

runPromptIO :: 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 (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
    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
$
      [ String -> String -> String
color String
"31" String
"### Breakpoint Hit ###"
      , String -> String -> String
color String
"37" (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]
++ (String -> String -> String
color String
"36" (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
varNames)
    InputT IO ()
inputLoop
  where
    varNames :: [String]
varNames = Map String String -> [String]
forall k a. Map k a -> [k]
M.keys Map String String
vars
    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 (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
    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
$ String -> String -> String
color String
"36" (String
var String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" = ") String -> String -> String
forall a. [a] -> [a] -> [a]
++ 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
$ String -> String -> String
color String
"32" 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 (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 => 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 (f :: * -> *) a. Applicative f => a -> f a
pure ()

color :: String -> String -> String
color :: String -> String -> String
color String
c String
s = 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"

printVars :: M.Map String String -> String
printVars :: Map String String -> String
printVars Map String String
vars =
  let mkLine :: (String, String) -> String
mkLine (String
k, String
v) = String -> String -> String
color String
"36" (String
k String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" = ") String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
v
   in [String] -> String
unlines ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (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

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 (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 (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

--------------------------------------------------------------------------------
-- 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
  HscEnv
hscEnv <- TcRnIf TcGblEnv TcLclEnv HscEnv
forall gbl lcl. TcRnIf gbl lcl HscEnv
Ghc.getTopEnv
  Ghc.Found ModLocation
_ Module
breakpointMod <- IO FindResult -> IOEnv (Env TcGblEnv TcLclEnv) FindResult
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO FindResult -> IOEnv (Env TcGblEnv TcLclEnv) FindResult)
-> IO FindResult -> IOEnv (Env TcGblEnv TcLclEnv) FindResult
forall a b. (a -> b) -> a -> b
$
    HscEnv -> ModuleName -> IO FindResult
Ghc.findPluginModule HscEnv
hscEnv (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")

  let (HsGroup (GhcPass 'Renamed)
group', Any
_) =
        Reader Env (HsGroup (GhcPass 'Renamed), Any)
-> Env -> (HsGroup (GhcPass 'Renamed), Any)
forall r a. Reader r a -> r -> a
runReader (WriterT Any (Reader Env) (HsGroup (GhcPass 'Renamed))
-> Reader Env (HsGroup (GhcPass 'Renamed), Any)
forall w (m :: * -> *) a. Monoid w => WriterT w m a -> m (a, w)
runWriterT (WriterT Any (Reader Env) (HsGroup (GhcPass 'Renamed))
 -> Reader Env (HsGroup (GhcPass 'Renamed), Any))
-> WriterT Any (Reader Env) (HsGroup (GhcPass 'Renamed))
-> Reader Env (HsGroup (GhcPass 'Renamed), Any)
forall a b. (a -> b) -> a -> b
$ HsGroup (GhcPass 'Renamed)
-> WriterT Any (Reader Env) (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
getSrcLocName :: Name
runPromptMName :: Name
runPromptName :: Name
runPromptIOName :: Name
printAndWaitIOName :: Name
printAndWaitMName :: Name
printAndWaitName :: Name
queryVarsIOName :: Name
breakpointIOName :: Name
queryVarsMName :: Name
breakpointMName :: Name
queryVarsName :: Name
breakpointName :: Name
fromListName :: Name
showLevName :: Name
captureVarsName :: Name
getSrcLocName :: Name
runPromptName :: Name
runPromptMName :: Name
runPromptIOName :: Name
printAndWaitIOName :: Name
printAndWaitMName :: Name
printAndWaitName :: Name
queryVarsIOName :: Name
breakpointIOName :: Name
queryVarsMName :: Name
breakpointMName :: Name
queryVarsName :: Name
breakpointName :: Name
fromListName :: Name
showLevName :: Name
captureVarsName :: Name
.. }

  (TcGblEnv, HsGroup (GhcPass 'Renamed))
-> TcM (TcGblEnv, HsGroup (GhcPass 'Renamed))
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 (Reader Env) a
-> (a -> WriterT Any (Reader Env) a)
-> Maybe a
-> WriterT Any (Reader Env) a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((forall a. Data a => a -> EnvReader a)
-> a -> WriterT Any (Reader Env) a
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> a -> m a
gmapM forall a. Data a => a -> EnvReader a
recurse a
a) a -> WriterT Any (Reader Env) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Maybe a -> WriterT Any (Reader Env) a)
-> WriterT Any (Reader Env) (Maybe a) -> WriterT Any (Reader Env) a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< a -> WriterT Any (Reader Env) (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 (Reader Env)) a
-> WriterT Any (Reader Env) (Maybe a)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT
      (MaybeT (WriterT Any (Reader Env)) a
 -> WriterT Any (Reader Env) (Maybe a))
-> MaybeT (WriterT Any (Reader Env)) a
-> WriterT Any (Reader Env) (Maybe a)
forall a b. (a -> b) -> a -> b
$ (HsExpr (GhcPass 'Renamed)
 -> EnvReader (Maybe (HsExpr (GhcPass 'Renamed))))
-> MaybeT (WriterT Any (Reader Env)) a
forall b.
Data b =>
(b -> EnvReader (Maybe b)) -> MaybeT (WriterT Any (Reader Env)) a
wrap HsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
hsVarCase
    MaybeT (WriterT Any (Reader Env)) a
-> MaybeT (WriterT Any (Reader Env)) a
-> MaybeT (WriterT Any (Reader Env)) 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 (Reader Env)) a
forall b.
Data b =>
(b -> EnvReader (Maybe b)) -> MaybeT (WriterT Any (Reader Env)) a
wrap Match (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
-> EnvReader
     (Maybe (Match (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))))
Match
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader
     (Maybe
        (Match
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
matchCase
    MaybeT (WriterT Any (Reader Env)) a
-> MaybeT (WriterT Any (Reader Env)) a
-> MaybeT (WriterT Any (Reader Env)) 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 (Reader Env)) a
forall b.
Data b =>
(b -> EnvReader (Maybe b)) -> MaybeT (WriterT Any (Reader Env)) a
wrap GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
-> EnvReader
     (Maybe (GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))))
GRHSs
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader
     (Maybe
        (GRHSs
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
grhssCase
    MaybeT (WriterT Any (Reader Env)) a
-> MaybeT (WriterT Any (Reader Env)) a
-> MaybeT (WriterT Any (Reader Env)) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (HsExpr (GhcPass 'Renamed)
 -> EnvReader (Maybe (HsExpr (GhcPass 'Renamed))))
-> MaybeT (WriterT Any (Reader Env)) a
forall b.
Data b =>
(b -> EnvReader (Maybe b)) -> MaybeT (WriterT Any (Reader Env)) a
wrap HsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
hsLetCase
    MaybeT (WriterT Any (Reader Env)) a
-> MaybeT (WriterT Any (Reader Env)) a
-> MaybeT (WriterT Any (Reader Env)) 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 (Reader Env)) a
forall b.
Data b =>
(b -> EnvReader (Maybe b)) -> MaybeT (WriterT Any (Reader Env)) a
wrap GRHS (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
-> EnvReader
     (Maybe (GRHS (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))))
GRHS
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader
     (Maybe
        (GRHS
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
grhsCase
    MaybeT (WriterT Any (Reader Env)) a
-> MaybeT (WriterT Any (Reader Env)) a
-> MaybeT (WriterT Any (Reader Env)) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (HsExpr (GhcPass 'Renamed)
 -> EnvReader (Maybe (HsExpr (GhcPass 'Renamed))))
-> MaybeT (WriterT Any (Reader Env)) a
forall b.
Data b =>
(b -> EnvReader (Maybe b)) -> MaybeT (WriterT Any (Reader Env)) a
wrap HsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
hsDoCase
    MaybeT (WriterT Any (Reader Env)) a
-> MaybeT (WriterT Any (Reader Env)) a
-> MaybeT (WriterT Any (Reader Env)) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (HsExpr (GhcPass 'Renamed)
 -> EnvReader (Maybe (HsExpr (GhcPass 'Renamed))))
-> MaybeT (WriterT Any (Reader Env)) a
forall b.
Data b =>
(b -> EnvReader (Maybe b)) -> MaybeT (WriterT Any (Reader Env)) 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 (Reader Env)) 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 (Reader Env)) a
forall (f :: * -> *) a. Alternative f => f a
empty
        Just (T a -> WriterT Any (Reader Env) (Maybe a)
f') -> WriterT Any (Reader Env) (Maybe a)
-> MaybeT (WriterT Any (Reader Env)) a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (WriterT Any (Reader Env) (Maybe a)
 -> MaybeT (WriterT Any (Reader Env)) a)
-> WriterT Any (Reader Env) (Maybe a)
-> MaybeT (WriterT Any (Reader Env)) a
forall a b. (a -> b) -> a -> b
$ a -> WriterT Any (Reader Env) (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{VarSet
Name
getSrcLocName :: Name
runPromptMName :: Name
runPromptName :: Name
runPromptIOName :: Name
printAndWaitIOName :: Name
printAndWaitMName :: Name
printAndWaitName :: Name
queryVarsIOName :: Name
breakpointIOName :: Name
queryVarsMName :: Name
breakpointMName :: Name
queryVarsName :: Name
breakpointName :: Name
fromListName :: Name
showLevName :: Name
captureVarsName :: Name
varSet :: VarSet
getSrcLocName :: Env -> Name
runPromptMName :: Env -> Name
runPromptName :: Env -> Name
runPromptIOName :: Env -> Name
printAndWaitIOName :: Env -> Name
printAndWaitMName :: Env -> Name
printAndWaitName :: Env -> Name
queryVarsIOName :: Env -> Name
breakpointIOName :: Env -> Name
queryVarsMName :: Env -> Name
breakpointMName :: Env -> Name
queryVarsName :: Env -> Name
breakpointName :: Env -> Name
fromListName :: Env -> Name
showLevName :: Env -> Name
captureVarsName :: Env -> Name
varSet :: Env -> VarSet
..} <- Reader Env Env -> WriterT Any (Reader Env) Env
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift Reader Env 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))
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 :: GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
captureVarsExpr =
        let mkTuple :: (LexicalFastString', Name) -> LHsExpr (GhcPass 'Renamed)
mkTuple (LexicalFastString' -> FastString
Ghc.fromLexicalFastString -> FastString
varStr, Name
n) =
              [LHsExpr (GhcPass 'Renamed)]
-> XExplicitTuple (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (p :: Pass).
[LHsExpr (GhcPass p)]
-> XExplicitTuple (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.mkLHsTupleExpr
                [ HsLit (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (p :: Pass). HsLit (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsLit (HsLit (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed))
-> (String -> HsLit (GhcPass 'Renamed))
-> String
-> LHsExpr (GhcPass 'Renamed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> HsLit (GhcPass 'Renamed)
forall (p :: Pass). String -> HsLit (GhcPass p)
Ghc.mkHsString (String -> LHsExpr (GhcPass 'Renamed))
-> String -> LHsExpr (GhcPass 'Renamed)
forall a b. (a -> b) -> a -> b
$ FastString -> String
Ghc.unpackFS FastString
varStr
                , LHsExpr (GhcPass 'Renamed)
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp (IdP (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsVar IdP (GhcPass 'Renamed)
Name
showLevName) (IdP (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsVar IdP (GhcPass 'Renamed)
Name
n)
                ]
#if MIN_VERSION_ghc(9,2,0)
                XExplicitTuple (GhcPass 'Renamed)
NoExtField
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' XExplicitList p
NoExtField
Ghc.NoExtField [XRec p (HsExpr p)]
exprs)

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

      bpExpr :: LHsExpr (GhcPass 'Renamed)
bpExpr =
        LHsExpr (GhcPass 'Renamed)
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp
          (LHsExpr (GhcPass 'Renamed)
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp (IdP (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsVar IdP (GhcPass 'Renamed)
Name
printAndWaitName) LHsExpr (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
srcLocStringExpr)
          LHsExpr (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
captureVarsExpr

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

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

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

      queryVarsExpr :: LHsExpr (GhcPass 'Renamed)
queryVarsExpr =
        LHsExpr (GhcPass 'Renamed)
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp
          (LHsExpr (GhcPass 'Renamed)
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp (IdP (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsVar IdP (GhcPass 'Renamed)
Name
runPromptName) LHsExpr (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
srcLocStringExpr)
          LHsExpr (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
captureVarsExpr

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

  if | Name
captureVarsName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name -> do
         Any -> WriterT Any (Reader Env) ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell (Any -> WriterT Any (Reader Env) ())
-> Any -> WriterT Any (Reader Env) ()
forall a b. (a -> b) -> a -> b
$ Bool -> Any
Any Bool
True
         Maybe (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
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))
captureVarsExpr)

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

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

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

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

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

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

     | Name
getSrcLocName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name ->
         Maybe (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall (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 (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 (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (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)]
HsMatchContext (NoGhcTc (GhcPass 'Renamed))
GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
XCMatch (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
m_ctxt :: forall p body. Match p body -> HsMatchContext (NoGhcTc 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]
m_grhss :: GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
m_pats :: [LPat (GhcPass 'Renamed)]
m_ctxt :: HsMatchContext (NoGhcTc (GhcPass 'Renamed))
m_ext :: XCMatch (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
..} = do
  let names :: VarSet
names = (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)) -> VarSet)
-> [GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))] -> VarSet
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap LPat (GhcPass 'Renamed) -> VarSet
GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)) -> VarSet
extractVarPats [LPat (GhcPass 'Renamed)]
[GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))]
m_pats
  GRHSs
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
grhRes <- VarSet
-> EnvReader
     (GRHSs
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> EnvReader
     (GRHSs
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
forall a. VarSet -> EnvReader a -> EnvReader a
addScopedVars VarSet
names (EnvReader
   (GRHSs
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
 -> EnvReader
      (GRHSs
         (GhcPass 'Renamed)
         (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
-> EnvReader
     (GRHSs
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> EnvReader
     (GRHSs
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
forall a b. (a -> b) -> a -> b
$ GRHSs
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader
     (GRHSs
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
forall a. Data a => a -> EnvReader a
recurse GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
GRHSs
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
m_grhss
  Maybe
  (Match
     (GhcPass 'Renamed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> EnvReader
     (Maybe
        (Match
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
forall (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 (NoGhcTc (GhcPass 'Renamed))
XCMatch (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
XCMatch
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
m_ctxt :: HsMatchContext (NoGhcTc (GhcPass 'Renamed))
m_ext :: XCMatch
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
m_pats :: [LPat (GhcPass 'Renamed)]
m_pats :: [LPat (GhcPass 'Renamed)]
m_ctxt :: HsMatchContext (NoGhcTc (GhcPass 'Renamed))
m_ext :: XCMatch (GhcPass 'Renamed) (LHsExpr (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
. LPat (GhcPass 'Renamed) -> [Name]
GenLocated SrcSpanAnnA (Pat (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 :: 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
grhssLocalBinds :: HsLocalBinds (GhcPass 'Renamed)
grhssGRHSs :: [LGRHS (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))]
grhssExt :: XCGRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
..} = 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
   SrcSpan
   (GRHS
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
grhsRes <- VarSet
-> EnvReader
     [GenLocated
        SrcSpan
        (GRHS
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> EnvReader
     [GenLocated
        SrcSpan
        (GRHS
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
forall a. VarSet -> EnvReader a -> EnvReader a
addScopedVars VarSet
names (EnvReader
   [GenLocated
      SrcSpan
      (GRHS
         (GhcPass 'Renamed)
         (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
 -> EnvReader
      [GenLocated
         SrcSpan
         (GRHS
            (GhcPass 'Renamed)
            (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))])
-> EnvReader
     [GenLocated
        SrcSpan
        (GRHS
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> EnvReader
     [GenLocated
        SrcSpan
        (GRHS
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
forall a b. (a -> b) -> a -> b
$ [GenLocated
   SrcSpan
   (GRHS
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> EnvReader
     [GenLocated
        SrcSpan
        (GRHS
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
forall a. Data a => a -> EnvReader a
recurse [LGRHS (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))]
[GenLocated
   SrcSpan
   (GRHS
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
grhssGRHSs
  Maybe
  (GRHSs
     (GhcPass 'Renamed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> EnvReader
     (Maybe
        (GRHSs
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe
   (GRHSs
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
 -> EnvReader
      (Maybe
         (GRHSs
            (GhcPass 'Renamed)
            (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))))
-> Maybe
     (GRHSs
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> EnvReader
     (Maybe
        (GRHSs
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
forall a b. (a -> b) -> a -> b
$ GRHSs
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> Maybe
     (GRHSs
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
forall a. a -> Maybe a
Just
    Ghc.GRHSs { grhssGRHSs :: [LGRHS
   (GhcPass 'Renamed)
   (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))]
Ghc.grhssGRHSs = [LGRHS
   (GhcPass 'Renamed)
   (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))]
[GenLocated
   SrcSpan
   (GRHS
      (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) (LHsExpr (GhcPass 'Renamed))
XCGRHSs
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
grhssExt :: XCGRHSs
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
grhssExt :: XCGRHSs (GhcPass 'Renamed) (LHsExpr (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 (Reader Env) (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
-> WriterT
     Any
     (Reader Env)
     (GenLocated
        SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for LHsBind (GhcPass 'Renamed)
GenLocated
  SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
lbind ((HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
  -> WriterT
       Any (Reader Env) (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
 -> WriterT
      Any
      (Reader Env)
      (GenLocated
         SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))))
-> (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
    -> WriterT
         Any (Reader Env) (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
-> WriterT
     Any
     (Reader Env)
     (GenLocated
        SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
forall a b. (a -> b) -> a -> b
$ \case
  Ghc.FunBind {[CoreTickish]
MatchGroup (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
LIdP (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_tick :: [CoreTickish]
fun_matches :: MatchGroup (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
fun_id :: LIdP (GhcPass 'Renamed)
fun_ext :: XFunBind (GhcPass 'Renamed) (GhcPass 'Renamed)
..} -> do
    (MatchGroup
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
matchesRes, Any Bool
containsTarget)
      <- WriterT
  Any
  (Reader Env)
  (MatchGroup
     (GhcPass 'Renamed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> WriterT
     Any
     (Reader Env)
     (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
   (Reader Env)
   (MatchGroup
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
 -> WriterT
      Any
      (Reader Env)
      (MatchGroup
         (GhcPass 'Renamed)
         (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))),
       Any))
-> (WriterT
      Any
      (Reader Env)
      (MatchGroup
         (GhcPass 'Renamed)
         (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
    -> WriterT
         Any
         (Reader Env)
         (MatchGroup
            (GhcPass 'Renamed)
            (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
-> WriterT
     Any
     (Reader Env)
     (MatchGroup
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> WriterT
     Any
     (Reader Env)
     (MatchGroup
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))),
      Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarSet
-> WriterT
     Any
     (Reader Env)
     (MatchGroup
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> WriterT
     Any
     (Reader Env)
     (MatchGroup
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
forall a. VarSet -> EnvReader a -> EnvReader a
addScopedVars VarSet
resultNames
       (WriterT
   Any
   (Reader Env)
   (MatchGroup
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
 -> WriterT
      Any
      (Reader Env)
      (MatchGroup
         (GhcPass 'Renamed)
         (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))),
       Any))
-> WriterT
     Any
     (Reader Env)
     (MatchGroup
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> WriterT
     Any
     (Reader Env)
     (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
     (Reader Env)
     (MatchGroup
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
forall a. Data a => a -> EnvReader a
recurse MatchGroup (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
MatchGroup
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
fun_matches
    -- 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
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 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 (Reader Env) (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ghc.FunBind { fun_matches :: MatchGroup (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
Ghc.fun_matches = MatchGroup (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
MatchGroup
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
matchesRes, fun_ext :: XFunBind (GhcPass 'Renamed) (GhcPass 'Renamed)
Ghc.fun_ext = XFunBind (GhcPass 'Renamed) (GhcPass 'Renamed)
UniqSet Name
rhsVars, [CoreTickish]
LIdP (GhcPass 'Renamed)
fun_id :: LIdP (GhcPass 'Renamed)
fun_tick :: [CoreTickish]
fun_tick :: [CoreTickish]
fun_id :: LIdP (GhcPass 'Renamed)
.. }

  Ghc.PatBind {([CoreTickish], [[CoreTickish]])
GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
LPat (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_ticks :: ([CoreTickish], [[CoreTickish]])
pat_rhs :: GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
pat_lhs :: LPat (GhcPass 'Renamed)
pat_ext :: XPatBind (GhcPass 'Renamed) (GhcPass 'Renamed)
..} -> do
    (GRHSs
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
rhsRes, Any Bool
containsTarget)
      <- EnvReader
  (GRHSs
     (GhcPass 'Renamed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> WriterT
     Any
     (Reader Env)
     (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
      (Reader Env)
      (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
     (Reader Env)
     (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
      (Reader Env)
      (GRHSs
         (GhcPass 'Renamed)
         (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))),
       Any))
-> EnvReader
     (GRHSs
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> WriterT
     Any
     (Reader Env)
     (GRHSs
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))),
      Any)
forall a b. (a -> b) -> a -> b
$ GRHSs
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader
     (GRHSs
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
forall a. Data a => a -> EnvReader a
recurse GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
GRHSs
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
pat_rhs
    let rhsVars :: UniqSet Name
rhsVars
          | Bool
containsTarget
          = [Name] -> UniqSet Name
forall a. Uniquable a => [a] -> UniqSet a
Ghc.mkUniqSet ([Name] -> UniqSet Name)
-> ([Name] -> [Name]) -> [Name] -> UniqSet Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarSet -> [Name]
forall k a. Map k a -> [a]
M.elems
            (VarSet -> [Name]) -> ([Name] -> VarSet) -> [Name] -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VarSet -> VarSet -> VarSet
forall a. Semigroup a => a -> a -> a
<> VarSet
resultNames) (VarSet -> VarSet) -> ([Name] -> VarSet) -> [Name] -> VarSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Name] -> VarSet
mkVarSet
            ([Name] -> UniqSet Name) -> [Name] -> UniqSet Name
forall a b. (a -> b) -> a -> b
$ UniqSet Name -> [Name]
forall elt. UniqSet elt -> [elt]
Ghc.nonDetEltsUniqSet XPatBind (GhcPass 'Renamed) (GhcPass 'Renamed)
UniqSet Name
pat_ext
          | Bool
otherwise = XPatBind (GhcPass 'Renamed) (GhcPass 'Renamed)
UniqSet Name
pat_ext
    HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
-> WriterT
     Any (Reader Env) (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ghc.PatBind { pat_rhs :: GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
Ghc.pat_rhs = GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
GRHSs
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
rhsRes, pat_ext :: XPatBind (GhcPass 'Renamed) (GhcPass 'Renamed)
pat_ext = XPatBind (GhcPass 'Renamed) (GhcPass 'Renamed)
UniqSet Name
rhsVars, ([CoreTickish], [[CoreTickish]])
LPat (GhcPass 'Renamed)
pat_lhs :: LPat (GhcPass 'Renamed)
pat_ticks :: ([CoreTickish], [[CoreTickish]])
pat_ticks :: ([CoreTickish], [[CoreTickish]])
pat_lhs :: LPat (GhcPass 'Renamed)
.. }

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

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

  HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
other -> HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
-> WriterT
     Any (Reader Env) (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
forall (f :: * -> *) a. Applicative f => a -> f a
pure HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
other

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 (Reader Env))
  [GenLocated
     (Anno
        (Stmt
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
     (Stmt
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> WriterT
     Any
     (Reader Env)
     ([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 (Reader Env))
   [GenLocated
      (Anno
         (Stmt
            (GhcPass 'Renamed)
            (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
      (Stmt
         (GhcPass 'Renamed)
         (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
 -> WriterT
      Any
      (Reader Env)
      ([GenLocated
          (Anno
             (Stmt
                (GhcPass 'Renamed)
                (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
          (Stmt
             (GhcPass 'Renamed)
             (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
       VarSet))
-> WriterT
     VarSet
     (WriterT Any (Reader Env))
     [GenLocated
        (Anno
           (Stmt
              (GhcPass 'Renamed)
              (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
        (Stmt
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> WriterT
     Any
     (Reader Env)
     ([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 (Reader Env))
     [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 (Reader Env)) [LStmt (GhcPass 'Renamed) body]
dealWithStatements [GuardLStmt (GhcPass 'Renamed)]
[LStmt
   (GhcPass 'Renamed)
   (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))]
guards
  GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
bodyRes <- VarSet
-> EnvReader (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall a. VarSet -> EnvReader a -> EnvReader a
addScopedVars VarSet
names (EnvReader (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
 -> EnvReader (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> EnvReader (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> EnvReader (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall a. Data a => a -> EnvReader a
recurse LHsExpr (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
body
  Maybe
  (GRHS
     (GhcPass 'Renamed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> EnvReader
     (Maybe
        (GRHS
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe
   (GRHS
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
 -> EnvReader
      (Maybe
         (GRHS
            (GhcPass 'Renamed)
            (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))))
-> (GRHS
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
    -> Maybe
         (GRHS
            (GhcPass 'Renamed)
            (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
-> GRHS
     (GhcPass 'Renamed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader
     (Maybe
        (GRHS
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GRHS
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> Maybe
     (GRHS
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
forall a. a -> Maybe a
Just (GRHS
   (GhcPass 'Renamed)
   (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
 -> EnvReader
      (Maybe
         (GRHS
            (GhcPass 'Renamed)
            (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))))
-> GRHS
     (GhcPass 'Renamed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader
     (Maybe
        (GRHS
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
forall a b. (a -> b) -> a -> b
$ XCGRHS
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> [GuardLStmt (GhcPass 'Renamed)]
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> GRHS
     (GhcPass 'Renamed)
     (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
Ghc.GRHS XCGRHS (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
XCGRHS
  (GhcPass 'Renamed)
  (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
x [GuardLStmt (GhcPass 'Renamed)]
[GenLocated
   (Anno
      (Stmt
         (GhcPass 'Renamed)
         (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
   (Stmt
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
guardsRes GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
bodyRes
#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 (Ghc.L SrcSpan
loc HsLocalBinds (GhcPass 'Renamed)
localBinds) 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
-> EnvReader (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall a. VarSet -> EnvReader a -> EnvReader a
addScopedVars VarSet
names (EnvReader (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
 -> EnvReader (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> EnvReader (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> EnvReader (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall a. Data a => a -> EnvReader a
recurse LHsExpr (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
inExpr
  Maybe (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall (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)
-> GenLocated SrcSpan (HsLocalBinds (GhcPass 'Renamed))
-> LHsExpr (GhcPass 'Renamed)
-> HsExpr (GhcPass 'Renamed)
Ghc.HsLet' XLet (GhcPass 'Renamed)
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) LHsExpr (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
inExprRes
hsLetCase HsExpr (GhcPass 'Renamed)
_ = Maybe (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
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 (f :: * -> *) a. Applicative f => a -> f a
pure (HsLocalBinds (GhcPass 'Renamed)
hlb, VarSet
forall a. Monoid a => a
mempty)
    Ghc.XValBindsLR (Ghc.NValBinds [(RecFlag, LHsBinds (GhcPass 'Renamed))]
bindPairs [LSig (GhcPass 'Renamed)]
sigs) -> do
      let binds :: [LHsBind (GhcPass 'Renamed)]
binds = Bag
  (GenLocated
     SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
-> [LHsBind (GhcPass 'Renamed)]
forall a. Bag a -> [a]
Ghc.bagToList
                (Bag
   (GenLocated
      SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
 -> [LHsBind (GhcPass 'Renamed)])
-> ([Bag
       (GenLocated
          SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))]
    -> Bag
         (GenLocated
            SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))))
-> [Bag
      (GenLocated
         SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))]
-> [LHsBind (GhcPass 'Renamed)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Bag
   (GenLocated
      SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))]
-> Bag
     (GenLocated
        SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
forall a. [Bag a] -> Bag a
Ghc.unionManyBags
                ([Bag
    (GenLocated
       SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))]
 -> [LHsBind (GhcPass 'Renamed)])
-> [Bag
      (GenLocated
         SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))]
-> [LHsBind (GhcPass 'Renamed)]
forall a b. (a -> b) -> a -> b
$ ((RecFlag,
  Bag
    (GenLocated
       SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))))
 -> Bag
      (GenLocated
         SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))))
-> [(RecFlag,
     Bag
       (GenLocated
          SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))))]
-> [Bag
      (GenLocated
         SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))]
forall a b. (a -> b) -> [a] -> [b]
map (RecFlag,
 Bag
   (GenLocated
      SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))))
-> Bag
     (GenLocated
        SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
forall a b. (a, b) -> b
snd [(RecFlag, LHsBinds (GhcPass 'Renamed))]
[(RecFlag,
  Bag
    (GenLocated
       SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))))]
bindPairs :: [Ghc.LHsBind Ghc.GhcRn]
          names :: [[Name]]
names = (GenLocated
   SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
 -> [Name])
-> [GenLocated
      SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
-> [[Name]]
forall a b. (a -> b) -> [a] -> [b]
map ((HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed) -> [Name])
-> GenLocated
     SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
-> [Name]
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed) -> [Name]
forall idR. HsBindLR (GhcPass 'Renamed) idR -> [Name]
Ghc.collectHsBindBinders')
                      [LHsBind (GhcPass 'Renamed)]
[GenLocated
   SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
binds
          resultNames :: VarSet
resultNames = [Name] -> VarSet
mkVarSet ([Name] -> VarSet) -> [Name] -> VarSet
forall a b. (a -> b) -> a -> b
$ [[Name]] -> [Name]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Name]]
names

      ([(GenLocated
    SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
  [Name])]
resBindsWithNames, Any Bool
containsTarget)
        <- WriterT
  Any
  (Reader Env)
  [(GenLocated
      SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
    [Name])]
-> WriterT
     Any
     (Reader Env)
     ([(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
   (Reader Env)
   [(GenLocated
       SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
     [Name])]
 -> WriterT
      Any
      (Reader Env)
      ([(GenLocated
           SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
         [Name])],
       Any))
-> (WriterT
      Any
      (Reader Env)
      [GenLocated
         SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
    -> WriterT
         Any
         (Reader Env)
         [(GenLocated
             SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
           [Name])])
-> WriterT
     Any
     (Reader Env)
     [GenLocated
        SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
-> WriterT
     Any
     (Reader Env)
     ([(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
     (Reader Env)
     [GenLocated
        SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
-> WriterT
     Any
     (Reader Env)
     [(GenLocated
         SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
       [Name])]
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
   (Reader Env)
   [GenLocated
      SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
 -> WriterT
      Any
      (Reader Env)
      ([(GenLocated
           SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
         [Name])],
       Any))
-> WriterT
     Any
     (Reader Env)
     [GenLocated
        SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
-> WriterT
     Any
     (Reader Env)
     ([(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
      (Reader Env)
      (GenLocated
         SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))))
-> [GenLocated
      SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
-> WriterT
     Any
     (Reader Env)
     [GenLocated
        SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (VarSet
-> LHsBind (GhcPass 'Renamed)
-> EnvReader (LHsBind (GhcPass 'Renamed))
dealWithBind VarSet
resultNames) [LHsBind (GhcPass 'Renamed)]
[GenLocated
   SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
binds

      if Bool -> Bool
not Bool
containsTarget
         then (HsLocalBinds (GhcPass 'Renamed), VarSet)
-> EnvReader (HsLocalBinds (GhcPass 'Renamed), VarSet)
forall (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 (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 (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 (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 (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]
MatchGroup (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
LIdP (GhcPass 'Renamed)
XFunBind (GhcPass 'Renamed) (GhcPass 'Renamed)
fun_tick :: [CoreTickish]
fun_matches :: MatchGroup (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
fun_id :: LIdP (GhcPass 'Renamed)
fun_ext :: 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]
..} -> XFunBind (GhcPass 'Renamed) (GhcPass 'Renamed)
UniqSet Name
fun_ext
  Ghc.PatBind {([CoreTickish], [[CoreTickish]])
GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
LPat (GhcPass 'Renamed)
XPatBind (GhcPass 'Renamed) (GhcPass 'Renamed)
pat_ticks :: ([CoreTickish], [[CoreTickish]])
pat_rhs :: GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
pat_lhs :: LPat (GhcPass 'Renamed)
pat_ext :: 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]])
..} -> XPatBind (GhcPass 'Renamed) (GhcPass 'Renamed)
UniqSet Name
pat_ext
  Ghc.PatSynBind XPatSynBind (GhcPass 'Renamed) (GhcPass 'Renamed)
_ Ghc.PSB {HsPatSynDir (GhcPass 'Renamed)
HsPatSynDetails (GhcPass 'Renamed)
LPat (GhcPass 'Renamed)
LIdP (GhcPass 'Renamed)
XPSB (GhcPass 'Renamed) (GhcPass 'Renamed)
psb_dir :: HsPatSynDir (GhcPass 'Renamed)
psb_def :: LPat (GhcPass 'Renamed)
psb_args :: HsPatSynDetails (GhcPass 'Renamed)
psb_id :: LIdP (GhcPass 'Renamed)
psb_ext :: XPSB (GhcPass 'Renamed) (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
..} -> 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 HsStmtContext (HsDoRn (GhcPass 'Renamed))
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 (Reader Env))
  (GenLocated
     SrcSpanAnnL
     [GenLocated
        SrcSpanAnnA
        (Stmt
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))])
-> WriterT
     Any
     (Reader Env)
     (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 (Reader Env))
   (GenLocated
      SrcSpanAnnL
      [GenLocated
         SrcSpanAnnA
         (Stmt
            (GhcPass 'Renamed)
            (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))])
 -> WriterT
      Any
      (Reader Env)
      (GenLocated
         SrcSpanAnnL
         [GenLocated
            SrcSpanAnnA
            (Stmt
               (GhcPass 'Renamed)
               (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
       VarSet))
-> WriterT
     VarSet
     (WriterT Any (Reader Env))
     (GenLocated
        SrcSpanAnnL
        [GenLocated
           SrcSpanAnnA
           (Stmt
              (GhcPass 'Renamed)
              (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))])
-> WriterT
     Any
     (Reader Env)
     (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 (Reader Env))
         [GenLocated
            SrcSpanAnnA
            (Stmt
               (GhcPass 'Renamed)
               (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))])
-> WriterT
     VarSet
     (WriterT Any (Reader Env))
     (GenLocated
        SrcSpanAnnL
        [GenLocated
           SrcSpanAnnA
           (Stmt
              (GhcPass 'Renamed)
              (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for XRec (GhcPass 'Renamed) [GuardLStmt (GhcPass 'Renamed)]
GenLocated
  SrcSpanAnnL
  [GenLocated
     SrcSpanAnnA
     (Stmt
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
lStmts [GenLocated
   SrcSpanAnnA
   (Stmt
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> WriterT
     VarSet
     (WriterT Any (Reader Env))
     [GenLocated
        SrcSpanAnnA
        (Stmt
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
forall body.
(Data body, Data (Stmt (GhcPass 'Renamed) body)) =>
[LStmt (GhcPass 'Renamed) body]
-> WriterT
     VarSet (WriterT Any (Reader Env)) [LStmt (GhcPass 'Renamed) body]
dealWithStatements
  Maybe (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
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)
-> HsStmtContext (HsDoRn (GhcPass 'Renamed))
-> XRec (GhcPass 'Renamed) [GuardLStmt (GhcPass 'Renamed)]
-> HsExpr (GhcPass 'Renamed)
forall p.
XDo p
-> HsStmtContext (HsDoRn p) -> XRec p [ExprLStmt p] -> HsExpr p
Ghc.HsDo XDo (GhcPass 'Renamed)
x HsStmtContext (HsDoRn (GhcPass 'Renamed))
ctx XRec (GhcPass 'Renamed) [GuardLStmt (GhcPass 'Renamed)]
GenLocated
  SrcSpanAnnL
  [GenLocated
     SrcSpanAnnA
     (Stmt
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
stmtsRes
hsDoCase HsExpr (GhcPass 'Renamed)
_ = Maybe (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall (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 (Reader Env)) [LStmt (GhcPass 'Renamed) body]
dealWithStatements [] = [GenLocated
   (Anno (Stmt (GhcPass 'Renamed) body))
   (Stmt (GhcPass 'Renamed) body)]
-> WriterT
     VarSet
     (WriterT Any (Reader Env))
     [GenLocated
        (Anno (Stmt (GhcPass 'Renamed) body))
        (Stmt (GhcPass 'Renamed) body)]
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 (Reader Env))
  (GenLocated
     (Anno (Stmt (GhcPass 'Renamed) body))
     (Stmt (GhcPass 'Renamed) body))
-> WriterT
     VarSet
     (WriterT Any (Reader Env))
     (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 (Reader Env))
   (GenLocated
      (Anno (Stmt (GhcPass 'Renamed) body))
      (Stmt (GhcPass 'Renamed) body))
 -> WriterT
      VarSet
      (WriterT Any (Reader Env))
      (GenLocated
         (Anno (Stmt (GhcPass 'Renamed) body))
         (Stmt (GhcPass 'Renamed) body),
       VarSet))
-> WriterT
     VarSet
     (WriterT Any (Reader Env))
     (GenLocated
        (Anno (Stmt (GhcPass 'Renamed) body))
        (Stmt (GhcPass 'Renamed) body))
-> WriterT
     VarSet
     (WriterT Any (Reader Env))
     (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 (Reader Env)) (Stmt (GhcPass 'Renamed) body))
-> GenLocated
     (Anno (Stmt (GhcPass 'Renamed) body))
     (Stmt (GhcPass 'Renamed) body)
-> WriterT
     VarSet
     (WriterT Any (Reader Env))
     (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)
traverse Stmt (GhcPass 'Renamed) body
-> WriterT
     VarSet (WriterT Any (Reader Env)) (Stmt (GhcPass 'Renamed) body)
forall body.
(Data (Stmt (GhcPass 'Renamed) body), Data body) =>
Stmt (GhcPass 'Renamed) body
-> WriterT
     VarSet (WriterT Any (Reader Env)) (Stmt (GhcPass 'Renamed) body)
dealWithStmt LStmt (GhcPass 'Renamed) body
GenLocated
  (Anno (Stmt (GhcPass 'Renamed) body))
  (Stmt (GhcPass 'Renamed) body)
lstmt
  (GenLocated
  (Anno (Stmt (GhcPass 'Renamed) body))
  (Stmt (GhcPass 'Renamed) body)
stmtRes GenLocated
  (Anno (Stmt (GhcPass 'Renamed) body))
  (Stmt (GhcPass 'Renamed) body)
-> [GenLocated
      (Anno (Stmt (GhcPass 'Renamed) body))
      (Stmt (GhcPass 'Renamed) body)]
-> [GenLocated
      (Anno (Stmt (GhcPass 'Renamed) body))
      (Stmt (GhcPass 'Renamed) body)]
forall a. a -> [a] -> [a]
:) ([GenLocated
    (Anno (Stmt (GhcPass 'Renamed) body))
    (Stmt (GhcPass 'Renamed) body)]
 -> [GenLocated
       (Anno (Stmt (GhcPass 'Renamed) body))
       (Stmt (GhcPass 'Renamed) body)])
-> WriterT
     VarSet
     (WriterT Any (Reader Env))
     [GenLocated
        (Anno (Stmt (GhcPass 'Renamed) body))
        (Stmt (GhcPass 'Renamed) body)]
-> WriterT
     VarSet
     (WriterT Any (Reader Env))
     [GenLocated
        (Anno (Stmt (GhcPass 'Renamed) body))
        (Stmt (GhcPass 'Renamed) body)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WriterT
   Any
   (Reader Env)
   ([GenLocated
       (Anno (Stmt (GhcPass 'Renamed) body))
       (Stmt (GhcPass 'Renamed) body)],
    VarSet)
 -> WriterT
      Any
      (Reader Env)
      ([GenLocated
          (Anno (Stmt (GhcPass 'Renamed) body))
          (Stmt (GhcPass 'Renamed) body)],
       VarSet))
-> WriterT
     VarSet
     (WriterT Any (Reader Env))
     [GenLocated
        (Anno (Stmt (GhcPass 'Renamed) body))
        (Stmt (GhcPass 'Renamed) body)]
-> WriterT
     VarSet
     (WriterT Any (Reader Env))
     [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
     (Reader Env)
     ([GenLocated
         (Anno (Stmt (GhcPass 'Renamed) body))
         (Stmt (GhcPass 'Renamed) body)],
      VarSet)
-> WriterT
     Any
     (Reader Env)
     ([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 (Reader Env)) [LStmt (GhcPass 'Renamed) body]
forall body.
(Data body, Data (Stmt (GhcPass 'Renamed) body)) =>
[LStmt (GhcPass 'Renamed) body]
-> WriterT
     VarSet (WriterT Any (Reader Env)) [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 (Reader Env)) (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 (Reader Env)) ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell VarSet
names
    body
bodyRes <- EnvReader body -> WriterT VarSet (WriterT Any (Reader Env)) body
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (EnvReader body -> WriterT VarSet (WriterT Any (Reader Env)) body)
-> (EnvReader body -> EnvReader body)
-> EnvReader body
-> WriterT VarSet (WriterT Any (Reader Env)) body
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarSet -> EnvReader body -> EnvReader body
forall a. VarSet -> EnvReader a -> EnvReader a
addScopedVars VarSet
names (EnvReader body -> WriterT VarSet (WriterT Any (Reader Env)) body)
-> EnvReader body -> WriterT VarSet (WriterT Any (Reader Env)) 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 (Reader Env)) (Stmt (GhcPass 'Renamed) body)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Stmt (GhcPass 'Renamed) body
 -> WriterT
      VarSet (WriterT Any (Reader Env)) (Stmt (GhcPass 'Renamed) body))
-> Stmt (GhcPass 'Renamed) body
-> WriterT
     VarSet (WriterT Any (Reader Env)) (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 (Reader Env))
     (HsLocalBinds (GhcPass 'Renamed), VarSet)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (EnvReader (HsLocalBinds (GhcPass 'Renamed), VarSet)
 -> WriterT
      VarSet
      (WriterT Any (Reader Env))
      (HsLocalBinds (GhcPass 'Renamed), VarSet))
-> EnvReader (HsLocalBinds (GhcPass 'Renamed), VarSet)
-> WriterT
     VarSet
     (WriterT Any (Reader Env))
     (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 (Reader Env)) ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell VarSet
names
    Stmt (GhcPass 'Renamed) body
-> WriterT
     VarSet (WriterT Any (Reader Env)) (Stmt (GhcPass 'Renamed) body)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Stmt (GhcPass 'Renamed) body
 -> WriterT
      VarSet (WriterT Any (Reader Env)) (Stmt (GhcPass 'Renamed) body))
-> Stmt (GhcPass 'Renamed) body
-> WriterT
     VarSet (WriterT Any (Reader Env)) (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 (Reader Env))
     (ApplicativeArg (GhcPass 'Renamed))
dealWithAppArg = \case
          a :: ApplicativeArg (GhcPass 'Renamed)
a@Ghc.ApplicativeArgOne{Bool
LPat (GhcPass 'Renamed)
LHsExpr (GhcPass 'Renamed)
XApplicativeArgOne (GhcPass 'Renamed)
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
is_body_stmt :: Bool
arg_expr :: LHsExpr (GhcPass 'Renamed)
app_arg_pattern :: LPat (GhcPass 'Renamed)
xarg_app_arg_one :: XApplicativeArgOne (GhcPass 'Renamed)
..} -> do
            VarSet -> WriterT VarSet (WriterT Any (Reader Env)) ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell (VarSet -> WriterT VarSet (WriterT Any (Reader Env)) ())
-> VarSet -> WriterT VarSet (WriterT Any (Reader Env)) ()
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 (Reader Env))
     (ApplicativeArg (GhcPass 'Renamed))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ApplicativeArg (GhcPass 'Renamed)
a
          a :: ApplicativeArg (GhcPass 'Renamed)
a@Ghc.ApplicativeArgMany{[GuardLStmt (GhcPass 'Renamed)]
HsStmtContext (ApplicativeArgStmCtxPass (GhcPass 'Renamed))
HsExpr (GhcPass 'Renamed)
LPat (GhcPass 'Renamed)
XApplicativeArgMany (GhcPass 'Renamed)
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 -> HsStmtContext (ApplicativeArgStmCtxPass idL)
xarg_app_arg_many :: forall idL. ApplicativeArg idL -> XApplicativeArgMany idL
stmt_context :: HsStmtContext (ApplicativeArgStmCtxPass (GhcPass 'Renamed))
bv_pattern :: LPat (GhcPass 'Renamed)
final_expr :: HsExpr (GhcPass 'Renamed)
app_stmts :: [GuardLStmt (GhcPass 'Renamed)]
xarg_app_arg_many :: XApplicativeArgMany (GhcPass 'Renamed)
..} -> do
            VarSet -> WriterT VarSet (WriterT Any (Reader Env)) ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell (VarSet -> WriterT VarSet (WriterT Any (Reader Env)) ())
-> VarSet -> WriterT VarSet (WriterT Any (Reader Env)) ()
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
  (Reader Env)
  ([GenLocated
      (Anno
         (Stmt
            (GhcPass 'Renamed)
            (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
      (Stmt
         (GhcPass 'Renamed)
         (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
   VarSet)
-> WriterT
     VarSet
     (WriterT Any (Reader Env))
     ([GenLocated
         (Anno
            (Stmt
               (GhcPass 'Renamed)
               (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
         (Stmt
            (GhcPass 'Renamed)
            (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
      VarSet)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WriterT
   Any
   (Reader Env)
   ([GenLocated
       (Anno
          (Stmt
             (GhcPass 'Renamed)
             (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
       (Stmt
          (GhcPass 'Renamed)
          (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
    VarSet)
 -> WriterT
      VarSet
      (WriterT Any (Reader Env))
      ([GenLocated
          (Anno
             (Stmt
                (GhcPass 'Renamed)
                (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
          (Stmt
             (GhcPass 'Renamed)
             (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
       VarSet))
-> (WriterT
      VarSet
      (WriterT Any (Reader Env))
      [GenLocated
         (Anno
            (Stmt
               (GhcPass 'Renamed)
               (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
         (Stmt
            (GhcPass 'Renamed)
            (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
    -> WriterT
         Any
         (Reader Env)
         ([GenLocated
             (Anno
                (Stmt
                   (GhcPass 'Renamed)
                   (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
             (Stmt
                (GhcPass 'Renamed)
                (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
          VarSet))
-> WriterT
     VarSet
     (WriterT Any (Reader Env))
     [GenLocated
        (Anno
           (Stmt
              (GhcPass 'Renamed)
              (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
        (Stmt
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> WriterT
     VarSet
     (WriterT Any (Reader Env))
     ([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 (Reader Env))
  [GenLocated
     (Anno
        (Stmt
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
     (Stmt
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> WriterT
     Any
     (Reader Env)
     ([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 (Reader Env))
   [GenLocated
      (Anno
         (Stmt
            (GhcPass 'Renamed)
            (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
      (Stmt
         (GhcPass 'Renamed)
         (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
 -> WriterT
      VarSet
      (WriterT Any (Reader Env))
      ([GenLocated
          (Anno
             (Stmt
                (GhcPass 'Renamed)
                (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
          (Stmt
             (GhcPass 'Renamed)
             (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
       VarSet))
-> WriterT
     VarSet
     (WriterT Any (Reader Env))
     [GenLocated
        (Anno
           (Stmt
              (GhcPass 'Renamed)
              (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
        (Stmt
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> WriterT
     VarSet
     (WriterT Any (Reader Env))
     ([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 (Reader Env))
     [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 (Reader Env)) [LStmt (GhcPass 'Renamed) body]
dealWithStatements [GuardLStmt (GhcPass 'Renamed)]
[LStmt
   (GhcPass 'Renamed)
   (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))]
app_stmts
            ApplicativeArg (GhcPass 'Renamed)
-> WriterT
     VarSet
     (WriterT Any (Reader Env))
     (ApplicativeArg (GhcPass 'Renamed))
forall (f :: * -> *) a. Applicative f => a -> f a
pure ApplicativeArg (GhcPass 'Renamed)
a {app_stmts :: [GuardLStmt (GhcPass 'Renamed)]
Ghc.app_stmts = [GuardLStmt (GhcPass 'Renamed)]
[GenLocated
   (Anno
      (Stmt
         (GhcPass 'Renamed)
         (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
   (Stmt
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsExpr (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 (Reader Env))
      (SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed)))
-> [(SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))]
-> WriterT
     VarSet
     (WriterT Any (Reader Env))
     [(SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (((SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))
  -> WriterT
       VarSet
       (WriterT Any (Reader Env))
       (SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed)))
 -> [(SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))]
 -> WriterT
      VarSet
      (WriterT Any (Reader Env))
      [(SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))])
-> ((ApplicativeArg (GhcPass 'Renamed)
     -> WriterT
          VarSet
          (WriterT Any (Reader Env))
          (ApplicativeArg (GhcPass 'Renamed)))
    -> (SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))
    -> WriterT
         VarSet
         (WriterT Any (Reader Env))
         (SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed)))
-> (ApplicativeArg (GhcPass 'Renamed)
    -> WriterT
         VarSet
         (WriterT Any (Reader Env))
         (ApplicativeArg (GhcPass 'Renamed)))
-> [(SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))]
-> WriterT
     VarSet
     (WriterT Any (Reader Env))
     [(SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ApplicativeArg (GhcPass 'Renamed)
 -> WriterT
      VarSet
      (WriterT Any (Reader Env))
      (ApplicativeArg (GhcPass 'Renamed)))
-> (SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))
-> WriterT
     VarSet
     (WriterT Any (Reader Env))
     (SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse) ApplicativeArg (GhcPass 'Renamed)
-> WriterT
     VarSet
     (WriterT Any (Reader Env))
     (ApplicativeArg (GhcPass 'Renamed))
dealWithAppArg [(SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))]
[(SyntaxExpr (GhcPass 'Renamed),
  ApplicativeArg (GhcPass 'Renamed))]
pairs
    Stmt (GhcPass 'Renamed) body
-> WriterT
     VarSet (WriterT Any (Reader Env)) (Stmt (GhcPass 'Renamed) body)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Stmt (GhcPass 'Renamed) body
 -> WriterT
      VarSet (WriterT Any (Reader Env)) (Stmt (GhcPass 'Renamed) body))
-> Stmt (GhcPass 'Renamed) body
-> WriterT
     VarSet (WriterT Any (Reader Env)) (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 [(SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))]
[(SyntaxExpr (GhcPass 'Renamed),
  ApplicativeArg (GhcPass 'Renamed))]
pairsRes Maybe (SyntaxExpr (GhcPass 'Renamed))
mbJoin

  Stmt (GhcPass 'Renamed) body
other -> EnvReader (Stmt (GhcPass 'Renamed) body)
-> WriterT
     VarSet (WriterT Any (Reader Env)) (Stmt (GhcPass 'Renamed) body)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (EnvReader (Stmt (GhcPass 'Renamed) body)
 -> WriterT
      VarSet (WriterT Any (Reader Env)) (Stmt (GhcPass 'Renamed) body))
-> EnvReader (Stmt (GhcPass 'Renamed) body)
-> WriterT
     VarSet (WriterT Any (Reader Env)) (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
gmapM 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 (Reader Env)) (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT (WriterT Any (Reader Env)) (HsExpr (GhcPass 'Renamed))
 -> EnvReader (Maybe (HsExpr (GhcPass 'Renamed))))
-> MaybeT (WriterT Any (Reader Env)) (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall a b. (a -> b) -> a -> b
$ do
    GenLocated SrcSpan (HsCmdTop (GhcPass 'Renamed))
cmdTopRes <- GenLocated SrcSpan (HsCmdTop (GhcPass 'Renamed))
-> (HsCmdTop (GhcPass 'Renamed)
    -> MaybeT (WriterT Any (Reader Env)) (HsCmdTop (GhcPass 'Renamed)))
-> MaybeT
     (WriterT Any (Reader Env))
     (GenLocated SrcSpan (HsCmdTop (GhcPass 'Renamed)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for LHsCmdTop (GhcPass 'Renamed)
GenLocated SrcSpan (HsCmdTop (GhcPass 'Renamed))
cmdTop ((HsCmdTop (GhcPass 'Renamed)
  -> MaybeT (WriterT Any (Reader Env)) (HsCmdTop (GhcPass 'Renamed)))
 -> MaybeT
      (WriterT Any (Reader Env))
      (GenLocated SrcSpan (HsCmdTop (GhcPass 'Renamed))))
-> (HsCmdTop (GhcPass 'Renamed)
    -> MaybeT (WriterT Any (Reader Env)) (HsCmdTop (GhcPass 'Renamed)))
-> MaybeT
     (WriterT Any (Reader Env))
     (GenLocated SrcSpan (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 (Reader Env)) (HsCmd (GhcPass 'Renamed)))
-> MaybeT
     (WriterT Any (Reader Env))
     (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for LHsCmd (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))
lcmd ((HsCmd (GhcPass 'Renamed)
  -> MaybeT (WriterT Any (Reader Env)) (HsCmd (GhcPass 'Renamed)))
 -> MaybeT
      (WriterT Any (Reader Env))
      (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))
-> (HsCmd (GhcPass 'Renamed)
    -> MaybeT (WriterT Any (Reader Env)) (HsCmd (GhcPass 'Renamed)))
-> MaybeT
     (WriterT Any (Reader Env))
     (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
  (Reader Env)
  (GenLocated
     SrcSpanAnnL
     [GenLocated
        (Anno
           (Stmt
              (GhcPass 'Renamed)
              (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
        (Stmt
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
   VarSet)
-> MaybeT
     (WriterT Any (Reader Env))
     (GenLocated
        SrcSpanAnnL
        [GenLocated
           (Anno
              (Stmt
                 (GhcPass 'Renamed)
                 (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
           (Stmt
              (GhcPass 'Renamed)
              (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
      VarSet)
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WriterT
   Any
   (Reader Env)
   (GenLocated
      SrcSpanAnnL
      [GenLocated
         (Anno
            (Stmt
               (GhcPass 'Renamed)
               (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
         (Stmt
            (GhcPass 'Renamed)
            (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
    VarSet)
 -> MaybeT
      (WriterT Any (Reader Env))
      (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 (Reader Env))
          [GenLocated
             (Anno
                (Stmt
                   (GhcPass 'Renamed)
                   (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
             (Stmt
                (GhcPass 'Renamed)
                (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))])
    -> WriterT
         Any
         (Reader Env)
         (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 (Reader Env))
         [GenLocated
            (Anno
               (Stmt
                  (GhcPass 'Renamed)
                  (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
            (Stmt
               (GhcPass 'Renamed)
               (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))])
-> MaybeT
     (WriterT Any (Reader Env))
     (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 (Reader Env))
  (GenLocated
     SrcSpanAnnL
     [GenLocated
        (Anno
           (Stmt
              (GhcPass 'Renamed)
              (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
        (Stmt
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))])
-> WriterT
     Any
     (Reader Env)
     (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 (Reader Env))
   (GenLocated
      SrcSpanAnnL
      [GenLocated
         (Anno
            (Stmt
               (GhcPass 'Renamed)
               (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
         (Stmt
            (GhcPass 'Renamed)
            (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))])
 -> WriterT
      Any
      (Reader Env)
      (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 (Reader Env))
          [GenLocated
             (Anno
                (Stmt
                   (GhcPass 'Renamed)
                   (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
             (Stmt
                (GhcPass 'Renamed)
                (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))])
    -> WriterT
         VarSet
         (WriterT Any (Reader Env))
         (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 (Reader Env))
         [GenLocated
            (Anno
               (Stmt
                  (GhcPass 'Renamed)
                  (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
            (Stmt
               (GhcPass 'Renamed)
               (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))])
-> WriterT
     Any
     (Reader Env)
     (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 (Reader Env))
         [GenLocated
            (Anno
               (Stmt
                  (GhcPass 'Renamed)
                  (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
            (Stmt
               (GhcPass 'Renamed)
               (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))])
-> WriterT
     VarSet
     (WriterT Any (Reader Env))
     (GenLocated
        SrcSpanAnnL
        [GenLocated
           (Anno
              (Stmt
                 (GhcPass 'Renamed)
                 (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
           (Stmt
              (GhcPass 'Renamed)
              (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for XRec (GhcPass 'Renamed) [CmdLStmt (GhcPass 'Renamed)]
GenLocated
  SrcSpanAnnL
  [GenLocated
     SrcSpanAnnA
     (Stmt
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
lstmts (([GenLocated
     SrcSpanAnnA
     (Stmt
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
  -> WriterT
       VarSet
       (WriterT Any (Reader Env))
       [GenLocated
          (Anno
             (Stmt
                (GhcPass 'Renamed)
                (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
          (Stmt
             (GhcPass 'Renamed)
             (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))])
 -> MaybeT
      (WriterT Any (Reader Env))
      (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 (Reader Env))
         [GenLocated
            (Anno
               (Stmt
                  (GhcPass 'Renamed)
                  (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
            (Stmt
               (GhcPass 'Renamed)
               (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))])
-> MaybeT
     (WriterT Any (Reader Env))
     (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 (Reader Env)) ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell VarSet
inputNames
              (WriterT
   Any
   (Reader Env)
   ([GenLocated
       (Anno
          (Stmt
             (GhcPass 'Renamed)
             (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
       (Stmt
          (GhcPass 'Renamed)
          (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
    VarSet)
 -> WriterT
      Any
      (Reader Env)
      ([GenLocated
          (Anno
             (Stmt
                (GhcPass 'Renamed)
                (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
          (Stmt
             (GhcPass 'Renamed)
             (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
       VarSet))
-> WriterT
     VarSet
     (WriterT Any (Reader Env))
     [GenLocated
        (Anno
           (Stmt
              (GhcPass 'Renamed)
              (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
        (Stmt
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
-> WriterT
     VarSet
     (WriterT Any (Reader Env))
     [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
     (Reader Env)
     ([GenLocated
         (Anno
            (Stmt
               (GhcPass 'Renamed)
               (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
         (Stmt
            (GhcPass 'Renamed)
            (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
      VarSet)
-> WriterT
     Any
     (Reader Env)
     ([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 (Reader Env))
   [GenLocated
      (Anno
         (Stmt
            (GhcPass 'Renamed)
            (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
      (Stmt
         (GhcPass 'Renamed)
         (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
 -> WriterT
      VarSet
      (WriterT Any (Reader Env))
      [GenLocated
         (Anno
            (Stmt
               (GhcPass 'Renamed)
               (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
         (Stmt
            (GhcPass 'Renamed)
            (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))])
-> WriterT
     VarSet
     (WriterT Any (Reader Env))
     [GenLocated
        (Anno
           (Stmt
              (GhcPass 'Renamed)
              (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
        (Stmt
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
-> WriterT
     VarSet
     (WriterT Any (Reader Env))
     [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 (Reader Env))
     [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 (Reader Env)) [LStmt (GhcPass 'Renamed) body]
dealWithStatements [LStmt
   (GhcPass 'Renamed)
   (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))]
[GenLocated
   SrcSpanAnnA
   (Stmt
      (GhcPass 'Renamed)
      (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
stmts
            HsCmd (GhcPass 'Renamed)
-> MaybeT (WriterT Any (Reader Env)) (HsCmd (GhcPass 'Renamed))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsCmd (GhcPass 'Renamed)
 -> MaybeT (WriterT Any (Reader Env)) (HsCmd (GhcPass 'Renamed)))
-> HsCmd (GhcPass 'Renamed)
-> MaybeT (WriterT Any (Reader Env)) (HsCmd (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ XCmdDo (GhcPass 'Renamed)
-> XRec (GhcPass 'Renamed) [CmdLStmt (GhcPass 'Renamed)]
-> HsCmd (GhcPass 'Renamed)
forall id. XCmdDo id -> XRec id [CmdLStmt id] -> HsCmd id
Ghc.HsCmdDo XCmdDo (GhcPass 'Renamed)
x3 XRec (GhcPass 'Renamed) [CmdLStmt (GhcPass 'Renamed)]
GenLocated
  SrcSpanAnnL
  [GenLocated
     (Anno
        (Stmt
           (GhcPass 'Renamed)
           (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
     (Stmt
        (GhcPass 'Renamed)
        (GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
stmtsRes

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

        HsCmdTop (GhcPass 'Renamed)
-> MaybeT (WriterT Any (Reader Env)) (HsCmdTop (GhcPass 'Renamed))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsCmdTop (GhcPass 'Renamed)
 -> MaybeT (WriterT Any (Reader Env)) (HsCmdTop (GhcPass 'Renamed)))
-> HsCmdTop (GhcPass 'Renamed)
-> MaybeT (WriterT Any (Reader Env)) (HsCmdTop (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ XCmdTop (GhcPass 'Renamed)
-> LHsCmd (GhcPass 'Renamed) -> HsCmdTop (GhcPass 'Renamed)
forall p. XCmdTop p -> LHsCmd p -> HsCmdTop p
Ghc.HsCmdTop XCmdTop (GhcPass 'Renamed)
x2 LHsCmd (GhcPass 'Renamed)
GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))
cmdRes
#if !MIN_VERSION_ghc(9,0,0)
      _ -> empty
#endif
    HsExpr (GhcPass 'Renamed)
-> MaybeT (WriterT Any (Reader Env)) (HsExpr (GhcPass 'Renamed))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsExpr (GhcPass 'Renamed)
 -> MaybeT (WriterT Any (Reader Env)) (HsExpr (GhcPass 'Renamed)))
-> HsExpr (GhcPass 'Renamed)
-> MaybeT (WriterT Any (Reader Env)) (HsExpr (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ XProc (GhcPass 'Renamed)
-> LPat (GhcPass 'Renamed)
-> LHsCmdTop (GhcPass 'Renamed)
-> HsExpr (GhcPass 'Renamed)
forall p. XProc p -> LPat p -> LHsCmdTop p -> HsExpr p
Ghc.HsProc XProc (GhcPass 'Renamed)
x1 LPat (GhcPass 'Renamed)
lpat LHsCmdTop (GhcPass 'Renamed)
GenLocated SrcSpan (HsCmdTop (GhcPass 'Renamed))
cmdTopRes
hsProcCase HsExpr (GhcPass 'Renamed)
_ = Maybe (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
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 (Reader Env)

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
  }

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 (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 = (Reader Env (a, Any) -> Reader Env (a, Any))
-> WriterT Any (Reader Env) a -> WriterT Any (Reader Env) 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 ((Reader Env (a, Any) -> Reader Env (a, Any))
 -> WriterT Any (Reader Env) a -> WriterT Any (Reader Env) a)
-> (Reader Env (a, Any) -> Reader Env (a, Any))
-> WriterT Any (Reader Env) a
-> WriterT Any (Reader Env) a
forall a b. (a -> b) -> a -> b
$ (Env -> Env) -> Reader Env (a, Any) -> Reader Env (a, Any)
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)
             [(LHsBind (GhcPass 'Renamed), [Name], UniqSet Name)]
[(GenLocated
    SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
  [Name], UniqSet Name)]
binds_w_dus

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

--------------------------------------------------------------------------------
-- 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 (f :: * -> *) a. Applicative f => a -> f a
pure ()
  }

initTcPlugin :: Ghc.TcPluginM TcPluginNames
initTcPlugin :: TcPluginM TcPluginNames
initTcPlugin = do
  Ghc.Found ModLocation
_ Module
breakpointMod <-
    ModuleName -> Maybe FastString -> TcPluginM FindResult
Plugin.findImportedModule (String -> ModuleName
Ghc.mkModuleName String
"Debug.Breakpoint") Maybe FastString
forall a. Maybe a
Nothing
  Ghc.Found ModLocation
_ Module
showMod <-
    ModuleName -> Maybe FastString -> TcPluginM FindResult
Plugin.findImportedModule (String -> ModuleName
Ghc.mkModuleName String
"GHC.Show") (FastString -> Maybe FastString
forall a. a -> Maybe a
Just (FastString -> Maybe FastString) -> FastString -> Maybe FastString
forall a b. (a -> b) -> a -> b
$ String -> FastString
Ghc.fsLit String
"base")

  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 (f :: * -> *) a. Applicative f => a -> f a
pure MkTcPluginNames{Class
TyCon
Name
showWrapperTyCon :: TyCon
succeedClass :: Class
showClass :: Class
showLevClassName :: Name
showWrapperTyCon :: TyCon
succeedClass :: Class
showClass :: Class
showLevClassName :: Name
..}

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_class :: Ct -> Class
cc_ev :: Ct -> CtEvidence
cc_pend_sc :: Ct -> Bool
cc_tyargs :: Ct -> [Type]
cc_pend_sc :: Bool
cc_tyargs :: [Type]
cc_class :: Class
cc_ev :: CtEvidence
..} <- 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 [Ct]
_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 (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 (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)
  TcPluginResult -> TcPluginM TcPluginResult
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TcPluginResult -> TcPluginM TcPluginResult)
-> TcPluginResult -> TcPluginM TcPluginResult
forall a b. (a -> b) -> a -> b
$ [(EvTerm, Ct)] -> [Ct] -> TcPluginResult
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 (TcPluginNames -> Class
showClass TcPluginNames
names) [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 (t :: * -> *) a. Foldable t => t a -> Bool
null [Type]
subclasses
         then Maybe EvTerm -> TcPluginM (Maybe EvTerm)
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 (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)
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 (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)
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
                  Class
cls
                  [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 (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 (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 (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.showSDocUnsafe (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 (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

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

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