getGHCiMonad = fmap (ic_monad . hsc_IC) getSession

 getHistorySpan :: GhcMonad m => History -> m SrcSpan

 obtainTermFromVal :: GhcMonad m => Int ->  Bool -> Type -> a -> m Term

 obtainTermFromVal bound force ty a = withSession $ \hsc_env ->

 exprs_fvs exprs = mapUnionFV expr_fvs exprs

 tickish_fvs :: CoreTickish -> FV

 tickish_fvs _ = emptyFV

 {- **********************************************************************

         , AnnTick tickish expr2 )

       where

         expr2 = go expr

     go (Type ty)     = (tyCoVarsOfTypeDSet ty, AnnType ty)

     go (Coercion co) = (tyCoVarsOfCoDSet co, AnnCoercion co)

 lintCoreExpr (Tick tickish expr)

   = do { case tickish of

        ; markAllJoinsBadIf block_joins $ lintCoreExpr expr }

   where

     block_joins = not (tickish `tickishScopesLike` SoftScope)

 eqDeBruijnTickish :: DeBruijn CoreTickish -> DeBruijn CoreTickish -> Bool

 eqDeBruijnTickish (D env1 t1) (D env2 t2) = go t1 t2 where

         =  lid == rid

         && D env1 lids == D env2 rids

         && lext == rext

     go l r = l == r

 -- Compares for equality, modulo alpha

       -- For a non-soft tick scope, we can inline lambdas only, so we

       -- abandon tail calls, and do markAllInsideLam too: usage_lam

       = -- Never substitute for any of the Ids in a Breakpoint

         addManyOccs usage_lam (mkVarSet ids)

   simplTickish env tickish

     | otherwise = tickish

   -- Push type application and coercion inside a tick

 import GHC.Core

 import GHC.Core.Stats (exprStats)

 import GHC.Types.Fixity (LexicalFixity(..))

 import GHC.Types.Literal( pprLiteral )

 import GHC.Types.Name( pprInfixName, pprPrefixName )

             ppr modl, comma,

             ppr ix,

             text ">"]

       hcat [text "break<",

             text ">",

             parens (hcat (punctuate comma (map ppr vars)))]

   ppr (ProfNote { profNoteCC = cc,

 ------------------

 -- | Drop free vars from the breakpoint if they have a non-variable substitution.

 substTickish :: Subst -> CoreTickish -> CoreTickish

  where

     do_one = getIdFromTrivialExpr_maybe . lookupIdSubst subst

 ------------  Tickish  --------------

 tidyTickish :: TidyEnv -> CoreTickish -> CoreTickish

 tidyTickish _   other_tickish       = other_tickish

 ------------  Rules  --------------

 -- Used by diffBinds, which is itself only used in GHC.Core.Lint.lintAnnots

 eqTickish :: RnEnv2 -> CoreTickish -> CoreTickish -> Bool

       = lid == rid &&

         map (rnOccL env) lids == map (rnOccR env) rids &&

 eqTickish _ l r = l == r

 -- | Finds differences between core bindings, see @diffExpr@.

 toIfaceTickish (HpcTick modl ix)       = IfaceHpcTick modl ix

 toIfaceTickish (SourceNote src (LexicalFastString names)) =

   IfaceSource src names

 ---------------------

 toIfaceBind :: Bind Id -> IfaceBinding IfaceLetBndr

 coreToStgTick :: Type -- type of the ticked expression

               -> CoreTickish

               -> StgTickish

 -- ---------------------------------------------------------------------------

 -- The magic for lets:

   = do { body <- cpeBodyNF env expr

        ; return (emptyFloats, mkTick tickish' body) }

   where

              -- See also 'substTickish'

              | otherwise

              = tickish

 import GHC.Utils.Outputable as Outputable

 import GHC.Utils.Panic

 import GHC.Utils.Logger

 import GHC.Types.SrcLoc

 import GHC.Types.Basic

 import GHC.Types.Id

     Breakpoints -> do

       i <- addMixEntry me

     SourceNotes | RealSrcSpan pos' _ <- pos ->

       return $ SourceNote pos' $ LexicalFastString cc_name

 import GHC.Builtin.Names ( unrestrictedFunTyConKey, liftedTypeKindTyConKey,

                            constraintKindTyConKey )

 import GHC.Types.Unique ( hasKey )

 import GHC.Iface.Type

 import GHC.Iface.Recomp.Binary

   = IfaceHpcTick    Module Int               -- from HpcTick x

   | IfaceSCC        CostCentre Bool Bool     -- from ProfNote

   | IfaceSource  RealSrcSpan FastString      -- from SourceNote

 data IfaceAlt = IfaceAlt IfaceConAlt [IfLclName] IfaceExpr

         -- Note: IfLclName, not IfaceBndr (and same with the case binder)

   = braces (pprCostCentreCore cc <+> ppr tick <+> ppr scope)

 pprIfaceTickish (IfaceSource src _names)

   = braces (pprUserRealSpan True src)

   = braces (text "break" <+> ppr m <+> ppr ix <+> ppr fvs)

 ------------------

   = unitNameSet ax &&& freeNamesIfTc tc &&& freeNamesIfAppArgs tys

 freeNamesIfTickish :: IfaceTickish -> NameSet

   fnList freeNamesIfExpr fvs

 freeNamesIfTickish _ = emptyNameSet

         put_ bh (srcSpanEndLine src)

         put_ bh (srcSpanEndCol src)

         put_ bh name

         putByte bh 3

         put_ bh m

         put_ bh ix

             3 -> do m <- get bh

                     ix <- get bh

                     fvs <- get bh

             _ -> panic ("get IfaceTickish " ++ show h)

 instance Binary IfaceConAlt where

     IfaceHpcTick m i -> rnf m `seq` rnf i

     IfaceSCC cc b1 b2 -> rnf cc `seq` rnf b1 `seq` rnf b2

     IfaceSource src str -> rnf src `seq` rnf str

 instance NFData IfaceConAlt where

   rnf = \case

 dffvExpr (Var v)              = insert v

 dffvExpr (App e1 e2)          = dffvExpr e1 >> dffvExpr e2

 dffvExpr (Lam v e)            = extendScope v (dffvExpr e)

 dffvExpr (Tick _other e)    = dffvExpr e

 dffvExpr (Cast e _)           = dffvExpr e

 dffvExpr (Let (NonRec x r) e) = dffvBind (x,r) >> extendScope x (dffvExpr e)

 tcIfaceTickish (IfaceHpcTick modl ix)   = return (HpcTick modl ix)

 tcIfaceTickish (IfaceSCC  cc tick push) = return (ProfNote cc tick push)

 tcIfaceTickish (IfaceSource src name)   = return (SourceNote src (LexicalFastString name))

   fvs' <- mapM tcIfaceExpr fvs

 -------------------------

 tcIfaceLit :: Literal -> IfL Literal

 -- | GHC API debugger module for finding and setting breakpoints.

 --

 -- This module is user facing and is at least used by `GHCi` and `ghc-debugger`

 -- to find and set breakpoints.

 module GHC.Runtime.Debugger.Breakpoints where

 import Control.Monad.Catch

 import Control.Monad

 import Data.Array

 import qualified Data.List.NonEmpty as NE

 import qualified Data.Semigroup as S

 import GHC.Runtime.Eval.Utils

 import GHC.Types.SrcLoc

 import GHC.Utils.Outputable

 import GHC.Utils.Panic

 import qualified GHC.Data.Strict as Strict

         ticks = arr ! line

         starts_here = [ (ix,pan) | (ix, pan) <- ticks,

         (comp, incomp) = partition ends_here starts_here

 -- | Find a breakpoint in the 'TickArray' of a module, given a line number and a column coordinate.

 findBreakByCoord :: (Int, Int) -> TickArray -> Maybe (BreakIndex, RealSrcSpan)

         contains = [ tick | tick@(_,pan) <- ticks, RealSrcSpan pan Strict.Nothing `spans` (line,col) ]

         after_here = [ tick | tick@(_,pan) <- ticks,

 leftmostLargestRealSrcSpan :: RealSrcSpan -> RealSrcSpan -> Ordering

 leftmostLargestRealSrcSpan = on compare realSrcSpanStart S.<> on (flip compare) realSrcSpanEnd

     Nothing -> do

       -- No errors found, go and return the module info

       let mod = fromMaybe (panic "resolveFunctionBreakpoint") mb_mod

       case mb_mod_info of

         Nothing -> pure . Left $

           text "Could not find ModuleInfo of " <> ppr mod

   where

     -- Try to lookup the module for an identifier that is in scope.

     -- `parseName` throws an exception, if the identifier is not in scope

     lookupModuleInscope mod_top_lvl = do

     -- Lookup the Module of a module name in the module graph

     lookupModuleInGraph mod_str = do

         pure $ find ((== mod_str) . moduleNameString . moduleName) hmods

     -- Check validity of an identifier to set a breakpoint:

     --  2. the identifier must be in an interpreted module

     --  3. the ModBreaks array for module `mod` must have an entry

     --     for the function

                        -> m (Maybe SDoc)

     validateBP mod_str fun_str Nothing = pure $ Just $ quotes (text

         (combineModIdent mod_str (takeWhile (/= '.') fun_str)))

         <+> text "not in scope"

     validateBP _ "" (Just _) = pure $ Just $ text "Function name is missing"

     validateBP _ fun_str (Just modl) = do

         mb_err_msg <- case isInterpr of

           False -> pure $ Just $ text "Module" <+> quotes (ppr modl) <+> text "is not interpreted"

           True -> do

             mb_modbreaks <- getModBreak modl

             let found = case mb_modbreaks of

                   Nothing -> False

             if found

               then pure Nothing

               else pure $ Just $ text "No breakpoint found for" <+> quotes (text fun_str)

 -- for

 --   (a) this binder only (it maybe a top-level or a nested declaration)

 --   (b) that do not have an enclosing breakpoint

 findBreakForBind str_name modbreaks = filter (not . enclosed) ticks

   where

     ticks = [ (index, span)

               str_name == intercalate "." decls,

     enclosed (_,sp0) = any subspan ticks

       where subspan (_,sp) = sp /= sp0 &&

                          realSrcSpanStart sp <= realSrcSpanStart sp0 &&

 --------------------------------------------------------------------------------

 -- | Maps line numbers to the breakpoint ticks existing at that line for a module.

 -- | Construct the 'TickArray' for the given module.

 makeModuleLineMap :: GhcMonad m => Module -> m (Maybe TickArray)

 makeModuleLineMap m = do

   where

     mkTickArray :: [(BreakIndex, SrcSpan)] -> TickArray

     mkTickArray ticks

       = accumArray (flip (:)) [] (1, max_line)

             [ (line, (nm,pan)) | (nm,RealSrcSpan pan _) <- ticks, line <- srcSpanLines pan ]

         where

 -- | Get the 'ModBreaks' of the given 'Module' when available

 getModBreak m = do

 --------------------------------------------------------------------------------

 -- Getting current breakpoint information

 --------------------------------------------------------------------------------

 getCurrentBreakSpan = do

   case resumes of

     [] -> return Nothing

     (r:_) -> do

         if ix == 0

            else do

                 return (Just pan)

 getCurrentBreakModule = do

   return $ case resumes of

     [] -> Nothing

 getResumeContext :: GhcMonad m => m [Resume]

 getResumeContext = withSession (return . ic_resume . hsc_IC)

 getHistoryModule :: History -> Module

 getHistoryModule = ibi_tick_mod . historyBreakpointId

   let ibi = historyBreakpointId hist

   return $ modBreaks_locs brks ! ibi_tick_index ibi

 {- | Finds the enclosing top level function name -}

 -- ToDo: a better way to do this would be to keep hold of the decl_path computed

 -- by the coverage pass, which gives the list of lexically-enclosing bindings

 -- for each tick.

   return $ modBreaks_decls brks ! ibi_tick_index ibi

 -- | Update fixity environment in the current interactive context.

     --  - or one of the stepping options in @EvalOpts@ caused us to stop at one

     EvalBreak apStack_ref (Just eval_break) resume_ctxt ccs -> do

       let ibi = evalBreakpointToId eval_break

       let

         span      = modBreaks_locs tick_brks ! ibi_tick_index ibi

         decl      = intercalate "." $ modBreaks_decls tick_brks ! ibi_tick_index ibi

         let eval_opts = initEvalOpts dflags (enableGhcStepMode step)

         status <- liftIO $ GHCi.resumeStmt interp eval_opts resume_ctxt_fhv

         history <- if not tracing then pure history0 else do

           let !history' = history1 `consBL` history0

                 -- history is strict, otherwise our BoundedList is pointless.

           return history'

                 -- When the user specified a break ignore count, set it

                 -- in the interpreter

                 case (mb_brkpt, mbCnt) of

                   _ -> return ()

                 let eval_opts = initEvalOpts dflags (enableGhcStepMode step)

                 status <- liftIO $ GHCi.resumeStmt interp eval_opts fhv

                 let prevHistoryLst = fromListBL 50 hist

                     hist' = case mb_brkpt of

                        Nothing -> pure prevHistoryLst

                        Just bi

                          | breakHere False step span -> do

                             return $ hist1 `consBL` fromListBL 50 hist

                          | otherwise -> pure prevHistoryLst

                 handleRunStatus step expr bindings final_ids status =<< hist'

   let breakarray = modBreaks_flags modBreaks

   _ <- liftIO $ GHCi.storeBreakpoint interp breakarray (bi_tick_index bi) cnt

   pure ()

             span <- case mb_info of

                       Nothing  -> return $ mkGeneralSrcSpan (fsLit "<unknown>")

                       Just ibi -> liftIO $ do

                         return $ modBreaks_locs brks ! ibi_tick_index ibi

             (hsc_env1, names) <-

               liftIO $ bindLocalsAtBreakpoint hsc_env apStack span mb_info

 result_fs :: FastString

 result_fs = fsLit "_result"

 bindLocalsAtBreakpoint

         :: HscEnv

         -> ForeignHValue

 -- Just case: we stopped at a breakpoint, we have information about the location

 -- of the breakpoint and the free variables of the expression.

 bindLocalsAtBreakpoint hsc_env apStack_fhv span (Just ibi) = do

    let info   = expectJust $ IntMap.lookup (ibi_info_index ibi) (modBreaks_breakInfo info_brks)

        interp = hscInterp hsc_env

        occs   = modBreaks_vars tick_brks ! ibi_tick_index ibi

   , getClosure

   , whereFrom

   , getModBreaks

   , seqHValue

   , evalBreakpointToId

   -- * The object-code linker

   , initObjLinker

 #if defined(HAVE_INTERNAL_INTERPRETER)

 import GHCi.Run

 #endif

 import Control.Concurrent

 import GHC.Builtin.Names

 import GHC.Types.Name

 -- Standard libraries

 import GHC.Exts

   ExternalInterp {}

     -> throwIO (InstallationError "this operation requires -fno-external-interpreter")

 getModBreaks :: HomeModInfo -> Maybe ModBreaks

 getModBreaks hmi

   | Just linkable <- homeModInfoByteCode hmi,

   | otherwise

   = Nothing -- probably object code