{-# LANGUAGE CPP #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE MagicHash #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PolyKinds #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE ImplicitParams #-}
module Debug.Breakpoint
(
plugin
, breakpoint
, breakpointM
, breakpointIO
, queryVars
, queryVarsM
, queryVarsIO
, excludeVars
, captureVars
, showLev
, fromAscList
, printAndWait
, printAndWaitM
, printAndWaitIO
, runPrompt
, runPromptM
, runPromptIO
, getSrcLoc
) where
import Control.Applicative ((<|>), empty)
import Control.Arrow ((&&&))
import Control.Monad.IO.Class
import Control.Monad.Reader
import Control.Monad.Trans.Maybe
import Control.Monad.Trans.Writer.CPS
import Data.Char (isSpace)
import Data.Data hiding (IntRep, FloatRep)
import Data.Either
import Data.Foldable
import Data.Functor
import qualified Data.Graph as Graph
import qualified Data.List as L
import qualified Data.Map.Lazy as M
import Data.Maybe
import Data.Monoid (Any(..))
import qualified Data.Text.Lazy as T
import Data.Traversable (for)
import Debug.Trace (trace, traceIO, traceM)
import qualified GHC.Exts as Exts
import GHC.Int
#if MIN_VERSION_ghc(9,0,0)
import qualified GHC.Tc.Plugin as Plugin
#else
import qualified TcPluginM as Plugin
#endif
import GHC.Word
import qualified System.Console.ANSI as ANSI
import qualified System.Console.Haskeline as HL
import System.Environment (lookupEnv)
import System.IO (stdout)
import System.IO.Unsafe (unsafePerformIO)
import qualified Text.Pretty.Simple as PS
import qualified Text.Pretty.Simple.Internal.Color as PS
import qualified Debug.Breakpoint.GhcFacade as Ghc
import qualified Debug.Breakpoint.TimerManager as TM
captureVars :: M.Map String String
captureVars :: Map String String
captureVars = Map String String
forall a. Monoid a => a
mempty
fromAscList :: Ord k => [(k, v)] -> M.Map k v
fromAscList :: forall k v. Ord k => [(k, v)] -> Map k v
fromAscList = [(k, v)] -> Map k v
forall k a. Eq k => [(k, a)] -> Map k a
M.fromAscList
printAndWait :: String -> M.Map String String -> a -> a
printAndWait :: forall a. String -> Map String String -> a -> a
printAndWait String
srcLoc Map String String
vars a
x =
IO a -> a
forall a. IO a -> a
unsafePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ String -> Map String String -> IO ()
forall (m :: * -> *).
MonadIO m =>
String -> Map String String -> m ()
printAndWaitIO String
srcLoc Map String String
vars IO () -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
{-# NOINLINE printAndWait #-}
printAndWaitM :: Applicative m => String -> M.Map String String -> m ()
printAndWaitM :: forall (m :: * -> *).
Applicative m =>
String -> Map String String -> m ()
printAndWaitM String
srcLoc Map String String
vars = String -> Map String String -> m () -> m ()
forall a. String -> Map String String -> a -> a
printAndWait String
srcLoc Map String String
vars (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
printAndWaitIO :: MonadIO m => String -> M.Map String String -> m ()
printAndWaitIO :: forall (m :: * -> *).
MonadIO m =>
String -> Map String String -> m ()
printAndWaitIO String
srcLoc Map String String
vars = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Bool
useColor <- Handle -> IO Bool
ANSI.hSupportsANSIColor Handle
stdout
let ?useColor = ?useColor::Bool
Bool
useColor
Bool
prettyPrint <- IO Bool
usePrettyPrinting
let ?prettyPrint = ?prettyPrint::Bool
Bool
prettyPrint
IO () -> IO ()
forall a. IO a -> IO a
TM.suspendTimeouts (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
String -> IO ()
traceIO (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
L.intercalate String
"\n"
[ (?useColor::Bool) => String -> String -> String
String -> String -> String
color String
red String
"### Breakpoint Hit ###"
, (?useColor::Bool) => String -> String -> String
String -> String -> String
color String
grey String
"(" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
srcLoc String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")"
, (?useColor::Bool, ?prettyPrint::Bool) =>
Map String String -> String
Map String String -> String
printVars Map String String
vars
, (?useColor::Bool) => String -> String -> String
String -> String -> String
color String
green String
"Press enter to continue"
]
IO Int -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void IO Int
blockOnInput
runPrompt :: String -> M.Map String String -> a -> a
runPrompt :: forall a. String -> Map String String -> a -> a
runPrompt String
srcLoc Map String String
vars a
x =
IO a -> a
forall a. IO a -> a
unsafePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ String -> Map String String -> IO ()
forall (m :: * -> *).
MonadIO m =>
String -> Map String String -> m ()
runPromptIO String
srcLoc Map String String
vars IO () -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
{-# NOINLINE runPrompt #-}
runPromptM :: Applicative m => String -> M.Map String String -> m ()
runPromptM :: forall (m :: * -> *).
Applicative m =>
String -> Map String String -> m ()
runPromptM String
srcLoc Map String String
vars = String -> Map String String -> m () -> m ()
forall a. String -> Map String String -> a -> a
runPrompt String
srcLoc Map String String
vars (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
runPromptIO :: forall m. MonadIO m => String -> M.Map String String -> m ()
runPromptIO :: forall (m :: * -> *).
MonadIO m =>
String -> Map String String -> m ()
runPromptIO String
srcLoc Map String String
vars = IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> (InputT IO () -> IO ()) -> InputT IO () -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Behavior -> Settings IO -> InputT IO () -> IO ()
forall (m :: * -> *) a.
(MonadIO m, MonadMask m) =>
Behavior -> Settings m -> InputT m a -> m a
HL.runInputTBehavior Behavior
HL.defaultBehavior Settings IO
settings (InputT IO () -> m ()) -> InputT IO () -> m ()
forall a b. (a -> b) -> a -> b
$ do
Bool
useColor <- IO Bool -> InputT IO Bool
forall a. IO a -> InputT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO Bool -> InputT IO Bool) -> IO Bool -> InputT IO Bool
forall a b. (a -> b) -> a -> b
$ Handle -> IO Bool
ANSI.hSupportsANSIColor Handle
stdout
let ?useColor = ?useColor::Bool
Bool
useColor
Bool
prettyPrint <- IO Bool -> InputT IO Bool
forall a. IO a -> InputT IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO Bool
usePrettyPrinting
let ?prettyPrint = ?prettyPrint::Bool
Bool
prettyPrint
let printVar :: String -> String -> InputT m ()
printVar String
var String
val =
String -> InputT m ()
forall (m :: * -> *). MonadIO m => String -> InputT m ()
HL.outputStrLn (String -> InputT m ()) -> String -> InputT m ()
forall a b. (a -> b) -> a -> b
$ (?useColor::Bool) => String -> String -> String
String -> String -> String
color String
cyan (String
var String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" =\n") String -> String -> String
forall a. [a] -> [a] -> [a]
++ (?prettyPrint::Bool) => String -> String
String -> String
prettify String
val
inputLoop :: InputT IO ()
inputLoop = do
Maybe String
mInp <- String -> InputT IO (Maybe String)
forall (m :: * -> *).
(MonadIO m, MonadMask m) =>
String -> InputT m (Maybe String)
HL.getInputLine (String -> InputT IO (Maybe String))
-> String -> InputT IO (Maybe String)
forall a b. (a -> b) -> a -> b
$ (?useColor::Bool) => String -> String -> String
String -> String -> String
color String
green String
"Enter variable name: "
case Maybe String
mInp of
Just ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
L.dropWhileEnd Char -> Bool
isSpace (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace -> String
inp)
| Bool -> Bool
not (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
inp) -> do
(String -> InputT IO ()) -> Maybe String -> InputT IO ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (String -> String -> InputT IO ()
forall {m :: * -> *}.
(MonadIO m, ?useColor::Bool, ?prettyPrint::Bool) =>
String -> String -> InputT m ()
printVar String
inp) (Maybe String -> InputT IO ()) -> Maybe String -> InputT IO ()
forall a b. (a -> b) -> a -> b
$ String -> Map String String -> Maybe String
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup String
inp Map String String
vars
InputT IO ()
inputLoop
Maybe String
_ -> () -> InputT IO ()
forall a. a -> InputT IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
String -> InputT IO ()
forall (m :: * -> *). MonadIO m => String -> InputT m ()
HL.outputStrLn (String -> InputT IO ())
-> ([String] -> String) -> [String] -> InputT IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
unlines ([String] -> InputT IO ()) -> [String] -> InputT IO ()
forall a b. (a -> b) -> a -> b
$
[ (?useColor::Bool) => String -> String -> String
String -> String -> String
color String
red String
"### Breakpoint Hit ###"
, (?useColor::Bool) => String -> String -> String
String -> String -> String
color String
grey (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
"(" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
srcLoc String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
")"
] [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ ((?useColor::Bool) => String -> String -> String
String -> String -> String
color String
cyan (String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
varNames)
InputT IO ()
inputLoop
where
settings :: Settings IO
settings = CompletionFunc IO -> Settings IO -> Settings IO
forall (m :: * -> *). CompletionFunc m -> Settings m -> Settings m
HL.setComplete CompletionFunc IO
completion Settings IO
forall (m :: * -> *). MonadIO m => Settings m
HL.defaultSettings
completion :: CompletionFunc IO
completion = Maybe Char
-> (Char -> Bool)
-> (String -> IO [Completion])
-> CompletionFunc IO
forall (m :: * -> *).
Monad m =>
Maybe Char
-> (Char -> Bool) -> (String -> m [Completion]) -> CompletionFunc m
HL.completeWord' Maybe Char
forall a. Maybe a
Nothing Char -> Bool
isSpace ((String -> IO [Completion]) -> CompletionFunc IO)
-> (String -> IO [Completion]) -> CompletionFunc IO
forall a b. (a -> b) -> a -> b
$ \String
str ->
[Completion] -> IO [Completion]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Completion] -> IO [Completion])
-> [Completion] -> IO [Completion]
forall a b. (a -> b) -> a -> b
$ String -> Completion
HL.simpleCompletion
(String -> Completion) -> [String] -> [Completion]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String
str String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`L.isPrefixOf`) [String]
varNames
varNames :: [String]
varNames = Map String String -> [String]
forall k a. Map k a -> [k]
M.keys Map String String
vars
usePrettyPrinting :: IO Bool
usePrettyPrinting :: IO Bool
usePrettyPrinting = Maybe String -> Bool
forall a. Maybe a -> Bool
isNothing (Maybe String -> Bool) -> IO (Maybe String) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
lookupEnv String
"NO_PRETTY_PRINT"
color :: (?useColor :: Bool) => String -> String -> String
color :: (?useColor::Bool) => String -> String -> String
color String
c String
s =
if ?useColor::Bool
Bool
?useColor
then String
"\ESC[" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
c String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"m\STX" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
s String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"\ESC[m\STX"
else String
s
red, green, grey, cyan :: String
red :: String
red = String
"31"
green :: String
green = String
"32"
grey :: String
grey = String
"37"
cyan :: String
cyan = String
"36"
printVars :: (?useColor :: Bool, ?prettyPrint :: Bool)
=> M.Map String String -> String
printVars :: (?useColor::Bool, ?prettyPrint::Bool) =>
Map String String -> String
printVars Map String String
vars =
let eqSign :: String
eqSign | ?prettyPrint::Bool
Bool
?prettyPrint = String
" =\n"
| Bool
otherwise = String
" = "
mkLine :: (String, String) -> String
mkLine (String
k, String
v) = (?useColor::Bool) => String -> String -> String
String -> String -> String
color String
cyan (String
k String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
eqSign) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (?prettyPrint::Bool) => String -> String
String -> String
prettify String
v
in [String] -> String
unlines ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String] -> [String]
forall a. a -> [a] -> [a]
L.intersperse String
"" ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (?useColor::Bool, ?prettyPrint::Bool) => (String, String) -> String
(String, String) -> String
mkLine ((String, String) -> String) -> [(String, String)] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Map String String -> [(String, String)]
forall k a. Map k a -> [(k, a)]
M.toList Map String String
vars
prettify :: (?prettyPrint :: Bool) => String -> String
prettify :: (?prettyPrint::Bool) => String -> String
prettify =
if ?prettyPrint::Bool
Bool
?prettyPrint
then Text -> String
T.unpack
(Text -> String) -> (String -> Text) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OutputOptions -> String -> Text
PS.pStringOpt
OutputOptions
PS.defaultOutputOptionsDarkBg
{ outputOptionsInitialIndent :: Int
PS.outputOptionsInitialIndent = Int
2
, outputOptionsIndentAmount :: Int
PS.outputOptionsIndentAmount = Int
2
, outputOptionsColorOptions :: Maybe ColorOptions
PS.outputOptionsColorOptions = ColorOptions -> Maybe ColorOptions
forall a. a -> Maybe a
Just PS.ColorOptions
{ colorQuote :: Style
PS.colorQuote = Style
PS.colorNull
, colorString :: Style
PS.colorString = Intensity -> Color -> Style
PS.colorBold Intensity
PS.Vivid Color
PS.Blue
, colorError :: Style
PS.colorError = Intensity -> Color -> Style
PS.colorBold Intensity
PS.Vivid Color
PS.Red
, colorNum :: Style
PS.colorNum = Intensity -> Color -> Style
PS.colorBold Intensity
PS.Vivid Color
PS.Green
, colorRainbowParens :: [Style]
PS.colorRainbowParens = [Intensity -> Color -> Style
PS.colorBold Intensity
PS.Vivid Color
PS.Cyan]
}
}
else String -> String
forall a. a -> a
id
inactivePluginStr :: String
inactivePluginStr :: String
inactivePluginStr =
String
"Cannot set breakpoint: the Debug.Trace plugin is not active"
breakpoint :: a -> a
breakpoint :: forall a. a -> a
breakpoint = String -> a -> a
forall a. String -> a -> a
trace String
inactivePluginStr
queryVars :: a -> a
queryVars :: forall a. a -> a
queryVars = String -> a -> a
forall a. String -> a -> a
trace String
inactivePluginStr
queryVarsM :: Applicative m => m ()
queryVarsM :: forall (m :: * -> *). Applicative m => m ()
queryVarsM = String -> m ()
forall (f :: * -> *). Applicative f => String -> f ()
traceM String
inactivePluginStr
queryVarsIO :: MonadIO m => m ()
queryVarsIO :: forall (m :: * -> *). MonadIO m => m ()
queryVarsIO =
IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO ()
traceIO String
inactivePluginStr)
breakpointM :: Applicative m => m ()
breakpointM :: forall (m :: * -> *). Applicative m => m ()
breakpointM = String -> m ()
forall (f :: * -> *). Applicative f => String -> f ()
traceM String
inactivePluginStr
breakpointIO :: MonadIO m => m ()
breakpointIO :: forall (m :: * -> *). MonadIO m => m ()
breakpointIO =
IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> IO ()
traceIO String
inactivePluginStr)
getSrcLoc :: String
getSrcLoc :: String
getSrcLoc = String
""
#if MIN_VERSION_ghc(9,2,0)
foreign import ccall unsafe "stdio.h getchar" blockOnInput :: IO Int
#else
blockOnInput :: IO Int
blockOnInput = 1 <$ getLine
#endif
excludeVars :: [String] -> a -> a
excludeVars :: forall a. [String] -> a -> a
excludeVars [String]
_ = a -> a
forall a. a -> a
id
plugin :: Ghc.Plugin
plugin :: Plugin
plugin = Plugin
Ghc.defaultPlugin
{ pluginRecompile :: [String] -> IO PluginRecompile
Ghc.pluginRecompile = [String] -> IO PluginRecompile
Ghc.purePlugin
, renamedResultAction :: [String]
-> TcGblEnv
-> HsGroup (GhcPass 'Renamed)
-> TcM (TcGblEnv, HsGroup (GhcPass 'Renamed))
Ghc.renamedResultAction = (TcGblEnv
-> HsGroup (GhcPass 'Renamed)
-> TcM (TcGblEnv, HsGroup (GhcPass 'Renamed)))
-> [String]
-> TcGblEnv
-> HsGroup (GhcPass 'Renamed)
-> TcM (TcGblEnv, HsGroup (GhcPass 'Renamed))
forall a b. a -> b -> a
const TcGblEnv
-> HsGroup (GhcPass 'Renamed)
-> TcM (TcGblEnv, HsGroup (GhcPass 'Renamed))
renameAction
, tcPlugin :: TcPlugin
Ghc.tcPlugin = Maybe TcPlugin -> TcPlugin
forall a b. a -> b -> a
const (Maybe TcPlugin -> TcPlugin) -> Maybe TcPlugin -> TcPlugin
forall a b. (a -> b) -> a -> b
$ TcPlugin -> Maybe TcPlugin
forall a. a -> Maybe a
Just TcPlugin
tcPlugin
}
renameAction
:: Ghc.TcGblEnv
-> Ghc.HsGroup Ghc.GhcRn
-> Ghc.TcM (Ghc.TcGblEnv, Ghc.HsGroup Ghc.GhcRn)
renameAction :: TcGblEnv
-> HsGroup (GhcPass 'Renamed)
-> TcM (TcGblEnv, HsGroup (GhcPass 'Renamed))
renameAction TcGblEnv
gblEnv HsGroup (GhcPass 'Renamed)
group = do
Ghc.Found ModLocation
_ Module
breakpointMod <-
ModuleName -> TcM FindResult
Ghc.findPluginModule' (String -> ModuleName
Ghc.mkModuleName String
"Debug.Breakpoint")
Name
captureVarsName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"captureVars")
Name
showLevName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"showLev")
Name
fromListName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"fromAscList")
Name
breakpointName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"breakpoint")
Name
queryVarsName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"queryVars")
Name
breakpointMName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"breakpointM")
Name
queryVarsMName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"queryVarsM")
Name
breakpointIOName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"breakpointIO")
Name
queryVarsIOName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"queryVarsIO")
Name
printAndWaitName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"printAndWait")
Name
printAndWaitMName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"printAndWaitM")
Name
printAndWaitIOName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"printAndWaitIO")
Name
runPromptIOName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"runPromptIO")
Name
runPromptMName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"runPromptM")
Name
runPromptName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"runPrompt")
Name
getSrcLocName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"getSrcLoc")
Name
excludeVarsName <- Module -> OccName -> TcRnIf TcGblEnv TcLclEnv Name
forall a b. Module -> OccName -> TcRnIf a b Name
Ghc.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkVarOcc String
"excludeVars")
(HsGroup (GhcPass 'Renamed)
group', Any
_) <-
ReaderT
Env
(IOEnv (Env TcGblEnv TcLclEnv))
(HsGroup (GhcPass 'Renamed), Any)
-> Env
-> IOEnv (Env TcGblEnv TcLclEnv) (HsGroup (GhcPass 'Renamed), Any)
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(HsGroup (GhcPass 'Renamed))
-> ReaderT
Env
(IOEnv (Env TcGblEnv TcLclEnv))
(HsGroup (GhcPass 'Renamed), Any)
forall w (m :: * -> *) a. Monoid w => WriterT w m a -> m (a, w)
runWriterT (WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(HsGroup (GhcPass 'Renamed))
-> ReaderT
Env
(IOEnv (Env TcGblEnv TcLclEnv))
(HsGroup (GhcPass 'Renamed), Any))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(HsGroup (GhcPass 'Renamed))
-> ReaderT
Env
(IOEnv (Env TcGblEnv TcLclEnv))
(HsGroup (GhcPass 'Renamed), Any)
forall a b. (a -> b) -> a -> b
$ HsGroup (GhcPass 'Renamed)
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(HsGroup (GhcPass 'Renamed))
forall a. Data a => a -> EnvReader a
recurse HsGroup (GhcPass 'Renamed)
group)
MkEnv { varSet :: VarSet
varSet = VarSet
forall a. Monoid a => a
mempty, Name
captureVarsName :: Name
showLevName :: Name
fromListName :: Name
breakpointName :: Name
queryVarsName :: Name
breakpointMName :: Name
queryVarsMName :: Name
breakpointIOName :: Name
queryVarsIOName :: Name
printAndWaitName :: Name
printAndWaitMName :: Name
printAndWaitIOName :: Name
runPromptIOName :: Name
runPromptMName :: Name
runPromptName :: Name
getSrcLocName :: Name
excludeVarsName :: Name
captureVarsName :: Name
showLevName :: Name
fromListName :: Name
breakpointName :: Name
queryVarsName :: Name
breakpointMName :: Name
queryVarsMName :: Name
breakpointIOName :: Name
queryVarsIOName :: Name
printAndWaitName :: Name
printAndWaitMName :: Name
printAndWaitIOName :: Name
runPromptIOName :: Name
runPromptName :: Name
runPromptMName :: Name
getSrcLocName :: Name
excludeVarsName :: Name
.. }
(TcGblEnv, HsGroup (GhcPass 'Renamed))
-> TcM (TcGblEnv, HsGroup (GhcPass 'Renamed))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TcGblEnv
gblEnv, HsGroup (GhcPass 'Renamed)
group')
recurse :: Data a => a -> EnvReader a
recurse :: forall a. Data a => a -> EnvReader a
recurse a
a =
WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
-> (a
-> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a)
-> Maybe a
-> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ((forall a. Data a => a -> EnvReader a)
-> a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> a -> m a
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a
gmapM d -> EnvReader d
forall a. Data a => a -> EnvReader a
recurse a
a) a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(Maybe a
-> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a)
-> WriterT
Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) (Maybe a)
-> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< a
-> WriterT
Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) (Maybe a)
forall a. Data a => a -> EnvReader (Maybe a)
transform a
a
newtype T a = T (a -> EnvReader (Maybe a))
transform :: forall a. Data a => a -> EnvReader (Maybe a)
transform :: forall a. Data a => a -> EnvReader (Maybe a)
transform a
a = MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> WriterT
Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) (Maybe a)
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT
(MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> WriterT
Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) (Maybe a))
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> WriterT
Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) (Maybe a)
forall a b. (a -> b) -> a -> b
$ (HsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed))))
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall b.
Data b =>
(b -> EnvReader (Maybe b))
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
wrap HsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
hsVarCase
MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall a.
MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> EnvReader
(Maybe (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall b.
Data b =>
(b -> EnvReader (Maybe b))
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
wrap GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> EnvReader
(Maybe (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
LHsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (LHsExpr (GhcPass 'Renamed)))
hsAppCase
MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall a.
MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Match
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader
(Maybe
(Match
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))))
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall b.
Data b =>
(b -> EnvReader (Maybe b))
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
wrap Match
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader
(Maybe
(Match
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
Match (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
-> EnvReader
(Maybe (Match (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))))
matchCase
MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall a.
MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader
(Maybe
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))))
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall b.
Data b =>
(b -> EnvReader (Maybe b))
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
wrap GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader
(Maybe
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
-> EnvReader
(Maybe (GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))))
grhssCase
MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall a.
MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (HsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed))))
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall b.
Data b =>
(b -> EnvReader (Maybe b))
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
wrap HsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
hsLetCase
MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall a.
MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader
(Maybe
(GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))))
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall b.
Data b =>
(b -> EnvReader (Maybe b))
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
wrap GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader
(Maybe
(GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
GRHS (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
-> EnvReader
(Maybe (GRHS (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))))
grhsCase
MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall a.
MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (HsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed))))
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall b.
Data b =>
(b -> EnvReader (Maybe b))
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
wrap HsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
hsDoCase
MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall a.
MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (HsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed))))
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall b.
Data b =>
(b -> EnvReader (Maybe b))
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
wrap HsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
hsProcCase
where
wrap :: forall b. Data b
=> (b -> EnvReader (Maybe b))
-> MaybeT EnvReader a
wrap :: forall b.
Data b =>
(b -> EnvReader (Maybe b))
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
wrap b -> EnvReader (Maybe b)
f = do
case forall {k} (a :: k) (b :: k) (c :: k -> *).
(Typeable a, Typeable b) =>
c a -> Maybe (c b)
forall a b (c :: * -> *).
(Typeable a, Typeable b) =>
c a -> Maybe (c b)
gcast @b @a ((b -> EnvReader (Maybe b)) -> T b
forall a. (a -> EnvReader (Maybe a)) -> T a
T b -> EnvReader (Maybe b)
f) of
Maybe (T a)
Nothing -> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall a.
MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall (f :: * -> *) a. Alternative f => f a
empty
Just (T a
-> WriterT
Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) (Maybe a)
f') -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) (Maybe a)
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall (m :: * -> *) a. m (Maybe a) -> MaybeT m a
MaybeT (WriterT
Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) (Maybe a)
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a)
-> WriterT
Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) (Maybe a)
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall a b. (a -> b) -> a -> b
$ a
-> WriterT
Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) (Maybe a)
f' a
a
hsVarCase :: Ghc.HsExpr Ghc.GhcRn
-> EnvReader (Maybe (Ghc.HsExpr Ghc.GhcRn))
hsVarCase :: HsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
hsVarCase (Ghc.HsVar XVar (GhcPass 'Renamed)
_ (Ghc.L SrcSpanAnnN
loc Name
name)) = do
MkEnv{Name
VarSet
varSet :: Env -> VarSet
captureVarsName :: Env -> Name
showLevName :: Env -> Name
fromListName :: Env -> Name
breakpointName :: Env -> Name
queryVarsName :: Env -> Name
breakpointMName :: Env -> Name
queryVarsMName :: Env -> Name
breakpointIOName :: Env -> Name
queryVarsIOName :: Env -> Name
printAndWaitName :: Env -> Name
printAndWaitMName :: Env -> Name
printAndWaitIOName :: Env -> Name
runPromptIOName :: Env -> Name
runPromptName :: Env -> Name
runPromptMName :: Env -> Name
getSrcLocName :: Env -> Name
excludeVarsName :: Env -> Name
varSet :: VarSet
captureVarsName :: Name
showLevName :: Name
fromListName :: Name
breakpointName :: Name
queryVarsName :: Name
breakpointMName :: Name
queryVarsMName :: Name
breakpointIOName :: Name
queryVarsIOName :: Name
printAndWaitName :: Name
printAndWaitMName :: Name
printAndWaitIOName :: Name
runPromptIOName :: Name
runPromptName :: Name
runPromptMName :: Name
getSrcLocName :: Name
excludeVarsName :: Name
..} <- ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)) Env
-> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) Env
forall (m :: * -> *) a. Monad m => m a -> WriterT Any m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)) Env
forall r (m :: * -> *). MonadReader r m => m r
ask
let srcLocStringExpr :: GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
srcLocStringExpr
= HsLit (GhcPass 'Renamed)
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
HsLit (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (p :: Pass). HsLit (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsLit (HsLit (GhcPass 'Renamed)
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> (SrcSpan -> HsLit (GhcPass 'Renamed))
-> SrcSpan
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> HsLit (GhcPass 'Renamed)
forall (p :: Pass). String -> HsLit (GhcPass p)
Ghc.mkHsString
(String -> HsLit (GhcPass 'Renamed))
-> (SrcSpan -> String) -> SrcSpan -> HsLit (GhcPass 'Renamed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SDoc -> String
Ghc.showSDocUnsafe
(SDoc -> String) -> (SrcSpan -> SDoc) -> SrcSpan -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcSpan -> SDoc
forall a. Outputable a => a -> SDoc
Ghc.ppr
(SrcSpan -> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> SrcSpan -> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ SrcSpanAnnN -> SrcSpan
forall ann. SrcSpanAnn' ann -> SrcSpan
Ghc.locA' SrcSpanAnnN
loc
captureVarsExpr :: Maybe Name -> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
captureVarsExpr Maybe Name
mResultName =
let mkTuple :: (LexicalFastString', Name) -> LHsExpr (GhcPass 'Renamed)
mkTuple (LexicalFastString' -> FastString
Ghc.fromLexicalFastString -> FastString
varStr, Name
n) =
[LHsExpr (GhcPass 'Renamed)]
-> XExplicitTuple (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (p :: Pass).
[LHsExpr (GhcPass p)]
-> XExplicitTuple (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.mkLHsTupleExpr
[ HsLit (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (p :: Pass). HsLit (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsLit (HsLit (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed))
-> (String -> HsLit (GhcPass 'Renamed))
-> String
-> LHsExpr (GhcPass 'Renamed)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> HsLit (GhcPass 'Renamed)
forall (p :: Pass). String -> HsLit (GhcPass p)
Ghc.mkHsString (String -> LHsExpr (GhcPass 'Renamed))
-> String -> LHsExpr (GhcPass 'Renamed)
forall a b. (a -> b) -> a -> b
$ FastString -> String
Ghc.unpackFS FastString
varStr
, LHsExpr (GhcPass 'Renamed)
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp (IdP (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsVar Name
IdP (GhcPass 'Renamed)
showLevName) (IdP (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsVar Name
IdP (GhcPass 'Renamed)
n)
]
#if MIN_VERSION_ghc(9,2,0)
NoExtField
XExplicitTuple (GhcPass 'Renamed)
Ghc.NoExtField
#endif
mkList :: [XRec p (HsExpr p)] -> LocatedAn an (HsExpr p)
mkList [XRec p (HsExpr p)]
exprs = HsExpr p -> LocatedAn an (HsExpr p)
forall a an. a -> LocatedAn an a
Ghc.noLocA' (XExplicitList p -> [XRec p (HsExpr p)] -> HsExpr p
forall p. XExplicitList p -> [LHsExpr p] -> HsExpr p
Ghc.ExplicitList' NoExtField
XExplicitList p
Ghc.NoExtField [XRec p (HsExpr p)]
exprs)
varSetWithResult :: VarSet
varSetWithResult
| Just Name
resName <- Maybe Name
mResultName =
LexicalFastString' -> Name -> VarSet -> VarSet
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert (FastString -> LexicalFastString'
Ghc.mkLexicalFastString (FastString -> LexicalFastString')
-> FastString -> LexicalFastString'
forall a b. (a -> b) -> a -> b
$ String -> FastString
Ghc.mkFastString String
"*result")
Name
resName
VarSet
varSet
| Bool
otherwise = VarSet
varSet
in LHsExpr (GhcPass 'Renamed)
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp (IdP (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsVar Name
IdP (GhcPass 'Renamed)
fromListName) (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> ([GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))]
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> [GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))]
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))]
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
[LHsExpr (GhcPass 'Renamed)]
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
forall {p} {an}.
(XExplicitList p ~ NoExtField) =>
[XRec p (HsExpr p)] -> LocatedAn an (HsExpr p)
mkList
([GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))]
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> [GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))]
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ (LexicalFastString', Name)
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
(LexicalFastString', Name) -> LHsExpr (GhcPass 'Renamed)
mkTuple ((LexicalFastString', Name)
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> [(LexicalFastString', Name)]
-> [GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> VarSet -> [(LexicalFastString', Name)]
forall k a. Map k a -> [(k, a)]
M.toList VarSet
varSetWithResult
bpExpr :: IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
bpExpr = do
Name
resultName <- OccName -> TcRnIf TcGblEnv TcLclEnv Name
Ghc.newName (NameSpace -> String -> OccName
Ghc.mkOccName NameSpace
Ghc.varName String
"_result_")
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall a b. (a -> b) -> a -> b
$
[LPat (GhcPass 'Renamed)]
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (p :: Pass).
(IsPass p, XMG (GhcPass p) (LHsExpr (GhcPass p)) ~ NoExtField) =>
[LPat (GhcPass p)] -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.mkHsLam [IdP (GhcPass 'Renamed) -> LPat (GhcPass 'Renamed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LPat (GhcPass p)
Ghc.nlVarPat Name
IdP (GhcPass 'Renamed)
resultName] (LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed))
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall a b. (a -> b) -> a -> b
$
LHsExpr (GhcPass 'Renamed)
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp
(LHsExpr (GhcPass 'Renamed)
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp
(LHsExpr (GhcPass 'Renamed)
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp (IdP (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsVar Name
IdP (GhcPass 'Renamed)
printAndWaitName) GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
LHsExpr (GhcPass 'Renamed)
srcLocStringExpr)
(Maybe Name -> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
captureVarsExpr (Maybe Name -> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> Maybe Name -> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ Name -> Maybe Name
forall a. a -> Maybe a
Just Name
resultName)
)
(IdP (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsVar Name
IdP (GhcPass 'Renamed)
resultName)
bpMExpr :: LHsExpr (GhcPass 'Renamed)
bpMExpr =
LHsExpr (GhcPass 'Renamed)
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp
(LHsExpr (GhcPass 'Renamed)
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp (IdP (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsVar Name
IdP (GhcPass 'Renamed)
printAndWaitMName) GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
LHsExpr (GhcPass 'Renamed)
srcLocStringExpr)
(LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed))
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall a b. (a -> b) -> a -> b
$ Maybe Name -> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
captureVarsExpr Maybe Name
forall a. Maybe a
Nothing
bpIOExpr :: LHsExpr (GhcPass 'Renamed)
bpIOExpr =
LHsExpr (GhcPass 'Renamed)
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp
(LHsExpr (GhcPass 'Renamed)
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp (IdP (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsVar Name
IdP (GhcPass 'Renamed)
printAndWaitIOName) GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
LHsExpr (GhcPass 'Renamed)
srcLocStringExpr)
(LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed))
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall a b. (a -> b) -> a -> b
$ Maybe Name -> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
captureVarsExpr Maybe Name
forall a. Maybe a
Nothing
queryVarsIOExpr :: LHsExpr (GhcPass 'Renamed)
queryVarsIOExpr =
LHsExpr (GhcPass 'Renamed)
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp
(LHsExpr (GhcPass 'Renamed)
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp (IdP (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsVar Name
IdP (GhcPass 'Renamed)
runPromptIOName) GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
LHsExpr (GhcPass 'Renamed)
srcLocStringExpr)
(LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed))
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall a b. (a -> b) -> a -> b
$ Maybe Name -> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
captureVarsExpr Maybe Name
forall a. Maybe a
Nothing
queryVarsExpr :: IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
queryVarsExpr = do
Name
resultName <- OccName -> TcRnIf TcGblEnv TcLclEnv Name
Ghc.newName (NameSpace -> String -> OccName
Ghc.mkOccName NameSpace
Ghc.varName String
"_result_")
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall a b. (a -> b) -> a -> b
$
[LPat (GhcPass 'Renamed)]
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (p :: Pass).
(IsPass p, XMG (GhcPass p) (LHsExpr (GhcPass p)) ~ NoExtField) =>
[LPat (GhcPass p)] -> LHsExpr (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.mkHsLam [IdP (GhcPass 'Renamed) -> LPat (GhcPass 'Renamed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LPat (GhcPass p)
Ghc.nlVarPat Name
IdP (GhcPass 'Renamed)
resultName] (LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed))
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall a b. (a -> b) -> a -> b
$
LHsExpr (GhcPass 'Renamed)
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp
(LHsExpr (GhcPass 'Renamed)
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp
(LHsExpr (GhcPass 'Renamed)
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp (IdP (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsVar Name
IdP (GhcPass 'Renamed)
runPromptName) GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
LHsExpr (GhcPass 'Renamed)
srcLocStringExpr)
(Maybe Name -> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
captureVarsExpr (Maybe Name -> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> Maybe Name -> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ Name -> Maybe Name
forall a. a -> Maybe a
Just Name
resultName)
)
(IdP (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsVar Name
IdP (GhcPass 'Renamed)
resultName)
queryVarsMExpr :: LHsExpr (GhcPass 'Renamed)
queryVarsMExpr =
LHsExpr (GhcPass 'Renamed)
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp
(LHsExpr (GhcPass 'Renamed)
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (id :: Pass).
IsPass id =>
LHsExpr (GhcPass id)
-> LHsExpr (GhcPass id) -> LHsExpr (GhcPass id)
Ghc.nlHsApp (IdP (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall (p :: Pass) a.
IsSrcSpanAnn p a =>
IdP (GhcPass p) -> LHsExpr (GhcPass p)
Ghc.nlHsVar Name
IdP (GhcPass 'Renamed)
runPromptMName) GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
LHsExpr (GhcPass 'Renamed)
srcLocStringExpr)
(LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed))
-> LHsExpr (GhcPass 'Renamed) -> LHsExpr (GhcPass 'Renamed)
forall a b. (a -> b) -> a -> b
$ Maybe Name -> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
captureVarsExpr Maybe Name
forall a. Maybe a
Nothing
if | Name
captureVarsName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name -> do
Any -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell (Any
-> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) ())
-> Any
-> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) ()
forall a b. (a -> b) -> a -> b
$ Bool -> Any
Any Bool
True
Maybe (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed))
forall a. a -> Maybe a
Just (HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed)))
-> (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> HsExpr (GhcPass 'Renamed))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> Maybe (HsExpr (GhcPass 'Renamed))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> HsExpr (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
Ghc.unLoc (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> Maybe (HsExpr (GhcPass 'Renamed)))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> Maybe (HsExpr (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ Maybe Name -> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
captureVarsExpr Maybe Name
forall a. Maybe a
Nothing)
| Name
breakpointName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name -> do
Any -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell (Any
-> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) ())
-> Any
-> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) ()
forall a b. (a -> b) -> a -> b
$ Bool -> Any
Any Bool
True
HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed))
forall a. a -> Maybe a
Just (HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed)))
-> (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> HsExpr (GhcPass 'Renamed))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> Maybe (HsExpr (GhcPass 'Renamed))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> HsExpr (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
Ghc.unLoc (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> Maybe (HsExpr (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
Env
(IOEnv (Env TcGblEnv TcLclEnv))
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall (m :: * -> *) a. Monad m => m a -> WriterT Any m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> ReaderT
Env
(IOEnv (Env TcGblEnv TcLclEnv))
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall (m :: * -> *) a. Monad m => m a -> ReaderT Env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
bpExpr)
| Name
breakpointMName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name -> do
Any -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell (Any
-> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) ())
-> Any
-> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) ()
forall a b. (a -> b) -> a -> b
$ Bool -> Any
Any Bool
True
Maybe (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed))
forall a. a -> Maybe a
Just (HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed)))
-> HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> HsExpr (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
Ghc.unLoc GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
LHsExpr (GhcPass 'Renamed)
bpMExpr)
| Name
breakpointIOName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name -> do
Any -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell (Any
-> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) ())
-> Any
-> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) ()
forall a b. (a -> b) -> a -> b
$ Bool -> Any
Any Bool
True
Maybe (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed))
forall a. a -> Maybe a
Just (HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed)))
-> HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> HsExpr (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
Ghc.unLoc GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
LHsExpr (GhcPass 'Renamed)
bpIOExpr)
| Name
queryVarsIOName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name -> do
Any -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell (Any
-> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) ())
-> Any
-> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) ()
forall a b. (a -> b) -> a -> b
$ Bool -> Any
Any Bool
True
Maybe (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed))
forall a. a -> Maybe a
Just (HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed)))
-> HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> HsExpr (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
Ghc.unLoc GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
LHsExpr (GhcPass 'Renamed)
queryVarsIOExpr)
| Name
queryVarsName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name -> do
Any -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell (Any
-> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) ())
-> Any
-> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) ()
forall a b. (a -> b) -> a -> b
$ Bool -> Any
Any Bool
True
HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed))
forall a. a -> Maybe a
Just (HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed)))
-> (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> HsExpr (GhcPass 'Renamed))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> Maybe (HsExpr (GhcPass 'Renamed))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> HsExpr (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
Ghc.unLoc (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> Maybe (HsExpr (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReaderT
Env
(IOEnv (Env TcGblEnv TcLclEnv))
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall (m :: * -> *) a. Monad m => m a -> WriterT Any m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> ReaderT
Env
(IOEnv (Env TcGblEnv TcLclEnv))
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall (m :: * -> *) a. Monad m => m a -> ReaderT Env m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift IOEnv
(Env TcGblEnv TcLclEnv)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
queryVarsExpr)
| Name
queryVarsMName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name -> do
Any -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) ()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell (Any
-> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) ())
-> Any
-> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) ()
forall a b. (a -> b) -> a -> b
$ Bool -> Any
Any Bool
True
Maybe (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed))
forall a. a -> Maybe a
Just (HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed)))
-> HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> HsExpr (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
Ghc.unLoc GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
LHsExpr (GhcPass 'Renamed)
queryVarsMExpr)
| Name
getSrcLocName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
name ->
Maybe (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed))
forall a. a -> Maybe a
Just (HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed)))
-> HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> HsExpr (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
Ghc.unLoc GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
srcLocStringExpr)
| Bool
otherwise -> Maybe (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (HsExpr (GhcPass 'Renamed))
forall a. Maybe a
Nothing
hsVarCase HsExpr (GhcPass 'Renamed)
_ = Maybe (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (HsExpr (GhcPass 'Renamed))
forall a. Maybe a
Nothing
hsAppCase :: Ghc.LHsExpr Ghc.GhcRn
-> EnvReader (Maybe (Ghc.LHsExpr Ghc.GhcRn))
hsAppCase :: LHsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (LHsExpr (GhcPass 'Renamed)))
hsAppCase (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> HsExpr (GhcPass 'Renamed)
LHsExpr (GhcPass 'Renamed) -> HsExpr (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
Ghc.unLoc -> Ghc.HsApp XApp (GhcPass 'Renamed)
_ LHsExpr (GhcPass 'Renamed)
f LHsExpr (GhcPass 'Renamed)
innerExpr)
| Ghc.HsApp XApp (GhcPass 'Renamed)
_ (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> HsExpr (GhcPass 'Renamed)
LHsExpr (GhcPass 'Renamed) -> HsExpr (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
Ghc.unLoc -> Ghc.HsVar XVar (GhcPass 'Renamed)
_ (GenLocated SrcSpanAnnN Name -> Name
LIdP (GhcPass 'Renamed) -> Name
forall l e. GenLocated l e -> e
Ghc.unLoc -> Name
name))
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> HsExpr (GhcPass 'Renamed)
LHsExpr (GhcPass 'Renamed) -> HsExpr (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
Ghc.unLoc -> Ghc.ExplicitList' XExplicitList (GhcPass 'Renamed)
_ [LHsExpr (GhcPass 'Renamed)]
exprsToExclude)
<- GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> HsExpr (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
Ghc.unLoc GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
LHsExpr (GhcPass 'Renamed)
f
= do
MkEnv{Name
VarSet
varSet :: Env -> VarSet
captureVarsName :: Env -> Name
showLevName :: Env -> Name
fromListName :: Env -> Name
breakpointName :: Env -> Name
queryVarsName :: Env -> Name
breakpointMName :: Env -> Name
queryVarsMName :: Env -> Name
breakpointIOName :: Env -> Name
queryVarsIOName :: Env -> Name
printAndWaitName :: Env -> Name
printAndWaitMName :: Env -> Name
printAndWaitIOName :: Env -> Name
runPromptIOName :: Env -> Name
runPromptName :: Env -> Name
runPromptMName :: Env -> Name
getSrcLocName :: Env -> Name
excludeVarsName :: Env -> Name
varSet :: VarSet
captureVarsName :: Name
showLevName :: Name
fromListName :: Name
breakpointName :: Name
queryVarsName :: Name
breakpointMName :: Name
queryVarsMName :: Name
breakpointIOName :: Name
queryVarsIOName :: Name
printAndWaitName :: Name
printAndWaitMName :: Name
printAndWaitIOName :: Name
runPromptIOName :: Name
runPromptName :: Name
runPromptMName :: Name
getSrcLocName :: Name
excludeVarsName :: Name
..} <- ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)) Env
-> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) Env
forall (m :: * -> *) a. Monad m => m a -> WriterT Any m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)) Env
forall r (m :: * -> *). MonadReader r m => m r
ask
if Name
excludeVarsName Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
/= Name
name
then Maybe (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader
(Maybe (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall a. Maybe a
Nothing
else do
let extractVarName :: HsExpr (GhcPass 'Renamed) -> Maybe LexicalFastString'
extractVarName (Ghc.HsLit XLitE (GhcPass 'Renamed)
_ (Ghc.HsString XHsString (GhcPass 'Renamed)
_ FastString
fs)) =
LexicalFastString' -> Maybe LexicalFastString'
forall a. a -> Maybe a
Just (LexicalFastString' -> Maybe LexicalFastString')
-> LexicalFastString' -> Maybe LexicalFastString'
forall a b. (a -> b) -> a -> b
$ FastString -> LexicalFastString'
Ghc.mkLexicalFastString FastString
fs
extractVarName (Ghc.HsOverLit XOverLitE (GhcPass 'Renamed)
_ (Ghc.OverLit' (Ghc.HsIsString SourceText
_ FastString
fs))) =
LexicalFastString' -> Maybe LexicalFastString'
forall a. a -> Maybe a
Just (LexicalFastString' -> Maybe LexicalFastString')
-> LexicalFastString' -> Maybe LexicalFastString'
forall a b. (a -> b) -> a -> b
$ FastString -> LexicalFastString'
Ghc.mkLexicalFastString FastString
fs
extractVarName HsExpr (GhcPass 'Renamed)
_ = Maybe LexicalFastString'
forall a. Maybe a
Nothing
varsToExclude :: [LexicalFastString']
varsToExclude =
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> Maybe LexicalFastString')
-> [GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))]
-> [LexicalFastString']
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (HsExpr (GhcPass 'Renamed) -> Maybe LexicalFastString'
extractVarName (HsExpr (GhcPass 'Renamed) -> Maybe LexicalFastString')
-> (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> HsExpr (GhcPass 'Renamed))
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> Maybe LexicalFastString'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> HsExpr (GhcPass 'Renamed)
forall l e. GenLocated l e -> e
Ghc.unLoc) [GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))]
[LHsExpr (GhcPass 'Renamed)]
exprsToExclude
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> Maybe (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall a. a -> Maybe a
Just (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> Maybe (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader
(Maybe (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
(ReaderT
Env
(IOEnv (Env TcGblEnv TcLclEnv))
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)), Any)
-> ReaderT
Env
(IOEnv (Env TcGblEnv TcLclEnv))
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)), Any))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall (n :: * -> *) w w' (m :: * -> *) a b.
(Monad n, Monoid w, Monoid w') =>
(m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
mapWriterT
((Env -> Env)
-> ReaderT
Env
(IOEnv (Env TcGblEnv TcLclEnv))
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)), Any)
-> ReaderT
Env
(IOEnv (Env TcGblEnv TcLclEnv))
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)), Any)
forall a.
(Env -> Env)
-> ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)) a
-> ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ((VarSet -> VarSet) -> Env -> Env
overVarSet ((VarSet -> VarSet) -> Env -> Env)
-> (VarSet -> VarSet) -> Env -> Env
forall a b. (a -> b) -> a -> b
$ \VarSet
vs -> (LexicalFastString' -> VarSet -> VarSet)
-> VarSet -> [LexicalFastString'] -> VarSet
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr LexicalFastString' -> VarSet -> VarSet
forall k a. Ord k => k -> Map k a -> Map k a
M.delete VarSet
vs [LexicalFastString']
varsToExclude))
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall a. Data a => a -> EnvReader a
recurse GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
LHsExpr (GhcPass 'Renamed)
innerExpr)
hsAppCase LHsExpr (GhcPass 'Renamed)
_ = Maybe (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader
(Maybe (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall a. Maybe a
Nothing
matchCase :: Ghc.Match Ghc.GhcRn (Ghc.LHsExpr Ghc.GhcRn)
-> EnvReader (Maybe (Ghc.Match Ghc.GhcRn (Ghc.LHsExpr Ghc.GhcRn)))
matchCase :: Match (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
-> EnvReader
(Maybe (Match (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))))
matchCase Ghc.Match {[LPat (GhcPass 'Renamed)]
GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
HsMatchContext (GhcPass 'Renamed)
XCMatch (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
m_ext :: XCMatch (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
m_ctxt :: HsMatchContext (GhcPass 'Renamed)
m_pats :: [LPat (GhcPass 'Renamed)]
m_grhss :: GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
m_ctxt :: forall p body. Match p body -> HsMatchContext p
m_ext :: forall p body. Match p body -> XCMatch p body
m_grhss :: forall p body. Match p body -> GRHSs p body
m_pats :: forall p body. Match p body -> [LPat p]
..} = do
let names :: VarSet
names = (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)) -> VarSet)
-> [GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))] -> VarSet
forall m a. Monoid m => (a -> m) -> [a] -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)) -> VarSet
LPat (GhcPass 'Renamed) -> VarSet
extractVarPats [GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))]
[LPat (GhcPass 'Renamed)]
m_pats
GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
grhRes <- VarSet
-> EnvReader
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> EnvReader
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
forall a. VarSet -> EnvReader a -> EnvReader a
addScopedVars VarSet
names (EnvReader
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> EnvReader
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
-> EnvReader
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> EnvReader
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
forall a b. (a -> b) -> a -> b
$ GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
forall a. Data a => a -> EnvReader a
recurse GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
m_grhss
Maybe
(Match
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> EnvReader
(Maybe
(Match
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe
(Match
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> EnvReader
(Maybe
(Match
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))))
-> Maybe
(Match
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> EnvReader
(Maybe
(Match
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
forall a b. (a -> b) -> a -> b
$ Match
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> Maybe
(Match
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
forall a. a -> Maybe a
Just
Ghc.Match { m_grhss :: GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
Ghc.m_grhss = GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
grhRes, [LPat (GhcPass 'Renamed)]
HsMatchContext (GhcPass 'Renamed)
XCMatch
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
XCMatch (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
m_ext :: XCMatch (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
m_ctxt :: HsMatchContext (GhcPass 'Renamed)
m_pats :: [LPat (GhcPass 'Renamed)]
m_ctxt :: HsMatchContext (GhcPass 'Renamed)
m_ext :: XCMatch
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
m_pats :: [LPat (GhcPass 'Renamed)]
.. }
#if !MIN_VERSION_ghc(9,0,0)
matchCase _ = pure Nothing
#endif
extractVarPats :: Ghc.LPat Ghc.GhcRn -> VarSet
= [Name] -> VarSet
mkVarSet ([Name] -> VarSet)
-> (GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)) -> [Name])
-> GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
-> VarSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)) -> [Name]
LPat (GhcPass 'Renamed) -> [Name]
Ghc.collectPatBinders'
grhssCase :: Ghc.GRHSs Ghc.GhcRn (Ghc.LHsExpr Ghc.GhcRn)
-> EnvReader (Maybe (Ghc.GRHSs Ghc.GhcRn (Ghc.LHsExpr Ghc.GhcRn)))
grhssCase :: GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
-> EnvReader
(Maybe (GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))))
grhssCase Ghc.GRHSs {[LGRHS (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))]
HsLocalBinds (GhcPass 'Renamed)
XCGRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
grhssExt :: XCGRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
grhssGRHSs :: [LGRHS (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))]
grhssLocalBinds :: HsLocalBinds (GhcPass 'Renamed)
grhssExt :: forall p body. GRHSs p body -> XCGRHSs p body
grhssGRHSs :: forall p body. GRHSs p body -> [LGRHS p body]
grhssLocalBinds :: forall p body. GRHSs p body -> HsLocalBinds p
..} = do
(HsLocalBinds (GhcPass 'Renamed)
localBindsRes, VarSet
names)
<- HsLocalBinds (GhcPass 'Renamed)
-> EnvReader (HsLocalBinds (GhcPass 'Renamed), VarSet)
dealWithLocalBinds
#if MIN_VERSION_ghc(9,2,0)
HsLocalBinds (GhcPass 'Renamed)
grhssLocalBinds
#else
(Ghc.unLoc grhssLocalBinds)
#endif
[GenLocated
(SrcAnn NoEpAnns)
(GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
grhsRes <- VarSet
-> EnvReader
[GenLocated
(SrcAnn NoEpAnns)
(GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> EnvReader
[GenLocated
(SrcAnn NoEpAnns)
(GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
forall a. VarSet -> EnvReader a -> EnvReader a
addScopedVars VarSet
names (EnvReader
[GenLocated
(SrcAnn NoEpAnns)
(GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> EnvReader
[GenLocated
(SrcAnn NoEpAnns)
(GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))])
-> EnvReader
[GenLocated
(SrcAnn NoEpAnns)
(GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> EnvReader
[GenLocated
(SrcAnn NoEpAnns)
(GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
forall a b. (a -> b) -> a -> b
$ [GenLocated
(SrcAnn NoEpAnns)
(GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> EnvReader
[GenLocated
(SrcAnn NoEpAnns)
(GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
forall a. Data a => a -> EnvReader a
recurse [GenLocated
(SrcAnn NoEpAnns)
(GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
[LGRHS (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))]
grhssGRHSs
Maybe
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> EnvReader
(Maybe
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> EnvReader
(Maybe
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))))
-> Maybe
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> EnvReader
(Maybe
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
forall a b. (a -> b) -> a -> b
$ GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> Maybe
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
forall a. a -> Maybe a
Just
Ghc.GRHSs { grhssGRHSs :: [LGRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))]
Ghc.grhssGRHSs = [GenLocated
(SrcAnn NoEpAnns)
(GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
[LGRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))]
grhsRes
#if MIN_VERSION_ghc(9,2,0)
, grhssLocalBinds :: HsLocalBinds (GhcPass 'Renamed)
grhssLocalBinds = HsLocalBinds (GhcPass 'Renamed)
localBindsRes
#else
, grhssLocalBinds = localBindsRes <$ grhssLocalBinds
#endif
, XCGRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
XCGRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
grhssExt :: XCGRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
grhssExt :: XCGRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
..
}
#if !MIN_VERSION_ghc(9,0,0)
grhssCase _ = pure Nothing
#endif
dealWithBind :: VarSet
-> Ghc.LHsBind Ghc.GhcRn
-> EnvReader (Ghc.LHsBind Ghc.GhcRn)
dealWithBind :: VarSet
-> LHsBind (GhcPass 'Renamed)
-> EnvReader (LHsBind (GhcPass 'Renamed))
dealWithBind VarSet
resultNames LHsBind (GhcPass 'Renamed)
lbind = GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
-> (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
LHsBind (GhcPass 'Renamed)
lbind ((HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))))
-> (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
forall a b. (a -> b) -> a -> b
$ \case
Ghc.FunBind {[CoreTickish]
LIdP (GhcPass 'Renamed)
MatchGroup (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
XFunBind (GhcPass 'Renamed) (GhcPass 'Renamed)
fun_ext :: XFunBind (GhcPass 'Renamed) (GhcPass 'Renamed)
fun_id :: LIdP (GhcPass 'Renamed)
fun_matches :: MatchGroup (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
fun_tick :: [CoreTickish]
fun_ext :: forall idL idR. HsBindLR idL idR -> XFunBind idL idR
fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_tick :: forall idL idR. HsBindLR idL idR -> [CoreTickish]
..} -> do
let resultNamesSansSelf :: VarSet
resultNamesSansSelf =
LexicalFastString' -> VarSet -> VarSet
forall k a. Ord k => k -> Map k a -> Map k a
M.delete (Name -> LexicalFastString'
getOccNameFS (Name -> LexicalFastString') -> Name -> LexicalFastString'
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnN Name -> Name
forall l e. GenLocated l e -> e
Ghc.unLoc GenLocated SrcSpanAnnN Name
LIdP (GhcPass 'Renamed)
fun_id) VarSet
resultNames
(MatchGroup
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
matchesRes, Any Bool
containsTarget)
<- WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(MatchGroup
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(MatchGroup
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))),
Any)
forall w (m :: * -> *) a.
(Monoid w, Monad m) =>
WriterT w m a -> WriterT w m (a, w)
listen
(WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(MatchGroup
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(MatchGroup
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))),
Any))
-> (WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(MatchGroup
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(MatchGroup
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(MatchGroup
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(MatchGroup
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))),
Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarSet
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(MatchGroup
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(MatchGroup
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
forall a. VarSet -> EnvReader a -> EnvReader a
addScopedVars VarSet
resultNamesSansSelf
(WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(MatchGroup
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(MatchGroup
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))),
Any))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(MatchGroup
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(MatchGroup
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))),
Any)
forall a b. (a -> b) -> a -> b
$ MatchGroup
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(MatchGroup
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
forall a. Data a => a -> EnvReader a
recurse MatchGroup
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
MatchGroup (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
fun_matches
let rhsVars :: UniqSet Name
rhsVars
| Bool
containsTarget
= [Name] -> UniqSet Name
forall a. Uniquable a => [a] -> UniqSet a
Ghc.mkUniqSet ([Name] -> UniqSet Name)
-> ([Name] -> [Name]) -> [Name] -> UniqSet Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarSet -> [Name]
forall k a. Map k a -> [a]
M.elems
(VarSet -> [Name]) -> ([Name] -> VarSet) -> [Name] -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VarSet -> VarSet -> VarSet
forall a. Semigroup a => a -> a -> a
<> VarSet
resultNamesSansSelf) (VarSet -> VarSet) -> ([Name] -> VarSet) -> [Name] -> VarSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Name] -> VarSet
mkVarSet
([Name] -> UniqSet Name) -> [Name] -> UniqSet Name
forall a b. (a -> b) -> a -> b
$ UniqSet Name -> [Name]
forall elt. UniqSet elt -> [elt]
Ghc.nonDetEltsUniqSet XFunBind (GhcPass 'Renamed) (GhcPass 'Renamed)
UniqSet Name
fun_ext
| Bool
otherwise = XFunBind (GhcPass 'Renamed) (GhcPass 'Renamed)
UniqSet Name
fun_ext
HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ghc.FunBind { fun_matches :: MatchGroup (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
Ghc.fun_matches = MatchGroup
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
MatchGroup (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
matchesRes, fun_ext :: XFunBind (GhcPass 'Renamed) (GhcPass 'Renamed)
Ghc.fun_ext = XFunBind (GhcPass 'Renamed) (GhcPass 'Renamed)
UniqSet Name
rhsVars, [CoreTickish]
LIdP (GhcPass 'Renamed)
fun_id :: LIdP (GhcPass 'Renamed)
fun_tick :: [CoreTickish]
fun_id :: LIdP (GhcPass 'Renamed)
fun_tick :: [CoreTickish]
.. }
Ghc.PatBind {([CoreTickish], [[CoreTickish]])
LPat (GhcPass 'Renamed)
GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
XPatBind (GhcPass 'Renamed) (GhcPass 'Renamed)
pat_ext :: XPatBind (GhcPass 'Renamed) (GhcPass 'Renamed)
pat_lhs :: LPat (GhcPass 'Renamed)
pat_rhs :: GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
pat_ticks :: ([CoreTickish], [[CoreTickish]])
pat_ext :: forall idL idR. HsBindLR idL idR -> XPatBind idL idR
pat_lhs :: forall idL idR. HsBindLR idL idR -> LPat idL
pat_rhs :: forall idL idR. HsBindLR idL idR -> GRHSs idR (LHsExpr idR)
pat_ticks :: forall idL idR.
HsBindLR idL idR -> ([CoreTickish], [[CoreTickish]])
..} -> do
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
rhsRes, Any Bool
containsTarget)
<- EnvReader
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))),
Any)
forall w (m :: * -> *) a.
(Monoid w, Monad m) =>
WriterT w m a -> WriterT w m (a, w)
listen
(EnvReader
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))),
Any))
-> (EnvReader
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> EnvReader
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
-> EnvReader
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))),
Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarSet
-> EnvReader
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> EnvReader
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
forall a. VarSet -> EnvReader a -> EnvReader a
addScopedVars VarSet
resultNames
(EnvReader
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))),
Any))
-> EnvReader
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))),
Any)
forall a b. (a -> b) -> a -> b
$ GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader
(GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
forall a. Data a => a -> EnvReader a
recurse GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
pat_rhs
let rhsVars :: UniqSet Name
rhsVars
| Bool
containsTarget
= [Name] -> UniqSet Name
forall a. Uniquable a => [a] -> UniqSet a
Ghc.mkUniqSet ([Name] -> UniqSet Name)
-> ([Name] -> [Name]) -> [Name] -> UniqSet Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarSet -> [Name]
forall k a. Map k a -> [a]
M.elems
(VarSet -> [Name]) -> ([Name] -> VarSet) -> [Name] -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VarSet -> VarSet -> VarSet
forall a. Semigroup a => a -> a -> a
<> VarSet
resultNames) (VarSet -> VarSet) -> ([Name] -> VarSet) -> [Name] -> VarSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Name] -> VarSet
mkVarSet
([Name] -> UniqSet Name) -> [Name] -> UniqSet Name
forall a b. (a -> b) -> a -> b
$ UniqSet Name -> [Name]
forall elt. UniqSet elt -> [elt]
Ghc.nonDetEltsUniqSet XPatBind (GhcPass 'Renamed) (GhcPass 'Renamed)
UniqSet Name
pat_ext
| Bool
otherwise = XPatBind (GhcPass 'Renamed) (GhcPass 'Renamed)
UniqSet Name
pat_ext
HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ghc.PatBind { pat_rhs :: GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
Ghc.pat_rhs = GRHSs
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
rhsRes, pat_ext :: XPatBind (GhcPass 'Renamed) (GhcPass 'Renamed)
pat_ext = XPatBind (GhcPass 'Renamed) (GhcPass 'Renamed)
UniqSet Name
rhsVars, ([CoreTickish], [[CoreTickish]])
LPat (GhcPass 'Renamed)
pat_lhs :: LPat (GhcPass 'Renamed)
pat_ticks :: ([CoreTickish], [[CoreTickish]])
pat_lhs :: LPat (GhcPass 'Renamed)
pat_ticks :: ([CoreTickish], [[CoreTickish]])
.. }
Ghc.VarBind {LHsExpr (GhcPass 'Renamed)
IdP (GhcPass 'Renamed)
XVarBind (GhcPass 'Renamed) (GhcPass 'Renamed)
var_ext :: XVarBind (GhcPass 'Renamed) (GhcPass 'Renamed)
var_id :: IdP (GhcPass 'Renamed)
var_rhs :: LHsExpr (GhcPass 'Renamed)
var_ext :: forall idL idR. HsBindLR idL idR -> XVarBind idL idR
var_id :: forall idL idR. HsBindLR idL idR -> IdP idL
var_rhs :: forall idL idR. HsBindLR idL idR -> LHsExpr idR
..} -> do
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
rhsRes
<- VarSet
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall a. VarSet -> EnvReader a -> EnvReader a
addScopedVars VarSet
resultNames
(WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall a. Data a => a -> EnvReader a
recurse GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
LHsExpr (GhcPass 'Renamed)
var_rhs
HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Ghc.VarBind { var_rhs :: LHsExpr (GhcPass 'Renamed)
Ghc.var_rhs = GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
LHsExpr (GhcPass 'Renamed)
rhsRes, IdP (GhcPass 'Renamed)
XVarBind (GhcPass 'Renamed) (GhcPass 'Renamed)
var_ext :: XVarBind (GhcPass 'Renamed) (GhcPass 'Renamed)
var_id :: IdP (GhcPass 'Renamed)
var_ext :: XVarBind (GhcPass 'Renamed) (GhcPass 'Renamed)
var_id :: IdP (GhcPass 'Renamed)
.. }
Ghc.PatSynBind XPatSynBind (GhcPass 'Renamed) (GhcPass 'Renamed)
x Ghc.PSB {LIdP (GhcPass 'Renamed)
LPat (GhcPass 'Renamed)
HsPatSynDir (GhcPass 'Renamed)
XPSB (GhcPass 'Renamed) (GhcPass 'Renamed)
HsPatSynDetails (GhcPass 'Renamed)
psb_ext :: XPSB (GhcPass 'Renamed) (GhcPass 'Renamed)
psb_id :: LIdP (GhcPass 'Renamed)
psb_args :: HsPatSynDetails (GhcPass 'Renamed)
psb_def :: LPat (GhcPass 'Renamed)
psb_dir :: HsPatSynDir (GhcPass 'Renamed)
psb_args :: forall idL idR. PatSynBind idL idR -> HsPatSynDetails idR
psb_def :: forall idL idR. PatSynBind idL idR -> LPat idR
psb_dir :: forall idL idR. PatSynBind idL idR -> HsPatSynDir idR
psb_ext :: forall idL idR. PatSynBind idL idR -> XPSB idL idR
psb_id :: forall idL idR. PatSynBind idL idR -> LIdP idL
..} -> do
(GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
defRes, Any Bool
containsTarget)
<- WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)), Any)
forall w (m :: * -> *) a.
(Monoid w, Monad m) =>
WriterT w m a -> WriterT w m (a, w)
listen
(WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)), Any))
-> (WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)), Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarSet
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
forall a. VarSet -> EnvReader a -> EnvReader a
addScopedVars VarSet
resultNames
(WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)), Any))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)), Any)
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed)))
forall a. Data a => a -> EnvReader a
recurse GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
LPat (GhcPass 'Renamed)
psb_def
let rhsVars :: UniqSet Name
rhsVars
| Bool
containsTarget
= [Name] -> UniqSet Name
forall a. Uniquable a => [a] -> UniqSet a
Ghc.mkUniqSet ([Name] -> UniqSet Name)
-> ([Name] -> [Name]) -> [Name] -> UniqSet Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VarSet -> [Name]
forall k a. Map k a -> [a]
M.elems
(VarSet -> [Name]) -> ([Name] -> VarSet) -> [Name] -> [Name]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (VarSet -> VarSet -> VarSet
forall a. Semigroup a => a -> a -> a
<> VarSet
resultNames) (VarSet -> VarSet) -> ([Name] -> VarSet) -> [Name] -> VarSet
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Name] -> VarSet
mkVarSet
([Name] -> UniqSet Name) -> [Name] -> UniqSet Name
forall a b. (a -> b) -> a -> b
$ UniqSet Name -> [Name]
forall elt. UniqSet elt -> [elt]
Ghc.nonDetEltsUniqSet XPSB (GhcPass 'Renamed) (GhcPass 'Renamed)
UniqSet Name
psb_ext
| Bool
otherwise = XPSB (GhcPass 'Renamed) (GhcPass 'Renamed)
UniqSet Name
psb_ext
HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
-> HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ XPatSynBind (GhcPass 'Renamed) (GhcPass 'Renamed)
-> PatSynBind (GhcPass 'Renamed) (GhcPass 'Renamed)
-> HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
forall idL idR.
XPatSynBind idL idR -> PatSynBind idL idR -> HsBindLR idL idR
Ghc.PatSynBind XPatSynBind (GhcPass 'Renamed) (GhcPass 'Renamed)
x Ghc.PSB { psb_def :: LPat (GhcPass 'Renamed)
psb_def = GenLocated SrcSpanAnnA (Pat (GhcPass 'Renamed))
LPat (GhcPass 'Renamed)
defRes, psb_ext :: XPSB (GhcPass 'Renamed) (GhcPass 'Renamed)
psb_ext = XPSB (GhcPass 'Renamed) (GhcPass 'Renamed)
UniqSet Name
rhsVars, LIdP (GhcPass 'Renamed)
HsPatSynDir (GhcPass 'Renamed)
HsPatSynDetails (GhcPass 'Renamed)
psb_id :: LIdP (GhcPass 'Renamed)
psb_args :: HsPatSynDetails (GhcPass 'Renamed)
psb_dir :: HsPatSynDir (GhcPass 'Renamed)
psb_args :: HsPatSynDetails (GhcPass 'Renamed)
psb_dir :: HsPatSynDir (GhcPass 'Renamed)
psb_id :: LIdP (GhcPass 'Renamed)
.. }
#if !MIN_VERSION_ghc(9,4,0)
other -> pure other
#endif
grhsCase :: Ghc.GRHS Ghc.GhcRn (Ghc.LHsExpr Ghc.GhcRn)
-> EnvReader (Maybe (Ghc.GRHS Ghc.GhcRn (Ghc.LHsExpr Ghc.GhcRn)))
grhsCase :: GRHS (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
-> EnvReader
(Maybe (GRHS (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))))
grhsCase (Ghc.GRHS XCGRHS (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
x [GuardLStmt (GhcPass 'Renamed)]
guards LHsExpr (GhcPass 'Renamed)
body) = do
([GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
guardsRes, VarSet
names) <- WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
([GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
VarSet)
forall w (m :: * -> *) a. Monoid w => WriterT w m a -> m (a, w)
runWriterT (WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
([GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
VarSet))
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
([GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
VarSet)
forall a b. (a -> b) -> a -> b
$ [LStmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))]
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
[LStmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))]
forall body.
(Data body, Data (Stmt (GhcPass 'Renamed) body)) =>
[LStmt (GhcPass 'Renamed) body]
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
[LStmt (GhcPass 'Renamed) body]
dealWithStatements [LStmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))]
[GuardLStmt (GhcPass 'Renamed)]
guards
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
bodyRes <- VarSet
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall a. VarSet -> EnvReader a -> EnvReader a
addScopedVars VarSet
names (WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall a. Data a => a -> EnvReader a
recurse GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
LHsExpr (GhcPass 'Renamed)
body
Maybe
(GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> EnvReader
(Maybe
(GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe
(GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> EnvReader
(Maybe
(GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))))
-> (GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> Maybe
(GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
-> GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader
(Maybe
(GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> Maybe
(GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
forall a. a -> Maybe a
Just (GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader
(Maybe
(GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))))
-> GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> EnvReader
(Maybe
(GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
forall a b. (a -> b) -> a -> b
$ XCGRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> [GuardLStmt (GhcPass 'Renamed)]
-> GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> GRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall p body.
XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
Ghc.GRHS XCGRHS
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
XCGRHS (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
x [GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
[GuardLStmt (GhcPass 'Renamed)]
guardsRes GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
bodyRes
#if !MIN_VERSION_ghc(9,0,0)
grhsCase _ = pure Nothing
#endif
hsLetCase :: Ghc.HsExpr Ghc.GhcRn
-> EnvReader (Maybe (Ghc.HsExpr Ghc.GhcRn))
hsLetCase :: HsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
hsLetCase (Ghc.HsLet' XLet (GhcPass 'Renamed)
x LetToken
letToken (Ghc.L SrcSpan
loc HsLocalBinds (GhcPass 'Renamed)
localBinds) InToken
inToken LHsExpr (GhcPass 'Renamed)
inExpr) = do
(HsLocalBinds (GhcPass 'Renamed)
bindsRes, VarSet
names) <- HsLocalBinds (GhcPass 'Renamed)
-> EnvReader (HsLocalBinds (GhcPass 'Renamed), VarSet)
dealWithLocalBinds HsLocalBinds (GhcPass 'Renamed)
localBinds
GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
inExprRes <- VarSet
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall a. VarSet -> EnvReader a -> EnvReader a
addScopedVars VarSet
names (WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall a b. (a -> b) -> a -> b
$ GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))
forall a. Data a => a -> EnvReader a
recurse GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
LHsExpr (GhcPass 'Renamed)
inExpr
Maybe (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed))))
-> (HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed)))
-> HsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed))
forall a. a -> Maybe a
Just (HsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed))))
-> HsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall a b. (a -> b) -> a -> b
$
XLet (GhcPass 'Renamed)
-> LetToken
-> GenLocated SrcSpan (HsLocalBinds (GhcPass 'Renamed))
-> InToken
-> LHsExpr (GhcPass 'Renamed)
-> HsExpr (GhcPass 'Renamed)
Ghc.HsLet' XLet (GhcPass 'Renamed)
x LetToken
letToken (SrcSpan
-> HsLocalBinds (GhcPass 'Renamed)
-> GenLocated SrcSpan (HsLocalBinds (GhcPass 'Renamed))
forall l e. l -> e -> GenLocated l e
Ghc.L SrcSpan
loc HsLocalBinds (GhcPass 'Renamed)
bindsRes) InToken
inToken GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))
LHsExpr (GhcPass 'Renamed)
inExprRes
hsLetCase HsExpr (GhcPass 'Renamed)
_ = Maybe (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (HsExpr (GhcPass 'Renamed))
forall a. Maybe a
Nothing
dealWithLocalBinds
:: Ghc.HsLocalBinds Ghc.GhcRn
-> EnvReader (Ghc.HsLocalBinds Ghc.GhcRn, VarSet)
dealWithLocalBinds :: HsLocalBinds (GhcPass 'Renamed)
-> EnvReader (HsLocalBinds (GhcPass 'Renamed), VarSet)
dealWithLocalBinds = \case
hlb :: HsLocalBinds (GhcPass 'Renamed)
hlb@(Ghc.HsValBinds XHsValBinds (GhcPass 'Renamed) (GhcPass 'Renamed)
x HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
valBinds) -> case HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
valBinds of
Ghc.ValBinds{} -> (HsLocalBinds (GhcPass 'Renamed), VarSet)
-> EnvReader (HsLocalBinds (GhcPass 'Renamed), VarSet)
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsLocalBinds (GhcPass 'Renamed)
hlb, VarSet
forall a. Monoid a => a
mempty)
Ghc.XValBindsLR (Ghc.NValBinds [(RecFlag, LHsBinds (GhcPass 'Renamed))]
bindPairs [LSig (GhcPass 'Renamed)]
sigs) -> do
let binds :: [LHsBind (GhcPass 'Renamed)]
binds = Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
-> [GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
-> [LHsBind (GhcPass 'Renamed)]
forall a. Bag a -> [a]
Ghc.bagToList
(Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
-> [LHsBind (GhcPass 'Renamed)])
-> ([Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))]
-> Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))))
-> [Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))]
-> [LHsBind (GhcPass 'Renamed)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))]
-> Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
forall a. [Bag a] -> Bag a
Ghc.unionManyBags
([Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))]
-> [LHsBind (GhcPass 'Renamed)])
-> [Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))]
-> [LHsBind (GhcPass 'Renamed)]
forall a b. (a -> b) -> a -> b
$ ((RecFlag,
Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))))
-> Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))))
-> [(RecFlag,
Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))))]
-> [Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))]
forall a b. (a -> b) -> [a] -> [b]
map (RecFlag,
Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))))
-> Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))
forall a b. (a, b) -> b
snd [(RecFlag,
Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))))]
[(RecFlag, LHsBinds (GhcPass 'Renamed))]
bindPairs :: [Ghc.LHsBind Ghc.GhcRn]
names :: [[Name]]
names = (GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
-> [Name])
-> [GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
-> [[Name]]
forall a b. (a -> b) -> [a] -> [b]
map ((HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed) -> [Name])
-> GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
-> [Name]
forall m a. Monoid m => (a -> m) -> GenLocated SrcSpanAnnA a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed) -> [Name]
forall idR. HsBindLR (GhcPass 'Renamed) idR -> [Name]
Ghc.collectHsBindBinders')
[GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
[LHsBind (GhcPass 'Renamed)]
binds
resultNames :: VarSet
resultNames = [Name] -> VarSet
mkVarSet ([Name] -> VarSet) -> [Name] -> VarSet
forall a b. (a -> b) -> a -> b
$ [[Name]] -> [Name]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [[Name]]
names
([(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name])]
resBindsWithNames, Any Bool
containsTarget)
<- WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
[(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name])]
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
([(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name])],
Any)
forall w (m :: * -> *) a.
(Monoid w, Monad m) =>
WriterT w m a -> WriterT w m (a, w)
listen
(WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
[(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name])]
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
([(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name])],
Any))
-> (WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
[GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
[(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name])])
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
[GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
([(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name])],
Any)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
-> [(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name])])
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
[GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
[(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name])]
forall a b.
(a -> b)
-> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
-> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
-> [[Name]]
-> [(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name])]
forall a b. [a] -> [b] -> [(a, b)]
`zip` [[Name]]
names)
(WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
[GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
([(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name])],
Any))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
[GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
([(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name])],
Any)
forall a b. (a -> b) -> a -> b
$ (GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))))
-> [GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
[GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (VarSet
-> LHsBind (GhcPass 'Renamed)
-> EnvReader (LHsBind (GhcPass 'Renamed))
dealWithBind VarSet
resultNames) [GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))]
[LHsBind (GhcPass 'Renamed)]
binds
if Bool -> Bool
not Bool
containsTarget
then (HsLocalBinds (GhcPass 'Renamed), VarSet)
-> EnvReader (HsLocalBinds (GhcPass 'Renamed), VarSet)
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsLocalBinds (GhcPass 'Renamed)
hlb, VarSet
resultNames)
else do
let mkTuple :: (t (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)), b)
-> (t (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)), b,
UniqSet Name)
mkTuple (t (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
bind, b
ns)
= (t (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
bind, b
ns, (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed) -> UniqSet Name)
-> t (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
-> UniqSet Name
forall m a. Monoid m => (a -> m) -> t a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed) -> UniqSet Name
getRhsFreeVars t (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
bind)
finalResult :: [(RecFlag, LHsBinds (GhcPass 'Renamed))]
finalResult = [(LHsBind (GhcPass 'Renamed), [Name], UniqSet Name)]
-> [(RecFlag, LHsBinds (GhcPass 'Renamed))]
depAnalBinds ([(LHsBind (GhcPass 'Renamed), [Name], UniqSet Name)]
-> [(RecFlag, LHsBinds (GhcPass 'Renamed))])
-> [(LHsBind (GhcPass 'Renamed), [Name], UniqSet Name)]
-> [(RecFlag, LHsBinds (GhcPass 'Renamed))]
forall a b. (a -> b) -> a -> b
$ (GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name])
-> (GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name], UniqSet Name)
forall {t :: * -> *} {b}.
Foldable t =>
(t (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)), b)
-> (t (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)), b,
UniqSet Name)
mkTuple ((GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name])
-> (GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name], UniqSet Name))
-> [(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name])]
-> [(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name], UniqSet Name)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name])]
resBindsWithNames
(HsLocalBinds (GhcPass 'Renamed), VarSet)
-> EnvReader (HsLocalBinds (GhcPass 'Renamed), VarSet)
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ( XHsValBinds (GhcPass 'Renamed) (GhcPass 'Renamed)
-> HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
-> HsLocalBinds (GhcPass 'Renamed)
forall idL idR.
XHsValBinds idL idR
-> HsValBindsLR idL idR -> HsLocalBindsLR idL idR
Ghc.HsValBinds XHsValBinds (GhcPass 'Renamed) (GhcPass 'Renamed)
x
(HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
-> HsLocalBinds (GhcPass 'Renamed))
-> HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
-> HsLocalBinds (GhcPass 'Renamed)
forall a b. (a -> b) -> a -> b
$ XXValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
-> HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
forall idL idR. XXValBindsLR idL idR -> HsValBindsLR idL idR
Ghc.XValBindsLR
(XXValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
-> HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed))
-> XXValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
-> HsValBindsLR (GhcPass 'Renamed) (GhcPass 'Renamed)
forall a b. (a -> b) -> a -> b
$ [(RecFlag, LHsBinds (GhcPass 'Renamed))]
-> [LSig (GhcPass 'Renamed)] -> NHsValBindsLR (GhcPass 'Renamed)
forall idL.
[(RecFlag, LHsBinds idL)]
-> [LSig (GhcPass 'Renamed)] -> NHsValBindsLR idL
Ghc.NValBinds [(RecFlag, LHsBinds (GhcPass 'Renamed))]
finalResult [LSig (GhcPass 'Renamed)]
sigs
, VarSet
resultNames
)
x :: HsLocalBinds (GhcPass 'Renamed)
x@(Ghc.HsIPBinds XHsIPBinds (GhcPass 'Renamed) (GhcPass 'Renamed)
_ HsIPBinds (GhcPass 'Renamed)
_) -> (HsLocalBinds (GhcPass 'Renamed), VarSet)
-> EnvReader (HsLocalBinds (GhcPass 'Renamed), VarSet)
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsLocalBinds (GhcPass 'Renamed)
x, VarSet
forall a. Monoid a => a
mempty)
HsLocalBinds (GhcPass 'Renamed)
other -> (HsLocalBinds (GhcPass 'Renamed), VarSet)
-> EnvReader (HsLocalBinds (GhcPass 'Renamed), VarSet)
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsLocalBinds (GhcPass 'Renamed)
other, VarSet
forall a. Monoid a => a
mempty)
getRhsFreeVars :: Ghc.HsBind Ghc.GhcRn -> Ghc.UniqSet Ghc.Name
getRhsFreeVars :: HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed) -> UniqSet Name
getRhsFreeVars = \case
Ghc.FunBind {[CoreTickish]
LIdP (GhcPass 'Renamed)
MatchGroup (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
XFunBind (GhcPass 'Renamed) (GhcPass 'Renamed)
fun_ext :: forall idL idR. HsBindLR idL idR -> XFunBind idL idR
fun_id :: forall idL idR. HsBindLR idL idR -> LIdP idL
fun_matches :: forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
fun_tick :: forall idL idR. HsBindLR idL idR -> [CoreTickish]
fun_ext :: XFunBind (GhcPass 'Renamed) (GhcPass 'Renamed)
fun_id :: LIdP (GhcPass 'Renamed)
fun_matches :: MatchGroup (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
fun_tick :: [CoreTickish]
..} -> XFunBind (GhcPass 'Renamed) (GhcPass 'Renamed)
UniqSet Name
fun_ext
Ghc.PatBind {([CoreTickish], [[CoreTickish]])
LPat (GhcPass 'Renamed)
GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
XPatBind (GhcPass 'Renamed) (GhcPass 'Renamed)
pat_ext :: forall idL idR. HsBindLR idL idR -> XPatBind idL idR
pat_lhs :: forall idL idR. HsBindLR idL idR -> LPat idL
pat_rhs :: forall idL idR. HsBindLR idL idR -> GRHSs idR (LHsExpr idR)
pat_ticks :: forall idL idR.
HsBindLR idL idR -> ([CoreTickish], [[CoreTickish]])
pat_ext :: XPatBind (GhcPass 'Renamed) (GhcPass 'Renamed)
pat_lhs :: LPat (GhcPass 'Renamed)
pat_rhs :: GRHSs (GhcPass 'Renamed) (LHsExpr (GhcPass 'Renamed))
pat_ticks :: ([CoreTickish], [[CoreTickish]])
..} -> XPatBind (GhcPass 'Renamed) (GhcPass 'Renamed)
UniqSet Name
pat_ext
Ghc.PatSynBind XPatSynBind (GhcPass 'Renamed) (GhcPass 'Renamed)
_ Ghc.PSB {LIdP (GhcPass 'Renamed)
LPat (GhcPass 'Renamed)
HsPatSynDir (GhcPass 'Renamed)
XPSB (GhcPass 'Renamed) (GhcPass 'Renamed)
HsPatSynDetails (GhcPass 'Renamed)
psb_args :: forall idL idR. PatSynBind idL idR -> HsPatSynDetails idR
psb_def :: forall idL idR. PatSynBind idL idR -> LPat idR
psb_dir :: forall idL idR. PatSynBind idL idR -> HsPatSynDir idR
psb_ext :: forall idL idR. PatSynBind idL idR -> XPSB idL idR
psb_id :: forall idL idR. PatSynBind idL idR -> LIdP idL
psb_ext :: XPSB (GhcPass 'Renamed) (GhcPass 'Renamed)
psb_id :: LIdP (GhcPass 'Renamed)
psb_args :: HsPatSynDetails (GhcPass 'Renamed)
psb_def :: LPat (GhcPass 'Renamed)
psb_dir :: HsPatSynDir (GhcPass 'Renamed)
..} -> XPSB (GhcPass 'Renamed) (GhcPass 'Renamed)
UniqSet Name
psb_ext
HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)
_ -> UniqSet Name
forall a. Monoid a => a
mempty
hsDoCase :: Ghc.HsExpr Ghc.GhcRn
-> EnvReader (Maybe (Ghc.HsExpr Ghc.GhcRn))
hsDoCase :: HsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
hsDoCase (Ghc.HsDo XDo (GhcPass 'Renamed)
x HsDoFlavour
ctx XRec (GhcPass 'Renamed) [GuardLStmt (GhcPass 'Renamed)]
lStmts) = do
(GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
stmtsRes, VarSet
_) <- WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))])
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
VarSet)
forall w (m :: * -> *) a. Monoid w => WriterT w m a -> m (a, w)
runWriterT (WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))])
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
VarSet))
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))])
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
VarSet)
forall a b. (a -> b) -> a -> b
$ GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> ([GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
[GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))])
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
XRec (GhcPass 'Renamed) [GuardLStmt (GhcPass 'Renamed)]
lStmts [GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
[GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
[LStmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))]
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
[LStmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))]
forall body.
(Data body, Data (Stmt (GhcPass 'Renamed) body)) =>
[LStmt (GhcPass 'Renamed) body]
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
[LStmt (GhcPass 'Renamed) body]
dealWithStatements
Maybe (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed))))
-> (HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed)))
-> HsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HsExpr (GhcPass 'Renamed) -> Maybe (HsExpr (GhcPass 'Renamed))
forall a. a -> Maybe a
Just (HsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed))))
-> HsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall a b. (a -> b) -> a -> b
$ XDo (GhcPass 'Renamed)
-> HsDoFlavour
-> XRec (GhcPass 'Renamed) [GuardLStmt (GhcPass 'Renamed)]
-> HsExpr (GhcPass 'Renamed)
forall p. XDo p -> HsDoFlavour -> XRec p [ExprLStmt p] -> HsExpr p
Ghc.HsDo XDo (GhcPass 'Renamed)
x HsDoFlavour
ctx GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
XRec (GhcPass 'Renamed) [GuardLStmt (GhcPass 'Renamed)]
stmtsRes
hsDoCase HsExpr (GhcPass 'Renamed)
_ = Maybe (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (HsExpr (GhcPass 'Renamed))
forall a. Maybe a
Nothing
dealWithStatements
:: (Data body, Data (Ghc.Stmt Ghc.GhcRn body))
=> [Ghc.LStmt Ghc.GhcRn body]
-> WriterT VarSet EnvReader [Ghc.LStmt Ghc.GhcRn body]
dealWithStatements :: forall body.
(Data body, Data (Stmt (GhcPass 'Renamed) body)) =>
[LStmt (GhcPass 'Renamed) body]
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
[LStmt (GhcPass 'Renamed) body]
dealWithStatements [] = [GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body)]
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
[GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body)]
forall a.
a
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
dealWithStatements (LStmt (GhcPass 'Renamed) body
lstmt : [LStmt (GhcPass 'Renamed) body]
xs) = do
(GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body)
stmtRes, VarSet
names) <- WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body))
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body),
VarSet)
forall w (m :: * -> *) a.
(Monoid w, Monad m) =>
WriterT w m a -> WriterT w m (a, w)
listen (WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body))
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body),
VarSet))
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body))
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body),
VarSet)
forall a b. (a -> b) -> a -> b
$ (Stmt (GhcPass 'Renamed) body
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(Stmt (GhcPass 'Renamed) body))
-> GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body)
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b)
-> GenLocated (Anno (Stmt (GhcPass 'Renamed) body)) a
-> f (GenLocated (Anno (Stmt (GhcPass 'Renamed) body)) b)
traverse Stmt (GhcPass 'Renamed) body
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(Stmt (GhcPass 'Renamed) body)
forall body.
(Data (Stmt (GhcPass 'Renamed) body), Data body) =>
Stmt (GhcPass 'Renamed) body
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(Stmt (GhcPass 'Renamed) body)
dealWithStmt GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body)
LStmt (GhcPass 'Renamed) body
lstmt
(GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body)
stmtRes GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body)
-> [GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body)]
-> [GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body)]
forall a. a -> [a] -> [a]
:) ([GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body)]
-> [GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body)])
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
[GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body)]
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
[GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
([GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body)],
VarSet)
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
([GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body)],
VarSet))
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
[GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body)]
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
[GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body)]
forall (n :: * -> *) w w' (m :: * -> *) a b.
(Monad n, Monoid w, Monoid w') =>
(m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
mapWriterT (VarSet
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
([GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body)],
VarSet)
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
([GenLocated
(Anno (Stmt (GhcPass 'Renamed) body))
(Stmt (GhcPass 'Renamed) body)],
VarSet)
forall a. VarSet -> EnvReader a -> EnvReader a
addScopedVars VarSet
names) ([LStmt (GhcPass 'Renamed) body]
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
[LStmt (GhcPass 'Renamed) body]
forall body.
(Data body, Data (Stmt (GhcPass 'Renamed) body)) =>
[LStmt (GhcPass 'Renamed) body]
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
[LStmt (GhcPass 'Renamed) body]
dealWithStatements [LStmt (GhcPass 'Renamed) body]
xs)
dealWithStmt :: (Data (Ghc.Stmt Ghc.GhcRn body), Data body)
=> Ghc.Stmt Ghc.GhcRn body
-> WriterT VarSet EnvReader (Ghc.Stmt Ghc.GhcRn body)
dealWithStmt :: forall body.
(Data (Stmt (GhcPass 'Renamed) body), Data body) =>
Stmt (GhcPass 'Renamed) body
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(Stmt (GhcPass 'Renamed) body)
dealWithStmt = \case
Ghc.BindStmt' XBindStmt (GhcPass 'Renamed) (GhcPass 'Renamed) body
x LPat (GhcPass 'Renamed)
lpat body
body SyntaxExpr (GhcPass 'Renamed)
bindExpr SyntaxExpr (GhcPass 'Renamed)
failExpr -> do
let names :: VarSet
names = LPat (GhcPass 'Renamed) -> VarSet
extractVarPats LPat (GhcPass 'Renamed)
lpat
VarSet
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell VarSet
names
body
bodyRes <- EnvReader body
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
body
forall (m :: * -> *) a. Monad m => m a -> WriterT VarSet m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (EnvReader body
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
body)
-> EnvReader body
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
body
forall a b. (a -> b) -> a -> b
$ body -> EnvReader body
forall a. Data a => a -> EnvReader a
recurse body
body
Stmt (GhcPass 'Renamed) body
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(Stmt (GhcPass 'Renamed) body)
forall a.
a
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Stmt (GhcPass 'Renamed) body
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(Stmt (GhcPass 'Renamed) body))
-> Stmt (GhcPass 'Renamed) body
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(Stmt (GhcPass 'Renamed) body)
forall a b. (a -> b) -> a -> b
$ XBindStmt (GhcPass 'Renamed) (GhcPass 'Renamed) body
-> LPat (GhcPass 'Renamed)
-> body
-> SyntaxExpr (GhcPass 'Renamed)
-> SyntaxExpr (GhcPass 'Renamed)
-> Stmt (GhcPass 'Renamed) body
forall body.
XBindStmt (GhcPass 'Renamed) (GhcPass 'Renamed) body
-> LPat (GhcPass 'Renamed)
-> body
-> SyntaxExpr (GhcPass 'Renamed)
-> SyntaxExpr (GhcPass 'Renamed)
-> Stmt (GhcPass 'Renamed) body
Ghc.BindStmt' XBindStmt (GhcPass 'Renamed) (GhcPass 'Renamed) body
x LPat (GhcPass 'Renamed)
lpat body
bodyRes SyntaxExpr (GhcPass 'Renamed)
bindExpr SyntaxExpr (GhcPass 'Renamed)
failExpr
Ghc.LetStmt' XLetStmt (GhcPass 'Renamed) (GhcPass 'Renamed) body
x (Ghc.L SrcSpan
loc HsLocalBinds (GhcPass 'Renamed)
localBinds) -> do
(HsLocalBinds (GhcPass 'Renamed)
bindsRes, VarSet
names) <- EnvReader (HsLocalBinds (GhcPass 'Renamed), VarSet)
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(HsLocalBinds (GhcPass 'Renamed), VarSet)
forall (m :: * -> *) a. Monad m => m a -> WriterT VarSet m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (EnvReader (HsLocalBinds (GhcPass 'Renamed), VarSet)
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(HsLocalBinds (GhcPass 'Renamed), VarSet))
-> EnvReader (HsLocalBinds (GhcPass 'Renamed), VarSet)
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(HsLocalBinds (GhcPass 'Renamed), VarSet)
forall a b. (a -> b) -> a -> b
$ HsLocalBinds (GhcPass 'Renamed)
-> EnvReader (HsLocalBinds (GhcPass 'Renamed), VarSet)
dealWithLocalBinds HsLocalBinds (GhcPass 'Renamed)
localBinds
VarSet
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell VarSet
names
Stmt (GhcPass 'Renamed) body
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(Stmt (GhcPass 'Renamed) body)
forall a.
a
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Stmt (GhcPass 'Renamed) body
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(Stmt (GhcPass 'Renamed) body))
-> Stmt (GhcPass 'Renamed) body
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(Stmt (GhcPass 'Renamed) body)
forall a b. (a -> b) -> a -> b
$ XLetStmt (GhcPass 'Renamed) (GhcPass 'Renamed) body
-> GenLocated SrcSpan (HsLocalBinds (GhcPass 'Renamed))
-> Stmt (GhcPass 'Renamed) body
forall body.
XLetStmt (GhcPass 'Renamed) (GhcPass 'Renamed) body
-> GenLocated SrcSpan (HsLocalBinds (GhcPass 'Renamed))
-> StmtLR (GhcPass 'Renamed) (GhcPass 'Renamed) body
Ghc.LetStmt' XLetStmt (GhcPass 'Renamed) (GhcPass 'Renamed) body
x (SrcSpan
-> HsLocalBinds (GhcPass 'Renamed)
-> GenLocated SrcSpan (HsLocalBinds (GhcPass 'Renamed))
forall l e. l -> e -> GenLocated l e
Ghc.L SrcSpan
loc HsLocalBinds (GhcPass 'Renamed)
bindsRes)
Ghc.ApplicativeStmt XApplicativeStmt (GhcPass 'Renamed) (GhcPass 'Renamed) body
x [(SyntaxExpr (GhcPass 'Renamed),
ApplicativeArg (GhcPass 'Renamed))]
pairs Maybe (SyntaxExpr (GhcPass 'Renamed))
mbJoin -> do
let dealWithAppArg :: ApplicativeArg (GhcPass 'Renamed)
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(ApplicativeArg (GhcPass 'Renamed))
dealWithAppArg = \case
a :: ApplicativeArg (GhcPass 'Renamed)
a@Ghc.ApplicativeArgOne{Bool
LHsExpr (GhcPass 'Renamed)
LPat (GhcPass 'Renamed)
XApplicativeArgOne (GhcPass 'Renamed)
xarg_app_arg_one :: XApplicativeArgOne (GhcPass 'Renamed)
app_arg_pattern :: LPat (GhcPass 'Renamed)
arg_expr :: LHsExpr (GhcPass 'Renamed)
is_body_stmt :: Bool
app_arg_pattern :: forall idL. ApplicativeArg idL -> LPat idL
arg_expr :: forall idL. ApplicativeArg idL -> LHsExpr idL
is_body_stmt :: forall idL. ApplicativeArg idL -> Bool
xarg_app_arg_one :: forall idL. ApplicativeArg idL -> XApplicativeArgOne idL
..} -> do
VarSet
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell (VarSet
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
())
-> VarSet
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
()
forall a b. (a -> b) -> a -> b
$ LPat (GhcPass 'Renamed) -> VarSet
extractVarPats LPat (GhcPass 'Renamed)
app_arg_pattern
ApplicativeArg (GhcPass 'Renamed)
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(ApplicativeArg (GhcPass 'Renamed))
forall a.
a
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ApplicativeArg (GhcPass 'Renamed)
a
a :: ApplicativeArg (GhcPass 'Renamed)
a@Ghc.ApplicativeArgMany{[GuardLStmt (GhcPass 'Renamed)]
HsExpr (GhcPass 'Renamed)
LPat (GhcPass 'Renamed)
HsDoFlavour
XApplicativeArgMany (GhcPass 'Renamed)
xarg_app_arg_many :: XApplicativeArgMany (GhcPass 'Renamed)
app_stmts :: [GuardLStmt (GhcPass 'Renamed)]
final_expr :: HsExpr (GhcPass 'Renamed)
bv_pattern :: LPat (GhcPass 'Renamed)
stmt_context :: HsDoFlavour
app_stmts :: forall idL. ApplicativeArg idL -> [ExprLStmt idL]
bv_pattern :: forall idL. ApplicativeArg idL -> LPat idL
final_expr :: forall idL. ApplicativeArg idL -> HsExpr idL
stmt_context :: forall idL. ApplicativeArg idL -> HsDoFlavour
xarg_app_arg_many :: forall idL. ApplicativeArg idL -> XApplicativeArgMany idL
..} -> do
VarSet
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell (VarSet
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
())
-> VarSet
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
()
forall a b. (a -> b) -> a -> b
$ LPat (GhcPass 'Renamed) -> VarSet
extractVarPats LPat (GhcPass 'Renamed)
bv_pattern
([GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
stmtsRes, VarSet
_) <- WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
([GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
VarSet)
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
([GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
VarSet)
forall (m :: * -> *) a. Monad m => m a -> WriterT VarSet m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
([GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
VarSet)
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
([GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
VarSet))
-> (WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
([GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
VarSet))
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
([GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
VarSet)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
([GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
VarSet)
forall w (m :: * -> *) a. Monoid w => WriterT w m a -> m (a, w)
runWriterT (WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
([GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
VarSet))
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
([GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))],
VarSet)
forall a b. (a -> b) -> a -> b
$ [LStmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))]
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
[LStmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))]
forall body.
(Data body, Data (Stmt (GhcPass 'Renamed) body)) =>
[LStmt (GhcPass 'Renamed) body]
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
[LStmt (GhcPass 'Renamed) body]
dealWithStatements [LStmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))]
[GuardLStmt (GhcPass 'Renamed)]
app_stmts
ApplicativeArg (GhcPass 'Renamed)
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(ApplicativeArg (GhcPass 'Renamed))
forall a.
a
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ApplicativeArg (GhcPass 'Renamed)
a {app_stmts :: [GuardLStmt (GhcPass 'Renamed)]
Ghc.app_stmts = [GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsExpr (GhcPass 'Renamed))))]
[GuardLStmt (GhcPass 'Renamed)]
stmtsRes}
#if !MIN_VERSION_ghc(9,0,0)
a -> lift $ gmapM recurse a
#endif
[(SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))]
pairsRes <- (((SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed)))
-> [(SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))]
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
[(SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (((SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed)))
-> [(SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))]
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
[(SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))])
-> ((ApplicativeArg (GhcPass 'Renamed)
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(ApplicativeArg (GhcPass 'Renamed)))
-> (SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed)))
-> (ApplicativeArg (GhcPass 'Renamed)
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(ApplicativeArg (GhcPass 'Renamed)))
-> [(SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))]
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
[(SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ApplicativeArg (GhcPass 'Renamed)
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(ApplicativeArg (GhcPass 'Renamed)))
-> (SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> (SyntaxExprRn, a) -> f (SyntaxExprRn, b)
traverse) ApplicativeArg (GhcPass 'Renamed)
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(ApplicativeArg (GhcPass 'Renamed))
dealWithAppArg [(SyntaxExpr (GhcPass 'Renamed),
ApplicativeArg (GhcPass 'Renamed))]
[(SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))]
pairs
Stmt (GhcPass 'Renamed) body
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(Stmt (GhcPass 'Renamed) body)
forall a.
a
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Stmt (GhcPass 'Renamed) body
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(Stmt (GhcPass 'Renamed) body))
-> Stmt (GhcPass 'Renamed) body
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(Stmt (GhcPass 'Renamed) body)
forall a b. (a -> b) -> a -> b
$ XApplicativeStmt (GhcPass 'Renamed) (GhcPass 'Renamed) body
-> [(SyntaxExpr (GhcPass 'Renamed),
ApplicativeArg (GhcPass 'Renamed))]
-> Maybe (SyntaxExpr (GhcPass 'Renamed))
-> Stmt (GhcPass 'Renamed) body
forall idL idR body.
XApplicativeStmt idL idR body
-> [(SyntaxExpr idR, ApplicativeArg idL)]
-> Maybe (SyntaxExpr idR)
-> StmtLR idL idR body
Ghc.ApplicativeStmt XApplicativeStmt (GhcPass 'Renamed) (GhcPass 'Renamed) body
x [(SyntaxExpr (GhcPass 'Renamed),
ApplicativeArg (GhcPass 'Renamed))]
[(SyntaxExprRn, ApplicativeArg (GhcPass 'Renamed))]
pairsRes Maybe (SyntaxExpr (GhcPass 'Renamed))
mbJoin
Stmt (GhcPass 'Renamed) body
other -> EnvReader (Stmt (GhcPass 'Renamed) body)
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(Stmt (GhcPass 'Renamed) body)
forall (m :: * -> *) a. Monad m => m a -> WriterT VarSet m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (EnvReader (Stmt (GhcPass 'Renamed) body)
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(Stmt (GhcPass 'Renamed) body))
-> EnvReader (Stmt (GhcPass 'Renamed) body)
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(Stmt (GhcPass 'Renamed) body)
forall a b. (a -> b) -> a -> b
$ (forall a. Data a => a -> EnvReader a)
-> Stmt (GhcPass 'Renamed) body
-> EnvReader (Stmt (GhcPass 'Renamed) body)
forall a (m :: * -> *).
(Data a, Monad m) =>
(forall d. Data d => d -> m d) -> a -> m a
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> Stmt (GhcPass 'Renamed) body -> m (Stmt (GhcPass 'Renamed) body)
gmapM d -> EnvReader d
forall a. Data a => a -> EnvReader a
recurse Stmt (GhcPass 'Renamed) body
other
hsProcCase :: Ghc.HsExpr Ghc.GhcRn
-> EnvReader (Maybe (Ghc.HsExpr Ghc.GhcRn))
hsProcCase :: HsExpr (GhcPass 'Renamed)
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
hsProcCase (Ghc.HsProc XProc (GhcPass 'Renamed)
x1 LPat (GhcPass 'Renamed)
lpat LHsCmdTop (GhcPass 'Renamed)
cmdTop) = do
let inputNames :: VarSet
inputNames = LPat (GhcPass 'Renamed) -> VarSet
extractVarPats LPat (GhcPass 'Renamed)
lpat
MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall (m :: * -> *) a. MaybeT m a -> m (Maybe a)
runMaybeT (MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed))))
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall a b. (a -> b) -> a -> b
$ do
GenLocated (SrcAnn NoEpAnns) (HsCmdTop (GhcPass 'Renamed))
cmdTopRes <- GenLocated (SrcAnn NoEpAnns) (HsCmdTop (GhcPass 'Renamed))
-> (HsCmdTop (GhcPass 'Renamed)
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(HsCmdTop (GhcPass 'Renamed)))
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(GenLocated (SrcAnn NoEpAnns) (HsCmdTop (GhcPass 'Renamed)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for GenLocated (SrcAnn NoEpAnns) (HsCmdTop (GhcPass 'Renamed))
LHsCmdTop (GhcPass 'Renamed)
cmdTop ((HsCmdTop (GhcPass 'Renamed)
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(HsCmdTop (GhcPass 'Renamed)))
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(GenLocated (SrcAnn NoEpAnns) (HsCmdTop (GhcPass 'Renamed))))
-> (HsCmdTop (GhcPass 'Renamed)
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(HsCmdTop (GhcPass 'Renamed)))
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(GenLocated (SrcAnn NoEpAnns) (HsCmdTop (GhcPass 'Renamed)))
forall a b. (a -> b) -> a -> b
$ \case
Ghc.HsCmdTop XCmdTop (GhcPass 'Renamed)
x2 LHsCmd (GhcPass 'Renamed)
lcmd -> do
GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))
cmdRes <- GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))
-> (HsCmd (GhcPass 'Renamed)
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(HsCmd (GhcPass 'Renamed)))
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))
LHsCmd (GhcPass 'Renamed)
lcmd ((HsCmd (GhcPass 'Renamed)
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(HsCmd (GhcPass 'Renamed)))
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))
-> (HsCmd (GhcPass 'Renamed)
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(HsCmd (GhcPass 'Renamed)))
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))
forall a b. (a -> b) -> a -> b
$ \case
Ghc.HsCmdDo XCmdDo (GhcPass 'Renamed)
x3 XRec (GhcPass 'Renamed) [CmdLStmt (GhcPass 'Renamed)]
lstmts -> do
(GenLocated
SrcSpanAnnL
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
stmtsRes, VarSet
_) <- WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated
SrcSpanAnnL
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
VarSet)
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(GenLocated
SrcSpanAnnL
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
VarSet)
forall (m :: * -> *) a. Monad m => m a -> MaybeT m a
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated
SrcSpanAnnL
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
VarSet)
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(GenLocated
SrcSpanAnnL
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
VarSet))
-> (([GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))])
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated
SrcSpanAnnL
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
VarSet))
-> ([GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))])
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(GenLocated
SrcSpanAnnL
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
VarSet)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(GenLocated
SrcSpanAnnL
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))])
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated
SrcSpanAnnL
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
VarSet)
forall w (m :: * -> *) a. Monoid w => WriterT w m a -> m (a, w)
runWriterT (WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(GenLocated
SrcSpanAnnL
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))])
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated
SrcSpanAnnL
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
VarSet))
-> (([GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))])
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(GenLocated
SrcSpanAnnL
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]))
-> ([GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))])
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
(GenLocated
SrcSpanAnnL
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
VarSet)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
-> ([GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))])
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(GenLocated
SrcSpanAnnL
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))])
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for GenLocated
SrcSpanAnnL
[GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
XRec (GhcPass 'Renamed) [CmdLStmt (GhcPass 'Renamed)]
lstmts (([GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))])
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(GenLocated
SrcSpanAnnL
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
VarSet))
-> ([GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))])
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(GenLocated
SrcSpanAnnL
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
VarSet)
forall a b. (a -> b) -> a -> b
$ \[GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
stmts -> do
VarSet
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
()
forall w (m :: * -> *). (Monoid w, Monad m) => w -> WriterT w m ()
tell VarSet
inputNames
(WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
([GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
VarSet)
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
([GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
VarSet))
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
forall (n :: * -> *) w w' (m :: * -> *) a b.
(Monad n, Monoid w, Monoid w') =>
(m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
mapWriterT (VarSet
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
([GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
VarSet)
-> WriterT
Any
(ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))
([GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))],
VarSet)
forall a. VarSet -> EnvReader a -> EnvReader a
addScopedVars VarSet
inputNames) (WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))])
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
forall a b. (a -> b) -> a -> b
$ [LStmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))]
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
[LStmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))]
forall body.
(Data body, Data (Stmt (GhcPass 'Renamed) body)) =>
[LStmt (GhcPass 'Renamed) body]
-> WriterT
VarSet
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
[LStmt (GhcPass 'Renamed) body]
dealWithStatements [GenLocated
SrcSpanAnnA
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
[LStmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))]
stmts
HsCmd (GhcPass 'Renamed)
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(HsCmd (GhcPass 'Renamed))
forall a.
a
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsCmd (GhcPass 'Renamed)
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(HsCmd (GhcPass 'Renamed)))
-> HsCmd (GhcPass 'Renamed)
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(HsCmd (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ XCmdDo (GhcPass 'Renamed)
-> XRec (GhcPass 'Renamed) [CmdLStmt (GhcPass 'Renamed)]
-> HsCmd (GhcPass 'Renamed)
forall id. XCmdDo id -> XRec id [CmdLStmt id] -> HsCmd id
Ghc.HsCmdDo XCmdDo (GhcPass 'Renamed)
x3 GenLocated
SrcSpanAnnL
[GenLocated
(Anno
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed)))))
(Stmt
(GhcPass 'Renamed)
(GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))))]
XRec (GhcPass 'Renamed) [CmdLStmt (GhcPass 'Renamed)]
stmtsRes
HsCmd (GhcPass 'Renamed)
_ -> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(HsCmd (GhcPass 'Renamed))
forall a.
MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall (f :: * -> *) a. Alternative f => f a
empty
HsCmdTop (GhcPass 'Renamed)
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(HsCmdTop (GhcPass 'Renamed))
forall a.
a
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsCmdTop (GhcPass 'Renamed)
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(HsCmdTop (GhcPass 'Renamed)))
-> HsCmdTop (GhcPass 'Renamed)
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(HsCmdTop (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ XCmdTop (GhcPass 'Renamed)
-> LHsCmd (GhcPass 'Renamed) -> HsCmdTop (GhcPass 'Renamed)
forall p. XCmdTop p -> LHsCmd p -> HsCmdTop p
Ghc.HsCmdTop XCmdTop (GhcPass 'Renamed)
x2 GenLocated SrcSpanAnnA (HsCmd (GhcPass 'Renamed))
LHsCmd (GhcPass 'Renamed)
cmdRes
#if !MIN_VERSION_ghc(9,0,0)
_ -> empty
#endif
HsExpr (GhcPass 'Renamed)
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(HsExpr (GhcPass 'Renamed))
forall a.
a
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (HsExpr (GhcPass 'Renamed)
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(HsExpr (GhcPass 'Renamed)))
-> HsExpr (GhcPass 'Renamed)
-> MaybeT
(WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))))
(HsExpr (GhcPass 'Renamed))
forall a b. (a -> b) -> a -> b
$ XProc (GhcPass 'Renamed)
-> LPat (GhcPass 'Renamed)
-> LHsCmdTop (GhcPass 'Renamed)
-> HsExpr (GhcPass 'Renamed)
forall p. XProc p -> LPat p -> LHsCmdTop p -> HsExpr p
Ghc.HsProc XProc (GhcPass 'Renamed)
x1 LPat (GhcPass 'Renamed)
lpat GenLocated (SrcAnn NoEpAnns) (HsCmdTop (GhcPass 'Renamed))
LHsCmdTop (GhcPass 'Renamed)
cmdTopRes
hsProcCase HsExpr (GhcPass 'Renamed)
_ = Maybe (HsExpr (GhcPass 'Renamed))
-> EnvReader (Maybe (HsExpr (GhcPass 'Renamed)))
forall a.
a -> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (HsExpr (GhcPass 'Renamed))
forall a. Maybe a
Nothing
type EnvReader = WriterT Any (ReaderT Env Ghc.TcM)
type VarSet = M.Map Ghc.LexicalFastString' Ghc.Name
data Env = MkEnv
{ Env -> VarSet
varSet :: !VarSet
, Env -> Name
captureVarsName :: !Ghc.Name
, Env -> Name
showLevName :: !Ghc.Name
, Env -> Name
fromListName :: !Ghc.Name
, Env -> Name
breakpointName :: !Ghc.Name
, Env -> Name
queryVarsName :: !Ghc.Name
, Env -> Name
breakpointMName :: !Ghc.Name
, Env -> Name
queryVarsMName :: !Ghc.Name
, Env -> Name
breakpointIOName :: !Ghc.Name
, Env -> Name
queryVarsIOName :: !Ghc.Name
, Env -> Name
printAndWaitName :: !Ghc.Name
, Env -> Name
printAndWaitMName :: !Ghc.Name
, Env -> Name
printAndWaitIOName :: !Ghc.Name
, Env -> Name
runPromptIOName :: !Ghc.Name
, Env -> Name
runPromptName :: !Ghc.Name
, Env -> Name
runPromptMName :: !Ghc.Name
, Env -> Name
getSrcLocName :: !Ghc.Name
, Env -> Name
excludeVarsName :: !Ghc.Name
}
overVarSet :: (VarSet -> VarSet) -> Env -> Env
overVarSet :: (VarSet -> VarSet) -> Env -> Env
overVarSet VarSet -> VarSet
f Env
env = Env
env { varSet :: VarSet
varSet = VarSet -> VarSet
f (VarSet -> VarSet) -> VarSet -> VarSet
forall a b. (a -> b) -> a -> b
$ Env -> VarSet
varSet Env
env }
getOccNameFS :: Ghc.Name -> Ghc.LexicalFastString'
getOccNameFS :: Name -> LexicalFastString'
getOccNameFS = FastString -> LexicalFastString'
Ghc.mkLexicalFastString (FastString -> LexicalFastString')
-> (Name -> FastString) -> Name -> LexicalFastString'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OccName -> FastString
Ghc.occNameFS (OccName -> FastString) -> (Name -> OccName) -> Name -> FastString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> OccName
forall a. NamedThing a => a -> OccName
Ghc.getOccName
mkVarSet :: [Ghc.Name] -> VarSet
mkVarSet :: [Name] -> VarSet
mkVarSet [Name]
names = [(LexicalFastString', Name)] -> VarSet
forall k v. Ord k => [(k, v)] -> Map k v
M.fromList ([(LexicalFastString', Name)] -> VarSet)
-> [(LexicalFastString', Name)] -> VarSet
forall a b. (a -> b) -> a -> b
$ (Name -> LexicalFastString'
getOccNameFS (Name -> LexicalFastString')
-> (Name -> Name) -> Name -> (LexicalFastString', Name)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Name -> Name
forall a. a -> a
id) (Name -> (LexicalFastString', Name))
-> [Name] -> [(LexicalFastString', Name)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Name]
names
addScopedVars :: VarSet -> EnvReader a -> EnvReader a
addScopedVars :: forall a. VarSet -> EnvReader a -> EnvReader a
addScopedVars VarSet
names = (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)) (a, Any)
-> ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)) (a, Any))
-> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
-> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall (n :: * -> *) w w' (m :: * -> *) a b.
(Monad n, Monoid w, Monoid w') =>
(m (a, w) -> n (b, w')) -> WriterT w m a -> WriterT w' n b
mapWriterT ((ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)) (a, Any)
-> ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)) (a, Any))
-> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
-> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a)
-> (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)) (a, Any)
-> ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)) (a, Any))
-> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
-> WriterT Any (ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv))) a
forall a b. (a -> b) -> a -> b
$ (Env -> Env)
-> ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)) (a, Any)
-> ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)) (a, Any)
forall a.
(Env -> Env)
-> ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)) a
-> ReaderT Env (IOEnv (Env TcGblEnv TcLclEnv)) a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ((VarSet -> VarSet) -> Env -> Env
overVarSet (VarSet
names VarSet -> VarSet -> VarSet
forall a. Semigroup a => a -> a -> a
<>))
depAnalBinds :: [(Ghc.LHsBind Ghc.GhcRn, [Ghc.Name], Ghc.UniqSet Ghc.Name)]
-> [(Ghc.RecFlag, Ghc.LHsBinds Ghc.GhcRn)]
depAnalBinds :: [(LHsBind (GhcPass 'Renamed), [Name], UniqSet Name)]
-> [(RecFlag, LHsBinds (GhcPass 'Renamed))]
depAnalBinds [(LHsBind (GhcPass 'Renamed), [Name], UniqSet Name)]
binds_w_dus
= (SCC
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name], UniqSet Name)
-> (RecFlag,
Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)))))
-> [SCC
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name], UniqSet Name)]
-> [(RecFlag,
Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))))]
forall a b. (a -> b) -> [a] -> [b]
map SCC
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name], UniqSet Name)
-> (RecFlag,
Bag
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))))
forall {a} {b} {c}. SCC (a, b, c) -> (RecFlag, Bag a)
get_binds [SCC
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name], UniqSet Name)]
sccs
where
sccs :: [SCC
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name], UniqSet Name)]
sccs = ((GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name], UniqSet Name)
-> [Name])
-> ((GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name], UniqSet Name)
-> [Name])
-> [(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name], UniqSet Name)]
-> [SCC
(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name], UniqSet Name)]
forall node.
(node -> [Name]) -> (node -> [Name]) -> [node] -> [SCC node]
Ghc.depAnal
(\(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
_, [Name]
defs, UniqSet Name
_) -> [Name]
defs)
(\(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed))
_, [Name]
_, UniqSet Name
uses) -> UniqSet Name -> [Name]
forall elt. UniqSet elt -> [elt]
Ghc.nonDetEltsUniqSet UniqSet Name
uses)
[(GenLocated
SrcSpanAnnA (HsBindLR (GhcPass 'Renamed) (GhcPass 'Renamed)),
[Name], UniqSet Name)]
[(LHsBind (GhcPass 'Renamed), [Name], UniqSet Name)]
binds_w_dus
get_binds :: SCC (a, b, c) -> (RecFlag, Bag a)
get_binds (Graph.AcyclicSCC (a
bind, b
_, c
_)) =
(RecFlag
Ghc.NonRecursive, a -> Bag a
forall a. a -> Bag a
Ghc.unitBag a
bind)
get_binds (Graph.CyclicSCC [(a, b, c)]
binds_w_dus') =
(RecFlag
Ghc.Recursive, [a] -> Bag a
forall a. [a] -> Bag a
Ghc.listToBag [a
b | (a
b,b
_,c
_) <- [(a, b, c)]
binds_w_dus'])
data TcPluginNames =
MkTcPluginNames
{ TcPluginNames -> Name
showLevClassName :: !Ghc.Name
, TcPluginNames -> Class
showClass :: !Ghc.Class
, TcPluginNames -> Class
succeedClass :: !Ghc.Class
, TcPluginNames -> TyCon
showWrapperTyCon :: !Ghc.TyCon
}
tcPlugin :: Ghc.TcPlugin
tcPlugin :: TcPlugin
tcPlugin = Ghc.TcPlugin
{ tcPluginInit :: TcPluginM TcPluginNames
Ghc.tcPluginInit = TcPluginM TcPluginNames
initTcPlugin
, tcPluginSolve :: TcPluginNames -> TcPluginSolver
Ghc.tcPluginSolve = TcPluginNames -> TcPluginSolver
solver
, tcPluginStop :: TcPluginNames -> TcPluginM ()
Ghc.tcPluginStop = TcPluginM () -> TcPluginNames -> TcPluginM ()
forall a b. a -> b -> a
const (TcPluginM () -> TcPluginNames -> TcPluginM ())
-> TcPluginM () -> TcPluginNames -> TcPluginM ()
forall a b. (a -> b) -> a -> b
$ () -> TcPluginM ()
forall a. a -> TcPluginM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
#if MIN_VERSION_ghc(9,4,0)
, tcPluginRewrite :: TcPluginNames -> UniqFM TyCon TcPluginRewriter
Ghc.tcPluginRewrite = TcPluginNames -> UniqFM TyCon TcPluginRewriter
forall a. Monoid a => a
mempty
#endif
}
initTcPlugin :: Ghc.TcPluginM TcPluginNames
initTcPlugin :: TcPluginM TcPluginNames
initTcPlugin = do
Ghc.Found ModLocation
_ Module
breakpointMod <-
ModuleName -> TcPluginM FindResult
Ghc.findImportedModule' (String -> ModuleName
Ghc.mkModuleName String
"Debug.Breakpoint")
Ghc.Found ModLocation
_ Module
showMod <-
ModuleName -> TcPluginM FindResult
Ghc.findImportedModule' (String -> ModuleName
Ghc.mkModuleName String
"GHC.Show")
Name
showLevClassName <- Module -> OccName -> TcPluginM Name
Plugin.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkClsOcc String
"ShowLev")
Class
showClass <- Name -> TcPluginM Class
Plugin.tcLookupClass (Name -> TcPluginM Class) -> TcPluginM Name -> TcPluginM Class
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Module -> OccName -> TcPluginM Name
Plugin.lookupOrig Module
showMod (String -> OccName
Ghc.mkClsOcc String
"Show")
Class
succeedClass <- Name -> TcPluginM Class
Plugin.tcLookupClass (Name -> TcPluginM Class) -> TcPluginM Name -> TcPluginM Class
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Module -> OccName -> TcPluginM Name
Plugin.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkClsOcc String
"Succeed")
TyCon
showWrapperTyCon <- Name -> TcPluginM TyCon
Plugin.tcLookupTyCon (Name -> TcPluginM TyCon) -> TcPluginM Name -> TcPluginM TyCon
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Module -> OccName -> TcPluginM Name
Plugin.lookupOrig Module
breakpointMod (String -> OccName
Ghc.mkClsOcc String
"ShowWrapper")
TcPluginNames -> TcPluginM TcPluginNames
forall a. a -> TcPluginM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure MkTcPluginNames{Name
TyCon
Class
showLevClassName :: Name
showClass :: Class
succeedClass :: Class
showWrapperTyCon :: TyCon
showLevClassName :: Name
showClass :: Class
succeedClass :: Class
showWrapperTyCon :: TyCon
..}
findShowLevWanted
:: TcPluginNames
-> Ghc.Ct
-> Maybe (Either (Ghc.Type, Ghc.Ct) (Ghc.Type, Ghc.Ct))
findShowLevWanted :: TcPluginNames -> Ct -> Maybe (Either (Type, Ct) (Type, Ct))
findShowLevWanted TcPluginNames
names Ct
ct
| Ghc.CDictCan{Bool
[Type]
CtEvidence
Class
cc_ev :: CtEvidence
cc_class :: Class
cc_tyargs :: [Type]
cc_pend_sc :: Bool
cc_fundeps :: Bool
cc_class :: Ct -> Class
cc_ev :: Ct -> CtEvidence
cc_fundeps :: Ct -> Bool
cc_pend_sc :: Ct -> Bool
cc_tyargs :: Ct -> [Type]
..} <- Ct
ct
, TcPluginNames -> Name
showLevClassName TcPluginNames
names Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Class -> Name
forall a. NamedThing a => a -> Name
Ghc.getName Class
cc_class
, [Ghc.TyConApp TyCon
tyCon [], Type
arg2] <- [Type]
cc_tyargs
= Either (Type, Ct) (Type, Ct)
-> Maybe (Either (Type, Ct) (Type, Ct))
forall a. a -> Maybe a
Just (Either (Type, Ct) (Type, Ct)
-> Maybe (Either (Type, Ct) (Type, Ct)))
-> Either (Type, Ct) (Type, Ct)
-> Maybe (Either (Type, Ct) (Type, Ct))
forall a b. (a -> b) -> a -> b
$ if TyCon -> Name
forall a. NamedThing a => a -> Name
Ghc.getName TyCon
tyCon Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
Ghc.liftedRepName
then (Type, Ct) -> Either (Type, Ct) (Type, Ct)
forall a b. b -> Either a b
Right (Type
arg2, Ct
ct)
else (Type, Ct) -> Either (Type, Ct) (Type, Ct)
forall a b. a -> Either a b
Left (Type
arg2, Ct
ct)
| Bool
otherwise = Maybe (Either (Type, Ct) (Type, Ct))
forall a. Maybe a
Nothing
solver :: TcPluginNames -> Ghc.TcPluginSolver
solver :: TcPluginNames -> TcPluginSolver
solver TcPluginNames
names EvBindsVar
_given [Ct]
_derived [Ct]
wanted = do
InstEnvs
instEnvs <- TcPluginM InstEnvs
Plugin.getInstEnvs
[Maybe (EvTerm, Ct)]
solved <- [Either (Type, Ct) (Type, Ct)]
-> (Either (Type, Ct) (Type, Ct) -> TcPluginM (Maybe (EvTerm, Ct)))
-> TcPluginM [Maybe (EvTerm, Ct)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for (TcPluginNames -> Ct -> Maybe (Either (Type, Ct) (Type, Ct))
findShowLevWanted TcPluginNames
names (Ct -> Maybe (Either (Type, Ct) (Type, Ct)))
-> [Ct] -> [Either (Type, Ct) (Type, Ct)]
forall a b. (a -> Maybe b) -> [a] -> [b]
`mapMaybe` [Ct]
wanted) ((Either (Type, Ct) (Type, Ct) -> TcPluginM (Maybe (EvTerm, Ct)))
-> TcPluginM [Maybe (EvTerm, Ct)])
-> (Either (Type, Ct) (Type, Ct) -> TcPluginM (Maybe (EvTerm, Ct)))
-> TcPluginM [Maybe (EvTerm, Ct)]
forall a b. (a -> b) -> a -> b
$ \case
Left (Type
ty, Ct
ct) -> do
EvTerm
unshowableDict <- TcM EvTerm -> TcPluginM EvTerm
forall a. TcM a -> TcPluginM a
Ghc.unsafeTcPluginTcM (TcM EvTerm -> TcPluginM EvTerm) -> TcM EvTerm -> TcPluginM EvTerm
forall a b. (a -> b) -> a -> b
$ Type -> TcM EvTerm
buildUnshowableDict Type
ty
Maybe (EvTerm, Ct) -> TcPluginM (Maybe (EvTerm, Ct))
forall a. a -> TcPluginM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (EvTerm, Ct) -> TcPluginM (Maybe (EvTerm, Ct)))
-> Maybe (EvTerm, Ct) -> TcPluginM (Maybe (EvTerm, Ct))
forall a b. (a -> b) -> a -> b
$ (EvTerm, Ct) -> Maybe (EvTerm, Ct)
forall a. a -> Maybe a
Just (EvTerm
unshowableDict, Ct
ct)
Right (Type
ty, Ct
ct) -> do
Maybe EvTerm
mShowDict <- TcPluginNames -> Class -> [Type] -> TcPluginM (Maybe EvTerm)
buildDict TcPluginNames
names (TcPluginNames -> Class
showClass TcPluginNames
names) [Type
ty]
Maybe (EvTerm, Ct) -> TcPluginM (Maybe (EvTerm, Ct))
forall a. a -> TcPluginM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (EvTerm, Ct) -> TcPluginM (Maybe (EvTerm, Ct)))
-> Maybe (EvTerm, Ct) -> TcPluginM (Maybe (EvTerm, Ct))
forall a b. (a -> b) -> a -> b
$ Maybe EvTerm
mShowDict Maybe EvTerm -> (EvTerm -> (EvTerm, Ct)) -> Maybe (EvTerm, Ct)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \EvTerm
showDict ->
let (ClsInst
succInst, [Type]
_) = (ClsInst, [Type])
-> Either SDoc (ClsInst, [Type]) -> (ClsInst, [Type])
forall b a. b -> Either a b -> b
fromRight (String -> (ClsInst, [Type])
forall a. HasCallStack => String -> a
error String
"impossible: no Succeed instance") (Either SDoc (ClsInst, [Type]) -> (ClsInst, [Type]))
-> Either SDoc (ClsInst, [Type]) -> (ClsInst, [Type])
forall a b. (a -> b) -> a -> b
$
InstEnvs -> Class -> [Type] -> Either SDoc (ClsInst, [Type])
Ghc.lookupUniqueInstEnv InstEnvs
instEnvs (TcPluginNames -> Class
succeedClass TcPluginNames
names) [Type
ty]
in (ClsInst -> Type -> EvExpr -> EvTerm
liftDict ClsInst
succInst Type
ty (EvTerm -> EvExpr
getEvExprFromDict EvTerm
showDict), Ct
ct)
TcPluginSolveResult -> TcPluginM TcPluginSolveResult
forall a. a -> TcPluginM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TcPluginSolveResult -> TcPluginM TcPluginSolveResult)
-> TcPluginSolveResult -> TcPluginM TcPluginSolveResult
forall a b. (a -> b) -> a -> b
$ [(EvTerm, Ct)] -> [Ct] -> TcPluginSolveResult
Ghc.TcPluginOk ([Maybe (EvTerm, Ct)] -> [(EvTerm, Ct)]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (EvTerm, Ct)]
solved) []
buildDict
:: TcPluginNames
-> Ghc.Class
-> [Ghc.Type]
-> Ghc.TcPluginM (Maybe Ghc.EvTerm)
buildDict :: TcPluginNames -> Class -> [Type] -> TcPluginM (Maybe EvTerm)
buildDict TcPluginNames
names Class
cls [Type]
tys = do
InstEnvs
instEnvs <- TcPluginM InstEnvs
Plugin.getInstEnvs
case InstEnvs -> Class -> [Type] -> Either SDoc (ClsInst, [Type])
Ghc.lookupUniqueInstEnv InstEnvs
instEnvs Class
cls [Type]
tys of
Right (ClsInst
clsInst, [Type]
_) -> do
let dfun :: TyVar
dfun = ClsInst -> TyVar
Ghc.is_dfun ClsInst
clsInst
([TyVar]
vars, [Type]
subclasses, Type
inst) = Type -> ([TyVar], [Type], Type)
Ghc.tcSplitSigmaTy (Type -> ([TyVar], [Type], Type))
-> Type -> ([TyVar], [Type], Type)
forall a b. (a -> b) -> a -> b
$ TyVar -> Type
Ghc.idType TyVar
dfun
if [Type] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Type]
subclasses
then Maybe EvTerm -> TcPluginM (Maybe EvTerm)
forall a. a -> TcPluginM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe EvTerm -> TcPluginM (Maybe EvTerm))
-> (EvTerm -> Maybe EvTerm) -> EvTerm -> TcPluginM (Maybe EvTerm)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvTerm -> Maybe EvTerm
forall a. a -> Maybe a
Just (EvTerm -> TcPluginM (Maybe EvTerm))
-> EvTerm -> TcPluginM (Maybe EvTerm)
forall a b. (a -> b) -> a -> b
$ TyVar -> [Type] -> [EvExpr] -> EvTerm
Ghc.evDFunApp TyVar
dfun [] []
else do
let tyVarMap :: Map TyVar Type
tyVarMap = Type -> [Type] -> Map TyVar Type
mkTyVarMapping Type
inst [Type]
tys
Maybe [EvTerm]
mSolvedSubClassDicts <- ([Maybe EvTerm] -> Maybe [EvTerm])
-> TcPluginM [Maybe EvTerm] -> TcPluginM (Maybe [EvTerm])
forall a b. (a -> b) -> TcPluginM a -> TcPluginM b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Maybe EvTerm] -> Maybe [EvTerm]
forall (t :: * -> *) (m :: * -> *) a.
(Traversable t, Monad m) =>
t (m a) -> m (t a)
forall (m :: * -> *) a. Monad m => [m a] -> m [a]
sequence (TcPluginM [Maybe EvTerm] -> TcPluginM (Maybe [EvTerm]))
-> ((Type -> TcPluginM (Maybe EvTerm)) -> TcPluginM [Maybe EvTerm])
-> (Type -> TcPluginM (Maybe EvTerm))
-> TcPluginM (Maybe [EvTerm])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Type]
-> (Type -> TcPluginM (Maybe EvTerm)) -> TcPluginM [Maybe EvTerm]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
t a -> (a -> f b) -> f (t b)
for [Type]
subclasses ((Type -> TcPluginM (Maybe EvTerm)) -> TcPluginM (Maybe [EvTerm]))
-> (Type -> TcPluginM (Maybe EvTerm)) -> TcPluginM (Maybe [EvTerm])
forall a b. (a -> b) -> a -> b
$ \Type
subclass -> do
let (Class
subCls, [Type]
subTys) = Type -> (Class, [Type])
Ghc.tcSplitDFunHead Type
subclass
subTys' :: [Type]
subTys' = Map TyVar Type -> [Type] -> [Type]
instantiateVars Map TyVar Type
tyVarMap [Type]
subTys
TcPluginNames -> Class -> [Type] -> TcPluginM (Maybe EvTerm)
buildDict TcPluginNames
names Class
subCls [Type]
subTys'
Maybe EvTerm -> TcPluginM (Maybe EvTerm)
forall a. a -> TcPluginM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe EvTerm -> TcPluginM (Maybe EvTerm))
-> Maybe EvTerm -> TcPluginM (Maybe EvTerm)
forall a b. (a -> b) -> a -> b
$ do
[Type]
vars' <- (TyVar -> Maybe Type) -> [TyVar] -> Maybe [Type]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse (Map TyVar Type
tyVarMap Map TyVar Type -> TyVar -> Maybe Type
forall k a. Ord k => Map k a -> k -> Maybe a
M.!?) [TyVar]
vars
TyVar -> [Type] -> [EvExpr] -> EvTerm
Ghc.evDFunApp TyVar
dfun [Type]
vars' ([EvExpr] -> EvTerm)
-> ([EvTerm] -> [EvExpr]) -> [EvTerm] -> EvTerm
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EvTerm -> EvExpr) -> [EvTerm] -> [EvExpr]
forall a b. (a -> b) -> [a] -> [b]
map EvTerm -> EvExpr
getEvExprFromDict
([EvTerm] -> EvTerm) -> Maybe [EvTerm] -> Maybe EvTerm
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [EvTerm]
mSolvedSubClassDicts
Left SDoc
_
| Class
cls Class -> Class -> Bool
forall a. Eq a => a -> a -> Bool
== TcPluginNames -> Class
showClass TcPluginNames
names
, [Type
ty] <- [Type]
tys -> do
EvTerm
unshowableDict <- TcM EvTerm -> TcPluginM EvTerm
forall a. TcM a -> TcPluginM a
Ghc.unsafeTcPluginTcM (TcM EvTerm -> TcPluginM EvTerm) -> TcM EvTerm -> TcPluginM EvTerm
forall a b. (a -> b) -> a -> b
$ Type -> TcM EvTerm
buildUnshowableDict Type
ty
let (ClsInst
inst, [Type]
_) = (ClsInst, [Type])
-> Either SDoc (ClsInst, [Type]) -> (ClsInst, [Type])
forall b a. b -> Either a b -> b
fromRight (String -> (ClsInst, [Type])
forall a. HasCallStack => String -> a
error String
"impossible: no Show instance for ShowWrapper") (Either SDoc (ClsInst, [Type]) -> (ClsInst, [Type]))
-> Either SDoc (ClsInst, [Type]) -> (ClsInst, [Type])
forall a b. (a -> b) -> a -> b
$
InstEnvs -> Class -> [Type] -> Either SDoc (ClsInst, [Type])
Ghc.lookupUniqueInstEnv
InstEnvs
instEnvs
(TcPluginNames -> Class
showClass TcPluginNames
names)
[TyCon -> [Type] -> Type
Ghc.mkTyConApp (TcPluginNames -> TyCon
showWrapperTyCon TcPluginNames
names) [Type
ty]]
liftedDict :: EvTerm
liftedDict =
ClsInst -> Type -> EvExpr -> EvTerm
liftDict ClsInst
inst Type
ty (EvTerm -> EvExpr
getEvExprFromDict EvTerm
unshowableDict)
Maybe EvTerm -> TcPluginM (Maybe EvTerm)
forall a. a -> TcPluginM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe EvTerm -> TcPluginM (Maybe EvTerm))
-> Maybe EvTerm -> TcPluginM (Maybe EvTerm)
forall a b. (a -> b) -> a -> b
$ EvTerm -> Maybe EvTerm
forall a. a -> Maybe a
Just EvTerm
liftedDict
| Bool
otherwise -> Maybe EvTerm -> TcPluginM (Maybe EvTerm)
forall a. a -> TcPluginM a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe EvTerm
forall a. Maybe a
Nothing
getEvExprFromDict :: Ghc.EvTerm -> Ghc.EvExpr
getEvExprFromDict :: EvTerm -> EvExpr
getEvExprFromDict = \case
Ghc.EvExpr EvExpr
expr -> EvExpr
expr
EvTerm
_ -> String -> EvExpr
forall a. HasCallStack => String -> a
error String
"invalid argument to getEvExprFromDict"
mkTyVarMapping
:: Ghc.Type
-> [Ghc.Type]
-> M.Map Ghc.TyVar Ghc.Type
mkTyVarMapping :: Type -> [Type] -> Map TyVar Type
mkTyVarMapping Type
wanted [Type]
tys =
let wantedHead :: [Type]
wantedHead = (Type, [Type]) -> [Type]
forall a b. (a, b) -> b
snd ((Type, [Type]) -> [Type]) -> (Type, [Type]) -> [Type]
forall a b. (a -> b) -> a -> b
$ Type -> (Type, [Type])
Ghc.splitAppTys Type
wanted
wantedTyVars :: [Type]
wantedTyVars = (Type -> [Type]) -> [Type] -> [Type]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Type, [Type]) -> [Type]
forall a b. (a, b) -> b
snd ((Type, [Type]) -> [Type])
-> (Type -> (Type, [Type])) -> Type -> [Type]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> (Type, [Type])
Ghc.splitAppTys) [Type]
wantedHead
concreteTys :: [Type]
concreteTys = (Type -> [Type]) -> [Type] -> [Type]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((Type, [Type]) -> [Type]
forall a b. (a, b) -> b
snd ((Type, [Type]) -> [Type])
-> (Type -> (Type, [Type])) -> Type -> [Type]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> (Type, [Type])
Ghc.splitAppTys) [Type]
tys
in [(TyVar, Type)] -> Map TyVar Type
forall k v. Ord k => [(k, v)] -> Map k v
M.fromList ([(TyVar, Type)] -> Map TyVar Type)
-> [(TyVar, Type)] -> Map TyVar Type
forall a b. (a -> b) -> a -> b
$ do
(Type
a, Type
b) <- [Type] -> [Type] -> [(Type, Type)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Type]
wantedTyVars [Type]
concreteTys
Just TyVar
tyVar <- [Type -> Maybe TyVar
Ghc.getTyVar_maybe Type
a]
(TyVar, Type) -> [(TyVar, Type)]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TyVar
tyVar, Type
b)
instantiateVars :: M.Map Ghc.TyVar Ghc.Type -> [Ghc.Type] -> [Ghc.Type]
instantiateVars :: Map TyVar Type -> [Type] -> [Type]
instantiateVars Map TyVar Type
tyVarMap [Type]
tys = Type -> Type
replace (Type -> Type) -> [Type] -> [Type]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Type]
tys
where
replace :: Type -> Type
replace Type
arg = Type -> Maybe Type -> Type
forall a. a -> Maybe a -> a
fromMaybe Type
arg (Maybe Type -> Type) -> Maybe Type -> Type
forall a b. (a -> b) -> a -> b
$ do
TyVar
tyVar <- Type -> Maybe TyVar
Ghc.getTyVar_maybe Type
arg
TyVar -> Map TyVar Type -> Maybe Type
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup TyVar
tyVar Map TyVar Type
tyVarMap
buildUnshowableDict :: Ghc.Type -> Ghc.TcM Ghc.EvTerm
buildUnshowableDict :: Type -> TcM EvTerm
buildUnshowableDict Type
ty = do
let tyString :: String
tyString = SDoc -> String
Ghc.showSDocOneLine' (SDoc -> String) -> SDoc -> String
forall a b. (a -> b) -> a -> b
$ Type -> SDoc
Ghc.pprTypeForUser' Type
ty
EvExpr
str <- String -> IOEnv (Env TcGblEnv TcLclEnv) EvExpr
forall (m :: * -> *). MonadThings m => String -> m EvExpr
Ghc.mkStringExpr (String -> IOEnv (Env TcGblEnv TcLclEnv) EvExpr)
-> String -> IOEnv (Env TcGblEnv TcLclEnv) EvExpr
forall a b. (a -> b) -> a -> b
$ String
"<" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
tyString String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
">"
EvTerm -> TcM EvTerm
forall a. a -> IOEnv (Env TcGblEnv TcLclEnv) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EvTerm -> TcM EvTerm)
-> (EvExpr -> EvTerm) -> EvExpr -> TcM EvTerm
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EvExpr -> EvTerm
Ghc.EvExpr (EvExpr -> TcM EvTerm) -> EvExpr -> TcM EvTerm
forall a b. (a -> b) -> a -> b
$
[TyVar] -> EvExpr -> EvExpr
Ghc.mkCoreLams [Type -> TyVar
Ghc.mkWildValBinder' Type
ty] EvExpr
str
liftDict :: Ghc.ClsInst -> Ghc.Type -> Ghc.EvExpr -> Ghc.EvTerm
liftDict :: ClsInst -> Type -> EvExpr -> EvTerm
liftDict ClsInst
succ_inst Type
ty EvExpr
dict = TyVar -> [Type] -> [EvExpr] -> EvTerm
Ghc.evDFunApp (ClsInst -> TyVar
Ghc.is_dfun ClsInst
succ_inst) [Type
ty] [EvExpr
dict]
class ShowLev (rep :: Exts.RuntimeRep) (a :: Exts.TYPE rep) where
showLev :: a -> String
instance ShowLev 'Exts.IntRep Exts.Int# where
showLev :: Int# -> String
showLev Int#
i = Int -> String
forall a. Show a => a -> String
show (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ Int# -> Int
I# Int#
i
#if MIN_VERSION_base(4,16,0)
instance ShowLev 'Exts.Int8Rep Exts.Int8# where
showLev :: Int8# -> String
showLev Int8#
i = Int8 -> String
forall a. Show a => a -> String
show (Int8 -> String) -> Int8 -> String
forall a b. (a -> b) -> a -> b
$ Int8# -> Int8
I8# Int8#
i
instance ShowLev 'Exts.Int16Rep Exts.Int16# where
showLev :: Int16# -> String
showLev Int16#
i = Int16 -> String
forall a. Show a => a -> String
show (Int16 -> String) -> Int16 -> String
forall a b. (a -> b) -> a -> b
$ Int16# -> Int16
I16# Int16#
i
instance ShowLev 'Exts.Int32Rep Exts.Int32# where
showLev :: Int32# -> String
showLev Int32#
i = Int32 -> String
forall a. Show a => a -> String
show (Int32 -> String) -> Int32 -> String
forall a b. (a -> b) -> a -> b
$ Int32# -> Int32
I32# Int32#
i
#endif
#if MIN_VERSION_base(4,17,0)
instance ShowLev 'Exts.Int64Rep Exts.Int64# where
showLev :: Int64# -> String
showLev Int64#
i = Int64 -> String
forall a. Show a => a -> String
show (Int64 -> String) -> Int64 -> String
forall a b. (a -> b) -> a -> b
$ Int64# -> Int64
I64# Int64#
i
#endif
instance ShowLev 'Exts.WordRep Exts.Word# where
showLev :: Word# -> String
showLev Word#
w = Word -> String
forall a. Show a => a -> String
show (Word -> String) -> Word -> String
forall a b. (a -> b) -> a -> b
$ Word# -> Word
W# Word#
w
#if MIN_VERSION_base(4,16,0)
instance ShowLev 'Exts.Word8Rep Exts.Word8# where
showLev :: Word8# -> String
showLev Word8#
w = Word8 -> String
forall a. Show a => a -> String
show (Word8 -> String) -> Word8 -> String
forall a b. (a -> b) -> a -> b
$ Word8# -> Word8
W8# Word8#
w
instance ShowLev 'Exts.Word16Rep Exts.Word16# where
showLev :: Word16# -> String
showLev Word16#
w = Word16 -> String
forall a. Show a => a -> String
show (Word16 -> String) -> Word16 -> String
forall a b. (a -> b) -> a -> b
$ Word16# -> Word16
W16# Word16#
w
instance ShowLev 'Exts.Word32Rep Exts.Word32# where
showLev :: Word32# -> String
showLev Word32#
w = Word32 -> String
forall a. Show a => a -> String
show (Word32 -> String) -> Word32 -> String
forall a b. (a -> b) -> a -> b
$ Word32# -> Word32
W32# Word32#
w
#endif
#if MIN_VERSION_base(4,17,0)
instance ShowLev 'Exts.Word64Rep Exts.Word64# where
showLev :: Word64# -> String
showLev Word64#
w = Word64 -> String
forall a. Show a => a -> String
show (Word64 -> String) -> Word64 -> String
forall a b. (a -> b) -> a -> b
$ Word64# -> Word64
W64# Word64#
w
#endif
instance ShowLev 'Exts.FloatRep Exts.Float# where
showLev :: Float# -> String
showLev Float#
f = Float -> String
forall a. Show a => a -> String
show (Float -> String) -> Float -> String
forall a b. (a -> b) -> a -> b
$ Float# -> Float
Exts.F# Float#
f
instance ShowLev 'Exts.DoubleRep Exts.Double# where
showLev :: Double# -> String
showLev Double#
d = Double -> String
forall a. Show a => a -> String
show (Double -> String) -> Double -> String
forall a b. (a -> b) -> a -> b
$ Double# -> Double
Exts.D# Double#
d
newtype ShowWrapper a = MkShowWrapper a
instance ShowLev Exts.LiftedRep a => Show (ShowWrapper a) where
show :: ShowWrapper a -> String
show (MkShowWrapper a
a) = a -> String
forall a. ShowLev LiftedRep a => a -> String
showLev a
a
class Succeed a where
_succeed :: a -> String
instance Show a => Succeed a where
_succeed :: a -> String
_succeed = a -> String
forall a. Show a => a -> String
show