module GHC.Driver.Config.Core.Lint.Interactive
( lintInteractiveExpr
) where
import GHC.Prelude
import GHC.Driver.Env
import GHC.Driver.Session
import GHC.Driver.Config.Core.Lint
import GHC.Core
import GHC.Core.Ppr
import GHC.Core.Lint
import GHC.Core.Lint.Interactive
import GHC.Data.Bag
import GHC.Utils.Outputable as Outputable
lintInteractiveExpr :: SDoc
-> HscEnv
-> CoreExpr -> IO ()
lintInteractiveExpr :: SDoc -> HscEnv -> CoreExpr -> IO ()
lintInteractiveExpr SDoc
what HscEnv
hsc_env CoreExpr
expr
| Bool -> Bool
not (GeneralFlag -> DynFlags -> Bool
gopt GeneralFlag
Opt_DoCoreLinting DynFlags
dflags)
= () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
| Just Bag SDoc
err <- LintConfig -> CoreExpr -> Maybe (Bag SDoc)
lintExpr (DynFlags -> [CoreBndr] -> LintConfig
initLintConfig DynFlags
dflags ([CoreBndr] -> LintConfig) -> [CoreBndr] -> LintConfig
forall a b. (a -> b) -> a -> b
$ InteractiveContext -> [CoreBndr]
interactiveInScope (InteractiveContext -> [CoreBndr])
-> InteractiveContext -> [CoreBndr]
forall a b. (a -> b) -> a -> b
$ HscEnv -> InteractiveContext
hsc_IC HscEnv
hsc_env) CoreExpr
expr
= Logger -> Bool -> SDoc -> SDoc -> WarnsAndErrs -> IO ()
displayLintResults Logger
logger Bool
False SDoc
what (CoreExpr -> SDoc
forall b. OutputableBndr b => Expr b -> SDoc
pprCoreExpr CoreExpr
expr) (Bag SDoc
forall a. Bag a
emptyBag, Bag SDoc
err)
| Bool
otherwise
= () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
dflags :: DynFlags
dflags = HscEnv -> DynFlags
hsc_dflags HscEnv
hsc_env
logger :: Logger
logger = HscEnv -> Logger
hsc_logger HscEnv
hsc_env