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)
= 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 forall a b. (a -> b) -> a -> b
$ InteractiveContext -> [CoreBndr]
interactiveInScope 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 (forall b. OutputableBndr b => Expr b -> SDoc
pprCoreExpr CoreExpr
expr) (forall a. Bag a
emptyBag, Bag SDoc
err)
| Bool
otherwise
= 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