    {-
    (c) Galois, 2006
    (c) University of Glasgow, 2007
    -}

    {-# LANGUAGE NondecreasingIndentation, RecordWildCards #-}
    {-# LANGUAGE ViewPatterns #-}
    {-# LANGUAGE TypeFamilies #-}
    {-# LANGUAGE DeriveFunctor #-}

    {-# OPTIONS_GHC -Wno-incomplete-record-updates #-}

    module GHC.HsToCore.Coverage (addTicksToBinds, hpcInitCode) where

    import GHC.Prelude as Prelude

    import qualified GHC.Runtime.Interpreter as GHCi
    import GHCi.RemoteTypes
    import Data.Array
    import GHC.ByteCode.Types
    import GHC.Stack.CCS
    import GHC.Core.Type
    import GHC.Hs
    import GHC.Unit
    import GHC.Utils.Outputable as Outputable
    import GHC.Driver.Session
    import GHC.Core.ConLike
    import Control.Monad
    import GHC.Types.SrcLoc
    import GHC.Utils.Error
    import GHC.Types.Name.Set hiding (FreeVars)
    import GHC.Types.Name
    import GHC.Data.Bag
    import GHC.Types.CostCentre
    import GHC.Types.CostCentre.State
    import GHC.Core
    import GHC.Types.Id
    import GHC.Types.Var.Set
    import Data.List
    import GHC.Data.FastString
    import GHC.Driver.Types
    import GHC.Core.TyCon
    import GHC.Types.Basic
    import GHC.Utils.Monad
    import GHC.Data.Maybe
    import GHC.Cmm.CLabel
    import GHC.Utils.Misc

    import Data.Time
    import System.Directory

    import Trace.Hpc.Mix
    import Trace.Hpc.Util

    import qualified Data.ByteString as BS
    import Data.Set (Set)
    import qualified Data.Set as Set

    {-
    ************************************************************************
    *                                                                      *
    *              The main function: addTicksToBinds
    *                                                                      *
    ************************************************************************
    -}

    addTicksToBinds
            :: HscEnv
            -> Module
            -> ModLocation          -- ... off the current module
            -> NameSet              -- Exported Ids.  When we call addTicksToBinds,
                                    -- isExportedId doesn't work yet (the desugarer
                                    -- hasn't set it), so we have to work from this set.
            -> [TyCon]              -- Type constructor in this module
            -> LHsBinds GhcTc
            -> IO (LHsBinds GhcTc, HpcInfo, Maybe ModBreaks)

    addTicksToBinds :: HscEnv
    -> Module
    -> ModLocation
    -> NameSet
    -> [TyCon]
    -> LHsBinds GhcTc
    -> IO (LHsBinds GhcTc, HpcInfo, Maybe ModBreaks)
    addTicksToBinds HscEnv
    hsc_env Module
    mod ModLocation
    mod_loc NameSet
    exports [TyCon]
    tyCons LHsBinds GhcTc
    binds
      | let dflags :: DynFlags
    dflags = HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env
            passes :: [TickishType]
    passes = DynFlags -> [TickishType]
    coveragePasses DynFlags
    dflags, Bool -> Bool
    not ([TickishType] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [TickishType]
    passes),
        Just FilePath
    orig_file <- ModLocation -> Maybe FilePath
    ml_hs_file ModLocation
    mod_loc = do

         let  orig_file2 :: FilePath
    orig_file2 = LHsBinds GhcTc -> FilePath -> FilePath
    guessSourceFile LHsBinds GhcTc
    binds FilePath
    orig_file

              tickPass :: TickishType
    -> (LHsBinds GhcTc, TickTransState)
    -> (LHsBinds GhcTc, TickTransState)
    tickPass TickishType
    tickish (LHsBinds GhcTc
    binds,TickTransState
    st) =
                let env :: TickTransEnv
    env = TTE :: FastString
    -> TickDensity
    -> DynFlags
    -> NameSet
    -> VarSet
    -> [FilePath]
    -> VarSet
    -> Set RealSrcSpan
    -> Module
    -> TickishType
    -> TickTransEnv
    TTE
                          { fileName :: FastString
    fileName     = FilePath -> FastString
    mkFastString FilePath
    orig_file2
                          , declPath :: [FilePath]
    declPath     = []
                          , tte_dflags :: DynFlags
    tte_dflags   = DynFlags
    dflags
                          , exports :: NameSet
    exports      = NameSet
    exports
                          , inlines :: VarSet
    inlines      = VarSet
    emptyVarSet
                          , inScope :: VarSet
    inScope      = VarSet
    emptyVarSet
                          , blackList :: Set RealSrcSpan
    blackList    = [RealSrcSpan] -> Set RealSrcSpan
    forall a. Ord a => [a] -> Set a
    Set.fromList ([RealSrcSpan] -> Set RealSrcSpan)
    -> [RealSrcSpan] -> Set RealSrcSpan
    forall a b. (a -> b) -> a -> b
    $
                                           (TyCon -> Maybe RealSrcSpan) -> [TyCon] -> [RealSrcSpan]
    forall a b. (a -> Maybe b) -> [a] -> [b]
    mapMaybe (\TyCon
    tyCon -> case Name -> SrcSpan
    forall a. NamedThing a => a -> SrcSpan
    getSrcSpan (TyCon -> Name
    tyConName TyCon
    tyCon) of
                                                                 RealSrcSpan RealSrcSpan
    l Maybe BufSpan
    _ -> RealSrcSpan -> Maybe RealSrcSpan
    forall a. a -> Maybe a
    Just RealSrcSpan
    l
                                                                 UnhelpfulSpan UnhelpfulSpanReason
    _ -> Maybe RealSrcSpan
    forall a. Maybe a
    Nothing)
                                                    [TyCon]
    tyCons
                          , density :: TickDensity
    density      = TickishType -> DynFlags -> TickDensity
    mkDensity TickishType
    tickish DynFlags
    dflags
                          , this_mod :: Module
    this_mod     = Module
    mod
                          , tickishType :: TickishType
    tickishType  = TickishType
    tickish
                          }
                    (LHsBinds GhcTc
    binds',FreeVars
    _,TickTransState
    st') = TM (LHsBinds GhcTc)
    -> TickTransEnv
    -> TickTransState
    -> (LHsBinds GhcTc, FreeVars, TickTransState)
    forall a.
    TM a
    -> TickTransEnv -> TickTransState -> (a, FreeVars, TickTransState)
    unTM (LHsBinds GhcTc -> TM (LHsBinds GhcTc)
    addTickLHsBinds LHsBinds GhcTc
    binds) TickTransEnv
    env TickTransState
    st
                in (LHsBinds GhcTc
    binds', TickTransState
    st')

              initState :: TickTransState
    initState = TT :: Int -> [MixEntry_] -> CostCentreState -> TickTransState
    TT { tickBoxCount :: Int
    tickBoxCount = Int
    0
                             , mixEntries :: [MixEntry_]
    mixEntries   = []
                             , ccIndices :: CostCentreState
    ccIndices    = CostCentreState
    newCostCentreState
                             }

              (LHsBinds GhcTc
    binds1,TickTransState
    st) = (TickishType
     -> (LHsBinds GhcTc, TickTransState)
     -> (LHsBinds GhcTc, TickTransState))
    -> (LHsBinds GhcTc, TickTransState)
    -> [TickishType]
    -> (LHsBinds GhcTc, TickTransState)
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr TickishType
    -> (LHsBinds GhcTc, TickTransState)
    -> (LHsBinds GhcTc, TickTransState)
    tickPass (LHsBinds GhcTc
    binds, TickTransState
    initState) [TickishType]
    passes

         let tickCount :: Int
    tickCount = TickTransState -> Int
    tickBoxCount TickTransState
    st
             entries :: [MixEntry_]
    entries = [MixEntry_] -> [MixEntry_]
    forall a. [a] -> [a]
    reverse ([MixEntry_] -> [MixEntry_]) -> [MixEntry_] -> [MixEntry_]
    forall a b. (a -> b) -> a -> b
    $ TickTransState -> [MixEntry_]
    mixEntries TickTransState
    st
         Int
    hashNo <- DynFlags -> Module -> Int -> [MixEntry_] -> FilePath -> IO Int
    writeMixEntries DynFlags
    dflags Module
    mod Int
    tickCount [MixEntry_]
    entries FilePath
    orig_file2
         Maybe ModBreaks
    modBreaks <- HscEnv -> Module -> Int -> [MixEntry_] -> IO (Maybe ModBreaks)
    mkModBreaks HscEnv
    hsc_env Module
    mod Int
    tickCount [MixEntry_]
    entries

         DynFlags -> DumpFlag -> FilePath -> DumpFormat -> SDoc -> IO ()
    dumpIfSet_dyn DynFlags
    dflags DumpFlag
    Opt_D_dump_ticked FilePath
    "HPC" DumpFormat
    FormatHaskell
           (LHsBinds GhcTc -> SDoc
    forall (idL :: Pass) (idR :: Pass).
    (OutputableBndrId idL, OutputableBndrId idR) =>
    LHsBindsLR (GhcPass idL) (GhcPass idR) -> SDoc
    pprLHsBinds LHsBinds GhcTc
    binds1)

         (LHsBinds GhcTc, HpcInfo, Maybe ModBreaks)
    -> IO (LHsBinds GhcTc, HpcInfo, Maybe ModBreaks)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LHsBinds GhcTc
    binds1, Int -> Int -> HpcInfo
    HpcInfo Int
    tickCount Int
    hashNo, Maybe ModBreaks
    modBreaks)

      | Bool
    otherwise = (LHsBinds GhcTc, HpcInfo, Maybe ModBreaks)
    -> IO (LHsBinds GhcTc, HpcInfo, Maybe ModBreaks)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LHsBinds GhcTc
    binds, Bool -> HpcInfo
    emptyHpcInfo Bool
    False, Maybe ModBreaks
    forall a. Maybe a
    Nothing)

    guessSourceFile :: LHsBinds GhcTc -> FilePath -> FilePath
    guessSourceFile :: LHsBinds GhcTc -> FilePath -> FilePath
    guessSourceFile LHsBinds GhcTc
    binds FilePath
    orig_file =
         -- Try look for a file generated from a .hsc file to a
         -- .hs file, by peeking ahead.
         let top_pos :: [FastString]
    top_pos = [Maybe FastString] -> [FastString]
    forall a. [Maybe a] -> [a]
    catMaybes ([Maybe FastString] -> [FastString])
    -> [Maybe FastString] -> [FastString]
    forall a b. (a -> b) -> a -> b
    $ (GenLocated SrcSpan (HsBindLR GhcTc GhcTc)
     -> [Maybe FastString] -> [Maybe FastString])
    -> [Maybe FastString] -> LHsBinds GhcTc -> [Maybe FastString]
    forall (t :: * -> *) a b.
    Foldable t =>
    (a -> b -> b) -> b -> t a -> b
    foldr (\ (L SrcSpan
    pos HsBindLR GhcTc GhcTc
    _) [Maybe FastString]
    rest ->
                                     SrcSpan -> Maybe FastString
    srcSpanFileName_maybe SrcSpan
    pos Maybe FastString -> [Maybe FastString] -> [Maybe FastString]
    forall a. a -> [a] -> [a]
    : [Maybe FastString]
    rest) [] LHsBinds GhcTc
    binds
         in
         case [FastString]
    top_pos of
            (FastString
    file_name:[FastString]
    _) | FilePath
    ".hsc" FilePath -> FilePath -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isSuffixOf` FastString -> FilePath
    unpackFS FastString
    file_name
                          -> FastString -> FilePath
    unpackFS FastString
    file_name
            [FastString]
    _ -> FilePath
    orig_file

    mkModBreaks :: HscEnv -> Module -> Int -> [MixEntry_] -> IO (Maybe ModBreaks)
    mkModBreaks :: HscEnv -> Module -> Int -> [MixEntry_] -> IO (Maybe ModBreaks)
    mkModBreaks HscEnv
    hsc_env Module
    mod Int
    count [MixEntry_]
    entries
      | DynFlags -> Bool
    breakpointsEnabled (HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env) = do
        ForeignRef BreakArray
    breakArray <- HscEnv -> Int -> IO (ForeignRef BreakArray)
    GHCi.newBreakArray HscEnv
    hsc_env ([MixEntry_] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [MixEntry_]
    entries)
        Array Int (RemotePtr CostCentre)
    ccs <- HscEnv
    -> Module
    -> Int
    -> [MixEntry_]
    -> IO (Array Int (RemotePtr CostCentre))
    mkCCSArray HscEnv
    hsc_env Module
    mod Int
    count [MixEntry_]
    entries
        let
               locsTicks :: Array Int SrcSpan
    locsTicks  = (Int, Int) -> [SrcSpan] -> Array Int SrcSpan
    forall i e. Ix i => (i, i) -> [e] -> Array i e
    listArray (Int
    0,Int
    countInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) [ SrcSpan
    span  | (SrcSpan
    span,[FilePath]
    _,[OccName]
    _,BoxLabel
    _)  <- [MixEntry_]
    entries ]
               varsTicks :: Array Int [OccName]
    varsTicks  = (Int, Int) -> [[OccName]] -> Array Int [OccName]
    forall i e. Ix i => (i, i) -> [e] -> Array i e
    listArray (Int
    0,Int
    countInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) [ [OccName]
    vars  | (SrcSpan
    _,[FilePath]
    _,[OccName]
    vars,BoxLabel
    _)  <- [MixEntry_]
    entries ]
               declsTicks :: Array Int [FilePath]
    declsTicks = (Int, Int) -> [[FilePath]] -> Array Int [FilePath]
    forall i e. Ix i => (i, i) -> [e] -> Array i e
    listArray (Int
    0,Int
    countInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) [ [FilePath]
    decls | (SrcSpan
    _,[FilePath]
    decls,[OccName]
    _,BoxLabel
    _) <- [MixEntry_]
    entries ]
        Maybe ModBreaks -> IO (Maybe ModBreaks)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe ModBreaks -> IO (Maybe ModBreaks))
    -> Maybe ModBreaks -> IO (Maybe ModBreaks)
    forall a b. (a -> b) -> a -> b
    $ ModBreaks -> Maybe ModBreaks
    forall a. a -> Maybe a
    Just (ModBreaks -> Maybe ModBreaks) -> ModBreaks -> Maybe ModBreaks
    forall a b. (a -> b) -> a -> b
    $ ModBreaks
    emptyModBreaks
                           { modBreaks_flags :: ForeignRef BreakArray
    modBreaks_flags = ForeignRef BreakArray
    breakArray
                           , modBreaks_locs :: Array Int SrcSpan
    modBreaks_locs  = Array Int SrcSpan
    locsTicks
                           , modBreaks_vars :: Array Int [OccName]
    modBreaks_vars  = Array Int [OccName]
    varsTicks
                           , modBreaks_decls :: Array Int [FilePath]
    modBreaks_decls = Array Int [FilePath]
    declsTicks
                           , modBreaks_ccs :: Array Int (RemotePtr CostCentre)
    modBreaks_ccs   = Array Int (RemotePtr CostCentre)
    ccs
                           }
      | Bool
    otherwise = Maybe ModBreaks -> IO (Maybe ModBreaks)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe ModBreaks
    forall a. Maybe a
    Nothing

    mkCCSArray
      :: HscEnv -> Module -> Int -> [MixEntry_]
      -> IO (Array BreakIndex (RemotePtr GHC.Stack.CCS.CostCentre))
    mkCCSArray :: HscEnv
    -> Module
    -> Int
    -> [MixEntry_]
    -> IO (Array Int (RemotePtr CostCentre))
    mkCCSArray HscEnv
    hsc_env Module
    modul Int
    count [MixEntry_]
    entries = do
      case HscEnv -> Maybe Interp
    hsc_interp HscEnv
    hsc_env of
        Just Interp
    interp | Interp -> Bool
    GHCi.interpreterProfiled Interp
    interp -> do
          let module_str :: FilePath
    module_str = ModuleName -> FilePath
    moduleNameString (Module -> ModuleName
    forall unit. GenModule unit -> ModuleName
    moduleName Module
    modul)
          [RemotePtr CostCentre]
    costcentres <- HscEnv
    -> FilePath -> [(FilePath, FilePath)] -> IO [RemotePtr CostCentre]
    GHCi.mkCostCentres HscEnv
    hsc_env FilePath
    module_str ((MixEntry_ -> (FilePath, FilePath))
    -> [MixEntry_] -> [(FilePath, FilePath)]
    forall a b. (a -> b) -> [a] -> [b]
    map MixEntry_ -> (FilePath, FilePath)
    mk_one [MixEntry_]
    entries)
          Array Int (RemotePtr CostCentre)
    -> IO (Array Int (RemotePtr CostCentre))
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Int, Int)
    -> [RemotePtr CostCentre] -> Array Int (RemotePtr CostCentre)
    forall i e. Ix i => (i, i) -> [e] -> Array i e
    listArray (Int
    0,Int
    countInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    1) [RemotePtr CostCentre]
    costcentres)

        Maybe Interp
    _ -> Array Int (RemotePtr CostCentre)
    -> IO (Array Int (RemotePtr CostCentre))
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Int, Int)
    -> [RemotePtr CostCentre] -> Array Int (RemotePtr CostCentre)
    forall i e. Ix i => (i, i) -> [e] -> Array i e
    listArray (Int
    0,-Int
    1) [])
     where
        dflags :: DynFlags
    dflags = HscEnv -> DynFlags
    hsc_dflags HscEnv
    hsc_env
        mk_one :: MixEntry_ -> (FilePath, FilePath)
    mk_one (SrcSpan
    srcspan, [FilePath]
    decl_path, [OccName]
    _, BoxLabel
    _) = (FilePath
    name, FilePath
    src)
          where name :: FilePath
    name = [FilePath] -> FilePath
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat (FilePath -> [FilePath] -> [FilePath]
    forall a. a -> [a] -> [a]
    intersperse FilePath
    "." [FilePath]
    decl_path)
                src :: FilePath
    src = DynFlags -> SDoc -> FilePath
    showSDoc DynFlags
    dflags (SrcSpan -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr SrcSpan
    srcspan)

    writeMixEntries
      :: DynFlags -> Module -> Int -> [MixEntry_] -> FilePath -> IO Int
    writeMixEntries :: DynFlags -> Module -> Int -> [MixEntry_] -> FilePath -> IO Int
    writeMixEntries DynFlags
    dflags Module
    mod Int
    count [MixEntry_]
    entries FilePath
    filename
      | Bool -> Bool
    not (GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_Hpc DynFlags
    dflags) = Int -> IO Int
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    0
      | Bool
    otherwise   = do
            let
                hpc_dir :: FilePath
    hpc_dir = DynFlags -> FilePath
    hpcDir DynFlags
    dflags
                mod_name :: FilePath
    mod_name = ModuleName -> FilePath
    moduleNameString (Module -> ModuleName
    forall unit. GenModule unit -> ModuleName
    moduleName Module
    mod)

                hpc_mod_dir :: FilePath
    hpc_mod_dir
                  | Module -> Unit
    forall unit. GenModule unit -> unit
    moduleUnit Module
    mod Unit -> Unit -> Bool
    forall a. Eq a => a -> a -> Bool
    == Unit
    mainUnit  = FilePath
    hpc_dir
                  | Bool
    otherwise = FilePath
    hpc_dir FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ FilePath
    "/" FilePath -> FilePath -> FilePath
    forall a. [a] -> [a] -> [a]
    ++ Unit -> FilePath
    unitString (Module -> Unit
    forall unit. GenModule unit -> unit
    moduleUnit Module
    mod)

                tabStop :: Int
    tabStop = Int
    8 -- <tab> counts as a normal char in GHC's
                            -- location ranges.

            Bool -> FilePath -> IO ()
    createDirectoryIfMissing Bool
    True FilePath
    hpc_mod_dir
            UTCTime
    modTime <- FilePath -> IO UTCTime
    getModificationUTCTime FilePath
    filename
            let entries' :: [(HpcPos, BoxLabel)]
    entries' = [ (HpcPos
    hpcPos, BoxLabel
    box)
                           | (SrcSpan
    span,[FilePath]
    _,[OccName]
    _,BoxLabel
    box) <- [MixEntry_]
    entries, HpcPos
    hpcPos <- [SrcSpan -> HpcPos
    mkHpcPos SrcSpan
    span] ]
            Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when ([(HpcPos, BoxLabel)]
    entries' [(HpcPos, BoxLabel)] -> Int -> Bool
    forall a. [a] -> Int -> Bool
    `lengthIsNot` Int
    count) (IO () -> IO ()) -> IO () -> IO ()
    forall a b. (a -> b) -> a -> b
    $ do
              FilePath -> IO ()
    forall a. FilePath -> a
    panic FilePath
    "the number of .mix entries are inconsistent"
            let hashNo :: Int
    hashNo = FilePath -> UTCTime -> Int -> [(HpcPos, BoxLabel)] -> Int
    mixHash FilePath
    filename UTCTime
    modTime Int
    tabStop [(HpcPos, BoxLabel)]
    entries'
            FilePath -> FilePath -> Mix -> IO ()
    mixCreate FilePath
    hpc_mod_dir FilePath
    mod_name
                           (Mix -> IO ()) -> Mix -> IO ()
    forall a b. (a -> b) -> a -> b
    $ FilePath -> UTCTime -> Hash -> Int -> [(HpcPos, BoxLabel)] -> Mix
    Mix FilePath
    filename UTCTime
    modTime (Int -> Hash
    forall a. HpcHash a => a -> Hash
    toHash Int
    hashNo) Int
    tabStop [(HpcPos, BoxLabel)]
    entries'
            Int -> IO Int
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    hashNo

    -- -----------------------------------------------------------------------------
    -- TickDensity: where to insert ticks

    data TickDensity
      = TickForCoverage       -- for Hpc
      | TickForBreakPoints    -- for GHCi
      | TickAllFunctions      -- for -prof-auto-all
      | TickTopFunctions      -- for -prof-auto-top
      | TickExportedFunctions -- for -prof-auto-exported
      | TickCallSites         -- for stack tracing
      deriving TickDensity -> TickDensity -> Bool
    (TickDensity -> TickDensity -> Bool)
    -> (TickDensity -> TickDensity -> Bool) -> Eq TickDensity
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: TickDensity -> TickDensity -> Bool
    $c/= :: TickDensity -> TickDensity -> Bool
    == :: TickDensity -> TickDensity -> Bool
    $c== :: TickDensity -> TickDensity -> Bool
    Eq

    mkDensity :: TickishType -> DynFlags -> TickDensity
    mkDensity :: TickishType -> DynFlags -> TickDensity
    mkDensity TickishType
    tickish DynFlags
    dflags = case TickishType
    tickish of
      TickishType
    HpcTicks             -> TickDensity
    TickForCoverage
      TickishType
    SourceNotes          -> TickDensity
    TickForCoverage
      TickishType
    Breakpoints          -> TickDensity
    TickForBreakPoints
      TickishType
    ProfNotes ->
        case DynFlags -> ProfAuto
    profAuto DynFlags
    dflags of
          ProfAuto
    ProfAutoAll      -> TickDensity
    TickAllFunctions
          ProfAuto
    ProfAutoTop      -> TickDensity
    TickTopFunctions
          ProfAuto
    ProfAutoExports  -> TickDensity
    TickExportedFunctions
          ProfAuto
    ProfAutoCalls    -> TickDensity
    TickCallSites
          ProfAuto
    _other           -> FilePath -> TickDensity
    forall a. FilePath -> a
    panic FilePath
    "mkDensity"

    -- | Decide whether to add a tick to a binding or not.
    shouldTickBind  :: TickDensity
                    -> Bool         -- top level?
                    -> Bool         -- exported?
                    -> Bool         -- simple pat bind?
                    -> Bool         -- INLINE pragma?
                    -> Bool

    shouldTickBind :: TickDensity -> Bool -> Bool -> Bool -> Bool -> Bool
    shouldTickBind TickDensity
    density Bool
    top_lev Bool
    exported Bool
    _simple_pat Bool
    inline
     = case TickDensity
    density of
          TickDensity
    TickForBreakPoints    -> Bool
    False
            -- we never add breakpoints to simple pattern bindings
            -- (there's always a tick on the rhs anyway).
          TickDensity
    TickAllFunctions      -> Bool -> Bool
    not Bool
    inline
          TickDensity
    TickTopFunctions      -> Bool
    top_lev Bool -> Bool -> Bool
    && Bool -> Bool
    not Bool
    inline
          TickDensity
    TickExportedFunctions -> Bool
    exported Bool -> Bool -> Bool
    && Bool -> Bool
    not Bool
    inline
          TickDensity
    TickForCoverage       -> Bool
    True
          TickDensity
    TickCallSites         -> Bool
    False

    shouldTickPatBind :: TickDensity -> Bool -> Bool
    shouldTickPatBind :: TickDensity -> Bool -> Bool
    shouldTickPatBind TickDensity
    density Bool
    top_lev
      = case TickDensity
    density of
          TickDensity
    TickForBreakPoints    -> Bool
    False
          TickDensity
    TickAllFunctions      -> Bool
    True
          TickDensity
    TickTopFunctions      -> Bool
    top_lev
          TickDensity
    TickExportedFunctions -> Bool
    False
          TickDensity
    TickForCoverage       -> Bool
    False
          TickDensity
    TickCallSites         -> Bool
    False

    -- -----------------------------------------------------------------------------
    -- Adding ticks to bindings

    addTickLHsBinds :: LHsBinds GhcTc -> TM (LHsBinds GhcTc)
    addTickLHsBinds :: LHsBinds GhcTc -> TM (LHsBinds GhcTc)
    addTickLHsBinds = (GenLocated SrcSpan (HsBindLR GhcTc GhcTc)
     -> TM (GenLocated SrcSpan (HsBindLR GhcTc GhcTc)))
    -> LHsBinds GhcTc -> TM (LHsBinds GhcTc)
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Bag a -> m (Bag b)
    mapBagM GenLocated SrcSpan (HsBindLR GhcTc GhcTc)
    -> TM (GenLocated SrcSpan (HsBindLR GhcTc GhcTc))
    addTickLHsBind

    addTickLHsBind :: LHsBind GhcTc -> TM (LHsBind GhcTc)
    addTickLHsBind :: GenLocated SrcSpan (HsBindLR GhcTc GhcTc)
    -> TM (GenLocated SrcSpan (HsBindLR GhcTc GhcTc))
    addTickLHsBind (L SrcSpan
    pos bind :: HsBindLR GhcTc GhcTc
    bind@(AbsBinds { abs_binds :: forall idL idR. HsBindLR idL idR -> LHsBinds idL
    abs_binds   = LHsBinds GhcTc
    binds,
                                           abs_exports :: forall idL idR. HsBindLR idL idR -> [ABExport idL]
    abs_exports = [ABExport GhcTc]
    abs_exports })) = do
      (TickTransEnv -> TickTransEnv)
    -> TM (GenLocated SrcSpan (HsBindLR GhcTc GhcTc))
    -> TM (GenLocated SrcSpan (HsBindLR GhcTc GhcTc))
    forall a. (TickTransEnv -> TickTransEnv) -> TM a -> TM a
    withEnv TickTransEnv -> TickTransEnv
    add_exports (TM (GenLocated SrcSpan (HsBindLR GhcTc GhcTc))
     -> TM (GenLocated SrcSpan (HsBindLR GhcTc GhcTc)))
    -> TM (GenLocated SrcSpan (HsBindLR GhcTc GhcTc))
    -> TM (GenLocated SrcSpan (HsBindLR GhcTc GhcTc))
    forall a b. (a -> b) -> a -> b
    $ do
      (TickTransEnv -> TickTransEnv)
    -> TM (GenLocated SrcSpan (HsBindLR GhcTc GhcTc))
    -> TM (GenLocated SrcSpan (HsBindLR GhcTc GhcTc))
    forall a. (TickTransEnv -> TickTransEnv) -> TM a -> TM a
    withEnv TickTransEnv -> TickTransEnv
    add_inlines (TM (GenLocated SrcSpan (HsBindLR GhcTc GhcTc))
     -> TM (GenLocated SrcSpan (HsBindLR GhcTc GhcTc)))
    -> TM (GenLocated SrcSpan (HsBindLR GhcTc GhcTc))
    -> TM (GenLocated SrcSpan (HsBindLR GhcTc GhcTc))
    forall a b. (a -> b) -> a -> b
    $ do
      LHsBinds GhcTc
    binds' <- LHsBinds GhcTc -> TM (LHsBinds GhcTc)
    addTickLHsBinds LHsBinds GhcTc
    binds
      GenLocated SrcSpan (HsBindLR GhcTc GhcTc)
    -> TM (GenLocated SrcSpan (HsBindLR GhcTc GhcTc))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (GenLocated SrcSpan (HsBindLR GhcTc GhcTc)
     -> TM (GenLocated SrcSpan (HsBindLR GhcTc GhcTc)))
    -> GenLocated SrcSpan (HsBindLR GhcTc GhcTc)
    -> TM (GenLocated SrcSpan (HsBindLR GhcTc GhcTc))
    forall a b. (a -> b) -> a -> b
    $ SrcSpan
    -> HsBindLR GhcTc GhcTc
    -> GenLocated SrcSpan (HsBindLR GhcTc GhcTc)
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    pos (HsBindLR GhcTc GhcTc -> GenLocated SrcSpan (HsBindLR GhcTc GhcTc))
    -> HsBindLR GhcTc GhcTc
    -> GenLocated SrcSpan (HsBindLR GhcTc GhcTc)
    forall a b. (a -> b) -> a -> b
    $ HsBindLR GhcTc GhcTc
    bind { abs_binds :: LHsBinds GhcTc
    abs_binds = LHsBinds GhcTc
    binds' }
     where
       -- in AbsBinds, the Id on each binding is not the actual top-level
       -- Id that we are defining, they are related by the abs_exports
       -- field of AbsBinds.  So if we're doing TickExportedFunctions we need
       -- to add the local Ids to the set of exported Names so that we know to
       -- tick the right bindings.
       add_exports :: TickTransEnv -> TickTransEnv
    add_exports TickTransEnv
    env =
         TickTransEnv
    env{ exports :: NameSet
    exports = TickTransEnv -> NameSet
    exports TickTransEnv
    env NameSet -> [Name] -> NameSet
    `extendNameSetList`
                          [ Id -> Name
    idName Id
    IdP GhcTc
    mid
                          | ABE{ abe_poly :: forall p. ABExport p -> IdP p
    abe_poly = IdP GhcTc
    pid, abe_mono :: forall p. ABExport p -> IdP p
    abe_mono = IdP GhcTc
    mid } <- [ABExport GhcTc]
    abs_exports
                          , Id -> Name
    idName Id
    IdP GhcTc
    pid Name -> NameSet -> Bool
    `elemNameSet` (TickTransEnv -> NameSet
    exports TickTransEnv
    env) ] }

       -- See Note [inline sccs]
       add_inlines :: TickTransEnv -> TickTransEnv
    add_inlines TickTransEnv
    env =
         TickTransEnv
    env{ inlines :: VarSet
    inlines = TickTransEnv -> VarSet
    inlines TickTransEnv
    env VarSet -> [Id] -> VarSet
    `extendVarSetList`
                          [ Id
    IdP GhcTc
    mid
                          | ABE{ abe_poly :: forall p. ABExport p -> IdP p
    abe_poly = IdP GhcTc
    pid, abe_mono :: forall p. ABExport p -> IdP p
    abe_mono = IdP GhcTc
    mid } <- [ABExport GhcTc]
    abs_exports
                          , InlinePragma -> Bool
    isInlinePragma (Id -> InlinePragma
    idInlinePragma Id
    IdP GhcTc
    pid) ] }

    addTickLHsBind (L SrcSpan
    pos (funBind :: HsBindLR GhcTc GhcTc
    funBind@(FunBind { fun_id :: forall idL idR. HsBindLR idL idR -> Located (IdP idL)
    fun_id = L SrcSpan
    _ IdP GhcTc
    id }))) = do
      let name :: FilePath
    name = Id -> FilePath
    forall a. NamedThing a => a -> FilePath
    getOccString Id
    IdP GhcTc
    id
      [FilePath]
    decl_path <- TM [FilePath]
    getPathEntry
      TickDensity
    density <- TM TickDensity
    getDensity

      VarSet
    inline_ids <- (TickTransEnv -> VarSet) -> TM TickTransEnv -> TM VarSet
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM TickTransEnv -> VarSet
    inlines TM TickTransEnv
    getEnv
      -- See Note [inline sccs]
      let inline :: Bool
    inline   = InlinePragma -> Bool
    isInlinePragma (Id -> InlinePragma
    idInlinePragma Id
    IdP GhcTc
    id)
                     Bool -> Bool -> Bool
    || Id
    IdP GhcTc
    id Id -> VarSet -> Bool
    `elemVarSet` VarSet
    inline_ids

      -- See Note [inline sccs]
      TickishType
    tickish <- TickTransEnv -> TickishType
    tickishType (TickTransEnv -> TickishType) -> TM TickTransEnv -> TM TickishType
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    `liftM` TM TickTransEnv
    getEnv
      if Bool
    inline Bool -> Bool -> Bool
    && TickishType
    tickish TickishType -> TickishType -> Bool
    forall a. Eq a => a -> a -> Bool
    == TickishType
    ProfNotes then GenLocated SrcSpan (HsBindLR GhcTc GhcTc)
    -> TM (GenLocated SrcSpan (HsBindLR GhcTc GhcTc))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SrcSpan
    -> HsBindLR GhcTc GhcTc
    -> GenLocated SrcSpan (HsBindLR GhcTc GhcTc)
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    pos HsBindLR GhcTc GhcTc
    funBind) else do

      (FreeVars
    fvs, MatchGroup GhcTc (LHsExpr GhcTc)
    mg) <-
            TM (MatchGroup GhcTc (LHsExpr GhcTc))
    -> TM (FreeVars, MatchGroup GhcTc (LHsExpr GhcTc))
    forall a. TM a -> TM (FreeVars, a)
    getFreeVars (TM (MatchGroup GhcTc (LHsExpr GhcTc))
     -> TM (FreeVars, MatchGroup GhcTc (LHsExpr GhcTc)))
    -> TM (MatchGroup GhcTc (LHsExpr GhcTc))
    -> TM (FreeVars, MatchGroup GhcTc (LHsExpr GhcTc))
    forall a b. (a -> b) -> a -> b
    $
            FilePath
    -> TM (MatchGroup GhcTc (LHsExpr GhcTc))
    -> TM (MatchGroup GhcTc (LHsExpr GhcTc))
    forall a. FilePath -> TM a -> TM a
    addPathEntry FilePath
    name (TM (MatchGroup GhcTc (LHsExpr GhcTc))
     -> TM (MatchGroup GhcTc (LHsExpr GhcTc)))
    -> TM (MatchGroup GhcTc (LHsExpr GhcTc))
    -> TM (MatchGroup GhcTc (LHsExpr GhcTc))
    forall a b. (a -> b) -> a -> b
    $
            Bool
    -> MatchGroup GhcTc (LHsExpr GhcTc)
    -> TM (MatchGroup GhcTc (LHsExpr GhcTc))
    addTickMatchGroup Bool
    False (HsBindLR GhcTc GhcTc -> MatchGroup GhcTc (LHsExpr GhcTc)
    forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
    fun_matches HsBindLR GhcTc GhcTc
    funBind)

      Bool
    blackListed <- SrcSpan -> TM Bool
    isBlackListed SrcSpan
    pos
      NameSet
    exported_names <- (TickTransEnv -> NameSet) -> TM TickTransEnv -> TM NameSet
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM TickTransEnv -> NameSet
    exports TM TickTransEnv
    getEnv

      -- We don't want to generate code for blacklisted positions
      -- We don't want redundant ticks on simple pattern bindings
      -- We don't want to tick non-exported bindings in TickExportedFunctions
      let simple :: Bool
    simple = HsBindLR GhcTc GhcTc -> Bool
    isSimplePatBind HsBindLR GhcTc GhcTc
    funBind
          toplev :: Bool
    toplev = [FilePath] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [FilePath]
    decl_path
          exported :: Bool
    exported = Id -> Name
    idName Id
    IdP GhcTc
    id Name -> NameSet -> Bool
    `elemNameSet` NameSet
    exported_names

      Maybe (Tickish Id)
    tick <- if Bool -> Bool
    not Bool
    blackListed Bool -> Bool -> Bool
    &&
                   TickDensity -> Bool -> Bool -> Bool -> Bool -> Bool
    shouldTickBind TickDensity
    density Bool
    toplev Bool
    exported Bool
    simple Bool
    inline
                 then
                    TickDensity
    -> FilePath -> SrcSpan -> FreeVars -> TM (Maybe (Tickish Id))
    bindTick TickDensity
    density FilePath
    name SrcSpan
    pos FreeVars
    fvs
                 else
                    Maybe (Tickish Id) -> TM (Maybe (Tickish Id))
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (Tickish Id)
    forall a. Maybe a
    Nothing

      let mbCons :: Maybe a -> [a] -> [a]
    mbCons = ([a] -> [a]) -> (a -> [a] -> [a]) -> Maybe a -> [a] -> [a]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [a] -> [a]
    forall a. a -> a
    Prelude.id (:)
      GenLocated SrcSpan (HsBindLR GhcTc GhcTc)
    -> TM (GenLocated SrcSpan (HsBindLR GhcTc GhcTc))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (GenLocated SrcSpan (HsBindLR GhcTc GhcTc)
     -> TM (GenLocated SrcSpan (HsBindLR GhcTc GhcTc)))
    -> GenLocated SrcSpan (HsBindLR GhcTc GhcTc)
    -> TM (GenLocated SrcSpan (HsBindLR GhcTc GhcTc))
    forall a b. (a -> b) -> a -> b
    $ SrcSpan
    -> HsBindLR GhcTc GhcTc
    -> GenLocated SrcSpan (HsBindLR GhcTc GhcTc)
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    pos (HsBindLR GhcTc GhcTc -> GenLocated SrcSpan (HsBindLR GhcTc GhcTc))
    -> HsBindLR GhcTc GhcTc
    -> GenLocated SrcSpan (HsBindLR GhcTc GhcTc)
    forall a b. (a -> b) -> a -> b
    $ HsBindLR GhcTc GhcTc
    funBind { fun_matches :: MatchGroup GhcTc (LHsExpr GhcTc)
    fun_matches = MatchGroup GhcTc (LHsExpr GhcTc)
    mg
                               , fun_tick :: [Tickish Id]
    fun_tick = Maybe (Tickish Id)
    tick Maybe (Tickish Id) -> [Tickish Id] -> [Tickish Id]
    forall {a}. Maybe a -> [a] -> [a]
    `mbCons` HsBindLR GhcTc GhcTc -> [Tickish Id]
    forall idL idR. HsBindLR idL idR -> [Tickish Id]
    fun_tick HsBindLR GhcTc GhcTc
    funBind }

       where
       -- a binding is a simple pattern binding if it is a funbind with
       -- zero patterns
       isSimplePatBind :: HsBind GhcTc -> Bool
       isSimplePatBind :: HsBindLR GhcTc GhcTc -> Bool
    isSimplePatBind HsBindLR GhcTc GhcTc
    funBind = MatchGroup GhcTc (LHsExpr GhcTc) -> Int
    forall (id :: Pass) body. MatchGroup (GhcPass id) body -> Int
    matchGroupArity (HsBindLR GhcTc GhcTc -> MatchGroup GhcTc (LHsExpr GhcTc)
    forall idL idR. HsBindLR idL idR -> MatchGroup idR (LHsExpr idR)
    fun_matches HsBindLR GhcTc GhcTc
    funBind) Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    0

    -- TODO: Revisit this
    addTickLHsBind (L SrcSpan
    pos (pat :: HsBindLR GhcTc GhcTc
    pat@(PatBind { pat_lhs :: forall idL idR. HsBindLR idL idR -> LPat idL
    pat_lhs = LPat GhcTc
    lhs
                                        , pat_rhs :: forall idL idR. HsBindLR idL idR -> GRHSs idR (LHsExpr idR)
    pat_rhs = GRHSs GhcTc (LHsExpr GhcTc)
    rhs }))) = do

      let simplePatId :: Maybe (IdP GhcTc)
    simplePatId = LPat GhcTc -> Maybe (IdP GhcTc)
    forall (x :: Pass). LPat (GhcPass x) -> Maybe (IdP (GhcPass x))
    isSimplePat LPat GhcTc
    lhs

      -- TODO: better name for rhs's for non-simple patterns?
      let name :: FilePath
    name = FilePath -> (Id -> FilePath) -> Maybe Id -> FilePath
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe FilePath
    "(...)" Id -> FilePath
    forall a. NamedThing a => a -> FilePath
    getOccString Maybe Id
    Maybe (IdP GhcTc)
    simplePatId

      (FreeVars
    fvs, GRHSs GhcTc (LHsExpr GhcTc)
    rhs') <- TM (GRHSs GhcTc (LHsExpr GhcTc))
    -> TM (FreeVars, GRHSs GhcTc (LHsExpr GhcTc))
    forall a. TM a -> TM (FreeVars, a)
    getFreeVars (TM (GRHSs GhcTc (LHsExpr GhcTc))
     -> TM (FreeVars, GRHSs GhcTc (LHsExpr GhcTc)))
    -> TM (GRHSs GhcTc (LHsExpr GhcTc))
    -> TM (FreeVars, GRHSs GhcTc (LHsExpr GhcTc))
    forall a b. (a -> b) -> a -> b
    $ FilePath
    -> TM (GRHSs GhcTc (LHsExpr GhcTc))
    -> TM (GRHSs GhcTc (LHsExpr GhcTc))
    forall a. FilePath -> TM a -> TM a
    addPathEntry FilePath
    name (TM (GRHSs GhcTc (LHsExpr GhcTc))
     -> TM (GRHSs GhcTc (LHsExpr GhcTc)))
    -> TM (GRHSs GhcTc (LHsExpr GhcTc))
    -> TM (GRHSs GhcTc (LHsExpr GhcTc))
    forall a b. (a -> b) -> a -> b
    $ Bool
    -> Bool
    -> GRHSs GhcTc (LHsExpr GhcTc)
    -> TM (GRHSs GhcTc (LHsExpr GhcTc))
    addTickGRHSs Bool
    False Bool
    False GRHSs GhcTc (LHsExpr GhcTc)
    rhs
      let pat' :: HsBindLR GhcTc GhcTc
    pat' = HsBindLR GhcTc GhcTc
    pat { pat_rhs :: GRHSs GhcTc (LHsExpr GhcTc)
    pat_rhs = GRHSs GhcTc (LHsExpr GhcTc)
    rhs'}

      -- Should create ticks here?
      TickDensity
    density <- TM TickDensity
    getDensity
      [FilePath]
    decl_path <- TM [FilePath]
    getPathEntry
      let top_lev :: Bool
    top_lev = [FilePath] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [FilePath]
    decl_path
      if Bool -> Bool
    not (TickDensity -> Bool -> Bool
    shouldTickPatBind TickDensity
    density Bool
    top_lev)
        then GenLocated SrcSpan (HsBindLR GhcTc GhcTc)
    -> TM (GenLocated SrcSpan (HsBindLR GhcTc GhcTc))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SrcSpan
    -> HsBindLR GhcTc GhcTc
    -> GenLocated SrcSpan (HsBindLR GhcTc GhcTc)
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    pos HsBindLR GhcTc GhcTc
    pat')
        else do

        let mbCons :: Maybe a -> [a] -> [a]
    mbCons = ([a] -> [a]) -> (a -> [a] -> [a]) -> Maybe a -> [a] -> [a]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [a] -> [a]
    forall a. a -> a
    id (:)

        let ([Tickish Id]
    initial_rhs_ticks, [[Tickish Id]]
    initial_patvar_tickss) = HsBindLR GhcTc GhcTc -> ([Tickish Id], [[Tickish Id]])
    forall idL idR. HsBindLR idL idR -> ([Tickish Id], [[Tickish Id]])
    pat_ticks HsBindLR GhcTc GhcTc
    pat'

        -- Allocate the ticks

        Maybe (Tickish Id)
    rhs_tick <- TickDensity
    -> FilePath -> SrcSpan -> FreeVars -> TM (Maybe (Tickish Id))
    bindTick TickDensity
    density FilePath
    name SrcSpan
    pos FreeVars
    fvs
        let rhs_ticks :: [Tickish Id]
    rhs_ticks = Maybe (Tickish Id)
    rhs_tick Maybe (Tickish Id) -> [Tickish Id] -> [Tickish Id]
    forall {a}. Maybe a -> [a] -> [a]
    `mbCons` [Tickish Id]
    initial_rhs_ticks

        [[Tickish Id]]
    patvar_tickss <- case Maybe (IdP GhcTc)
    simplePatId of
          Just{} -> [[Tickish Id]] -> TM [[Tickish Id]]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [[Tickish Id]]
    initial_patvar_tickss
          Maybe (IdP GhcTc)
    Nothing -> do
            let patvars :: [FilePath]
    patvars = (Id -> FilePath) -> [Id] -> [FilePath]
    forall a b. (a -> b) -> [a] -> [b]
    map Id -> FilePath
    forall a. NamedThing a => a -> FilePath
    getOccString (LPat GhcTc -> [IdP GhcTc]
    forall p. CollectPass p => LPat p -> [IdP p]
    collectPatBinders LPat GhcTc
    lhs)
            [Maybe (Tickish Id)]
    patvar_ticks <- (FilePath -> TM (Maybe (Tickish Id)))
    -> [FilePath] -> TM [Maybe (Tickish Id)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (\FilePath
    v -> TickDensity
    -> FilePath -> SrcSpan -> FreeVars -> TM (Maybe (Tickish Id))
    bindTick TickDensity
    density FilePath
    v SrcSpan
    pos FreeVars
    fvs) [FilePath]
    patvars
            [[Tickish Id]] -> TM [[Tickish Id]]
    forall (m :: * -> *) a. Monad m => a -> m a
    return
              ((Maybe (Tickish Id) -> [Tickish Id] -> [Tickish Id])
    -> [Maybe (Tickish Id)] -> [[Tickish Id]] -> [[Tickish Id]]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Maybe (Tickish Id) -> [Tickish Id] -> [Tickish Id]
    forall {a}. Maybe a -> [a] -> [a]
    mbCons [Maybe (Tickish Id)]
    patvar_ticks
                              ([[Tickish Id]]
    initial_patvar_tickss [[Tickish Id]] -> [[Tickish Id]] -> [[Tickish Id]]
    forall a. [a] -> [a] -> [a]
    ++ [Tickish Id] -> [[Tickish Id]]
    forall a. a -> [a]
    repeat []))

        GenLocated SrcSpan (HsBindLR GhcTc GhcTc)
    -> TM (GenLocated SrcSpan (HsBindLR GhcTc GhcTc))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (GenLocated SrcSpan (HsBindLR GhcTc GhcTc)
     -> TM (GenLocated SrcSpan (HsBindLR GhcTc GhcTc)))
    -> GenLocated SrcSpan (HsBindLR GhcTc GhcTc)
    -> TM (GenLocated SrcSpan (HsBindLR GhcTc GhcTc))
    forall a b. (a -> b) -> a -> b
    $ SrcSpan
    -> HsBindLR GhcTc GhcTc
    -> GenLocated SrcSpan (HsBindLR GhcTc GhcTc)
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    pos (HsBindLR GhcTc GhcTc -> GenLocated SrcSpan (HsBindLR GhcTc GhcTc))
    -> HsBindLR GhcTc GhcTc
    -> GenLocated SrcSpan (HsBindLR GhcTc GhcTc)
    forall a b. (a -> b) -> a -> b
    $ HsBindLR GhcTc GhcTc
    pat' { pat_ticks :: ([Tickish Id], [[Tickish Id]])
    pat_ticks = ([Tickish Id]
    rhs_ticks, [[Tickish Id]]
    patvar_tickss) }

    -- Only internal stuff, not from source, uses VarBind, so we ignore it.
    addTickLHsBind var_bind :: GenLocated SrcSpan (HsBindLR GhcTc GhcTc)
    var_bind@(L SrcSpan
    _ (VarBind {})) = GenLocated SrcSpan (HsBindLR GhcTc GhcTc)
    -> TM (GenLocated SrcSpan (HsBindLR GhcTc GhcTc))
    forall (m :: * -> *) a. Monad m => a -> m a
    return GenLocated SrcSpan (HsBindLR GhcTc GhcTc)
    var_bind
    addTickLHsBind patsyn_bind :: GenLocated SrcSpan (HsBindLR GhcTc GhcTc)
    patsyn_bind@(L SrcSpan
    _ (PatSynBind {})) = GenLocated SrcSpan (HsBindLR GhcTc GhcTc)
    -> TM (GenLocated SrcSpan (HsBindLR GhcTc GhcTc))
    forall (m :: * -> *) a. Monad m => a -> m a
    return GenLocated SrcSpan (HsBindLR GhcTc GhcTc)
    patsyn_bind

    bindTick
      :: TickDensity -> String -> SrcSpan -> FreeVars -> TM (Maybe (Tickish Id))
    bindTick :: TickDensity
    -> FilePath -> SrcSpan -> FreeVars -> TM (Maybe (Tickish Id))
    bindTick TickDensity
    density FilePath
    name SrcSpan
    pos FreeVars
    fvs = do
      [FilePath]
    decl_path <- TM [FilePath]
    getPathEntry
      let
          toplev :: Bool
    toplev        = [FilePath] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [FilePath]
    decl_path
          count_entries :: Bool
    count_entries = Bool
    toplev Bool -> Bool -> Bool
    || TickDensity
    density TickDensity -> TickDensity -> Bool
    forall a. Eq a => a -> a -> Bool
    == TickDensity
    TickAllFunctions
          top_only :: Bool
    top_only      = TickDensity
    density TickDensity -> TickDensity -> Bool
    forall a. Eq a => a -> a -> Bool
    /= TickDensity
    TickAllFunctions
          box_label :: BoxLabel
    box_label     = if Bool
    toplev then [FilePath] -> BoxLabel
    TopLevelBox [FilePath
    name]
                                    else [FilePath] -> BoxLabel
    LocalBox ([FilePath]
    decl_path [FilePath] -> [FilePath] -> [FilePath]
    forall a. [a] -> [a] -> [a]
    ++ [FilePath
    name])
      --
      BoxLabel
    -> Bool -> Bool -> SrcSpan -> FreeVars -> TM (Maybe (Tickish Id))
    allocATickBox BoxLabel
    box_label Bool
    count_entries Bool
    top_only SrcSpan
    pos FreeVars
    fvs

    -- Note [inline sccs]
    --
    -- The reason not to add ticks to INLINE functions is that this is
    -- sometimes handy for avoiding adding a tick to a particular function
    -- (see #6131)
    --
    -- So for now we do not add any ticks to INLINE functions at all.
    --
    -- We used to use isAnyInlinePragma to figure out whether to avoid adding
    -- ticks for this purpose. However, #12962 indicates that this contradicts
    -- the documentation on profiling (which only mentions INLINE pragmas).
    -- So now we're more careful about what we avoid adding ticks to.

    -- -----------------------------------------------------------------------------
    -- Decorate an LHsExpr with ticks

    -- selectively add ticks to interesting expressions
    addTickLHsExpr :: LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExpr :: LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExpr e :: LHsExpr GhcTc
    e@(L SrcSpan
    pos HsExpr GhcTc
    e0) = do
      TickDensity
    d <- TM TickDensity
    getDensity
      case TickDensity
    d of
        TickDensity
    TickForBreakPoints | HsExpr GhcTc -> Bool
    isGoodBreakExpr HsExpr GhcTc
    e0 -> TM (LHsExpr GhcTc)
    tick_it
        TickDensity
    TickForCoverage    -> TM (LHsExpr GhcTc)
    tick_it
        TickDensity
    TickCallSites      | HsExpr GhcTc -> Bool
    isCallSite HsExpr GhcTc
    e0      -> TM (LHsExpr GhcTc)
    tick_it
        TickDensity
    _other             -> TM (LHsExpr GhcTc)
    dont_tick_it
     where
       tick_it :: TM (LHsExpr GhcTc)
    tick_it      = BoxLabel
    -> Bool
    -> Bool
    -> SrcSpan
    -> TM (HsExpr GhcTc)
    -> TM (LHsExpr GhcTc)
    allocTickBox (Bool -> BoxLabel
    ExpBox Bool
    False) Bool
    False Bool
    False SrcSpan
    pos (TM (HsExpr GhcTc) -> TM (LHsExpr GhcTc))
    -> TM (HsExpr GhcTc) -> TM (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ HsExpr GhcTc -> TM (HsExpr GhcTc)
    addTickHsExpr HsExpr GhcTc
    e0
       dont_tick_it :: TM (LHsExpr GhcTc)
    dont_tick_it = LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExprNever LHsExpr GhcTc
    e

    -- Add a tick to an expression which is the RHS of an equation or a binding.
    -- We always consider these to be breakpoints, unless the expression is a 'let'
    -- (because the body will definitely have a tick somewhere).  ToDo: perhaps
    -- we should treat 'case' and 'if' the same way?
    addTickLHsExprRHS :: LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExprRHS :: LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExprRHS e :: LHsExpr GhcTc
    e@(L SrcSpan
    pos HsExpr GhcTc
    e0) = do
      TickDensity
    d <- TM TickDensity
    getDensity
      case TickDensity
    d of
         TickDensity
    TickForBreakPoints | HsLet{} <- HsExpr GhcTc
    e0 -> TM (LHsExpr GhcTc)
    dont_tick_it
                            | Bool
    otherwise     -> TM (LHsExpr GhcTc)
    tick_it
         TickDensity
    TickForCoverage -> TM (LHsExpr GhcTc)
    tick_it
         TickDensity
    TickCallSites   | HsExpr GhcTc -> Bool
    isCallSite HsExpr GhcTc
    e0 -> TM (LHsExpr GhcTc)
    tick_it
         TickDensity
    _other          -> TM (LHsExpr GhcTc)
    dont_tick_it
     where
       tick_it :: TM (LHsExpr GhcTc)
    tick_it      = BoxLabel
    -> Bool
    -> Bool
    -> SrcSpan
    -> TM (HsExpr GhcTc)
    -> TM (LHsExpr GhcTc)
    allocTickBox (Bool -> BoxLabel
    ExpBox Bool
    False) Bool
    False Bool
    False SrcSpan
    pos (TM (HsExpr GhcTc) -> TM (LHsExpr GhcTc))
    -> TM (HsExpr GhcTc) -> TM (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ HsExpr GhcTc -> TM (HsExpr GhcTc)
    addTickHsExpr HsExpr GhcTc
    e0
       dont_tick_it :: TM (LHsExpr GhcTc)
    dont_tick_it = LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExprNever LHsExpr GhcTc
    e

    -- The inner expression of an evaluation context:
    --    let binds in [], ( [] )
    -- we never tick these if we're doing HPC, but otherwise
    -- we treat it like an ordinary expression.
    addTickLHsExprEvalInner :: LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExprEvalInner :: LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExprEvalInner LHsExpr GhcTc
    e = do
       TickDensity
    d <- TM TickDensity
    getDensity
       case TickDensity
    d of
         TickDensity
    TickForCoverage -> LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExprNever LHsExpr GhcTc
    e
         TickDensity
    _otherwise      -> LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExpr LHsExpr GhcTc
    e

    -- | A let body is treated differently from addTickLHsExprEvalInner
    -- above with TickForBreakPoints, because for breakpoints we always
    -- want to tick the body, even if it is not a redex.  See test
    -- break012.  This gives the user the opportunity to inspect the
    -- values of the let-bound variables.
    addTickLHsExprLetBody :: LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExprLetBody :: LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExprLetBody e :: LHsExpr GhcTc
    e@(L SrcSpan
    pos HsExpr GhcTc
    e0) = do
      TickDensity
    d <- TM TickDensity
    getDensity
      case TickDensity
    d of
         TickDensity
    TickForBreakPoints | HsLet{} <- HsExpr GhcTc
    e0 -> TM (LHsExpr GhcTc)
    dont_tick_it
                            | Bool
    otherwise     -> TM (LHsExpr GhcTc)
    tick_it
         TickDensity
    _other -> LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExprEvalInner LHsExpr GhcTc
    e
     where
       tick_it :: TM (LHsExpr GhcTc)
    tick_it      = BoxLabel
    -> Bool
    -> Bool
    -> SrcSpan
    -> TM (HsExpr GhcTc)
    -> TM (LHsExpr GhcTc)
    allocTickBox (Bool -> BoxLabel
    ExpBox Bool
    False) Bool
    False Bool
    False SrcSpan
    pos (TM (HsExpr GhcTc) -> TM (LHsExpr GhcTc))
    -> TM (HsExpr GhcTc) -> TM (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ HsExpr GhcTc -> TM (HsExpr GhcTc)
    addTickHsExpr HsExpr GhcTc
    e0
       dont_tick_it :: TM (LHsExpr GhcTc)
    dont_tick_it = LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExprNever LHsExpr GhcTc
    e

    -- version of addTick that does not actually add a tick,
    -- because the scope of this tick is completely subsumed by
    -- another.
    addTickLHsExprNever :: LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExprNever :: LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExprNever (L SrcSpan
    pos HsExpr GhcTc
    e0) = do
        HsExpr GhcTc
    e1 <- HsExpr GhcTc -> TM (HsExpr GhcTc)
    addTickHsExpr HsExpr GhcTc
    e0
        LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LHsExpr GhcTc -> TM (LHsExpr GhcTc))
    -> LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ SrcSpan -> HsExpr GhcTc -> LHsExpr GhcTc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    pos HsExpr GhcTc
    e1

    -- general heuristic: expressions which do not denote values are good
    -- break points
    isGoodBreakExpr :: HsExpr GhcTc -> Bool
    isGoodBreakExpr :: HsExpr GhcTc -> Bool
    isGoodBreakExpr (HsApp {})     = Bool
    True
    isGoodBreakExpr (HsAppType {}) = Bool
    True
    isGoodBreakExpr (OpApp {})     = Bool
    True
    isGoodBreakExpr HsExpr GhcTc
    _other         = Bool
    False

    isCallSite :: HsExpr GhcTc -> Bool
    isCallSite :: HsExpr GhcTc -> Bool
    isCallSite HsApp{}     = Bool
    True
    isCallSite HsAppType{} = Bool
    True
    isCallSite OpApp{}     = Bool
    True
    isCallSite HsExpr GhcTc
    _ = Bool
    False

    addTickLHsExprOptAlt :: Bool -> LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExprOptAlt :: Bool -> LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExprOptAlt Bool
    oneOfMany (L SrcSpan
    pos HsExpr GhcTc
    e0)
      = TickDensity
    -> TM (LHsExpr GhcTc) -> TM (LHsExpr GhcTc) -> TM (LHsExpr GhcTc)
    forall a. TickDensity -> TM a -> TM a -> TM a
    ifDensity TickDensity
    TickForCoverage
            (BoxLabel
    -> Bool
    -> Bool
    -> SrcSpan
    -> TM (HsExpr GhcTc)
    -> TM (LHsExpr GhcTc)
    allocTickBox (Bool -> BoxLabel
    ExpBox Bool
    oneOfMany) Bool
    False Bool
    False SrcSpan
    pos (TM (HsExpr GhcTc) -> TM (LHsExpr GhcTc))
    -> TM (HsExpr GhcTc) -> TM (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ HsExpr GhcTc -> TM (HsExpr GhcTc)
    addTickHsExpr HsExpr GhcTc
    e0)
            (LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExpr (SrcSpan -> HsExpr GhcTc -> LHsExpr GhcTc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    pos HsExpr GhcTc
    e0))

    addBinTickLHsExpr :: (Bool -> BoxLabel) -> LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addBinTickLHsExpr :: (Bool -> BoxLabel) -> LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addBinTickLHsExpr Bool -> BoxLabel
    boxLabel (L SrcSpan
    pos HsExpr GhcTc
    e0)
      = TickDensity
    -> TM (LHsExpr GhcTc) -> TM (LHsExpr GhcTc) -> TM (LHsExpr GhcTc)
    forall a. TickDensity -> TM a -> TM a -> TM a
    ifDensity TickDensity
    TickForCoverage
            ((Bool -> BoxLabel)
    -> SrcSpan -> TM (HsExpr GhcTc) -> TM (LHsExpr GhcTc)
    allocBinTickBox Bool -> BoxLabel
    boxLabel SrcSpan
    pos (TM (HsExpr GhcTc) -> TM (LHsExpr GhcTc))
    -> TM (HsExpr GhcTc) -> TM (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ HsExpr GhcTc -> TM (HsExpr GhcTc)
    addTickHsExpr HsExpr GhcTc
    e0)
            (LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExpr (SrcSpan -> HsExpr GhcTc -> LHsExpr GhcTc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    pos HsExpr GhcTc
    e0))

    -- -----------------------------------------------------------------------------
    -- Decorate the body of an HsExpr with ticks.
    -- (Whether to put a tick around the whole expression was already decided,
    -- in the addTickLHsExpr family of functions.)

    addTickHsExpr :: HsExpr GhcTc -> TM (HsExpr GhcTc)
    addTickHsExpr :: HsExpr GhcTc -> TM (HsExpr GhcTc)
    addTickHsExpr e :: HsExpr GhcTc
    e@(HsVar XVar GhcTc
    _ (L SrcSpan
    _ IdP GhcTc
    id)) = do Id -> TM ()
    freeVar Id
    IdP GhcTc
    id; HsExpr GhcTc -> TM (HsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return HsExpr GhcTc
    e
    addTickHsExpr (HsUnboundVar {})    = FilePath -> TM (HsExpr GhcTc)
    forall a. FilePath -> a
    panic FilePath
    "addTickHsExpr.HsUnboundVar"
    addTickHsExpr e :: HsExpr GhcTc
    e@(HsConLikeOut XConLikeOut GhcTc
    _ ConLike
    con)
      | Just Id
    id <- ConLike -> Maybe Id
    conLikeWrapId_maybe ConLike
    con = do Id -> TM ()
    freeVar Id
    id; HsExpr GhcTc -> TM (HsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return HsExpr GhcTc
    e
    addTickHsExpr e :: HsExpr GhcTc
    e@(HsIPVar {})       = HsExpr GhcTc -> TM (HsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return HsExpr GhcTc
    e
    addTickHsExpr e :: HsExpr GhcTc
    e@(HsOverLit {})     = HsExpr GhcTc -> TM (HsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return HsExpr GhcTc
    e
    addTickHsExpr e :: HsExpr GhcTc
    e@(HsOverLabel{})    = HsExpr GhcTc -> TM (HsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return HsExpr GhcTc
    e
    addTickHsExpr e :: HsExpr GhcTc
    e@(HsLit {})         = HsExpr GhcTc -> TM (HsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return HsExpr GhcTc
    e
    addTickHsExpr (HsLam XLam GhcTc
    x MatchGroup GhcTc (LHsExpr GhcTc)
    matchgroup) = (MatchGroup GhcTc (LHsExpr GhcTc) -> HsExpr GhcTc)
    -> TM (MatchGroup GhcTc (LHsExpr GhcTc)) -> TM (HsExpr GhcTc)
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM (XLam GhcTc -> MatchGroup GhcTc (LHsExpr GhcTc) -> HsExpr GhcTc
    forall p. XLam p -> MatchGroup p (LHsExpr p) -> HsExpr p
    HsLam XLam GhcTc
    x)
                                               (Bool
    -> MatchGroup GhcTc (LHsExpr GhcTc)
    -> TM (MatchGroup GhcTc (LHsExpr GhcTc))
    addTickMatchGroup Bool
    True MatchGroup GhcTc (LHsExpr GhcTc)
    matchgroup)
    addTickHsExpr (HsLamCase XLamCase GhcTc
    x MatchGroup GhcTc (LHsExpr GhcTc)
    mgs)    = (MatchGroup GhcTc (LHsExpr GhcTc) -> HsExpr GhcTc)
    -> TM (MatchGroup GhcTc (LHsExpr GhcTc)) -> TM (HsExpr GhcTc)
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM (XLamCase GhcTc -> MatchGroup GhcTc (LHsExpr GhcTc) -> HsExpr GhcTc
    forall p. XLamCase p -> MatchGroup p (LHsExpr p) -> HsExpr p
    HsLamCase XLamCase GhcTc
    x)
                                               (Bool
    -> MatchGroup GhcTc (LHsExpr GhcTc)
    -> TM (MatchGroup GhcTc (LHsExpr GhcTc))
    addTickMatchGroup Bool
    True MatchGroup GhcTc (LHsExpr GhcTc)
    mgs)
    addTickHsExpr (HsApp XApp GhcTc
    x LHsExpr GhcTc
    e1 LHsExpr GhcTc
    e2)      = (LHsExpr GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc)
    -> TM (LHsExpr GhcTc) -> TM (LHsExpr GhcTc) -> TM (HsExpr GhcTc)
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 (XApp GhcTc -> LHsExpr GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
    forall p. XApp p -> LHsExpr p -> LHsExpr p -> HsExpr p
    HsApp XApp GhcTc
    x) (LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExprNever LHsExpr GhcTc
    e1)
                                                          (LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExpr      LHsExpr GhcTc
    e2)
    addTickHsExpr (HsAppType XAppTypeE GhcTc
    x LHsExpr GhcTc
    e LHsWcType (NoGhcTc GhcTc)
    ty)   = (Type
     -> LHsExpr GhcTc -> LHsWcType (GhcPass 'Renamed) -> HsExpr GhcTc)
    -> TM Type
    -> TM (LHsExpr GhcTc)
    -> TM (LHsWcType (GhcPass 'Renamed))
    -> TM (HsExpr GhcTc)
    forall (m :: * -> *) a1 a2 a3 r.
    Monad m =>
    (a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
    liftM3 Type
    -> LHsExpr GhcTc -> LHsWcType (GhcPass 'Renamed) -> HsExpr GhcTc
    forall p.
    XAppTypeE p -> LHsExpr p -> LHsWcType (NoGhcTc p) -> HsExpr p
    HsAppType (Type -> TM Type
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    XAppTypeE GhcTc
    x)
                                                          (LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExprNever LHsExpr GhcTc
    e)
                                                          (LHsWcType (GhcPass 'Renamed) -> TM (LHsWcType (GhcPass 'Renamed))
    forall (m :: * -> *) a. Monad m => a -> m a
    return LHsWcType (GhcPass 'Renamed)
    LHsWcType (NoGhcTc GhcTc)
    ty)

    addTickHsExpr (OpApp XOpApp GhcTc
    fix LHsExpr GhcTc
    e1 LHsExpr GhcTc
    e2 LHsExpr GhcTc
    e3) =
            (Fixity
     -> LHsExpr GhcTc -> LHsExpr GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc)
    -> TM Fixity
    -> TM (LHsExpr GhcTc)
    -> TM (LHsExpr GhcTc)
    -> TM (LHsExpr GhcTc)
    -> TM (HsExpr GhcTc)
    forall (m :: * -> *) a1 a2 a3 a4 r.
    Monad m =>
    (a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r
    liftM4 Fixity
    -> LHsExpr GhcTc -> LHsExpr GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
    forall p.
    XOpApp p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
    OpApp
                    (Fixity -> TM Fixity
    forall (m :: * -> *) a. Monad m => a -> m a
    return Fixity
    XOpApp GhcTc
    fix)
                    (LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExpr LHsExpr GhcTc
    e1)
                    (LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExprNever LHsExpr GhcTc
    e2)
                    (LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExpr LHsExpr GhcTc
    e3)
    addTickHsExpr (NegApp XNegApp GhcTc
    x LHsExpr GhcTc
    e SyntaxExpr GhcTc
    neg) =
            (LHsExpr GhcTc -> SyntaxExprTc -> HsExpr GhcTc)
    -> TM (LHsExpr GhcTc) -> TM SyntaxExprTc -> TM (HsExpr GhcTc)
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 (XNegApp GhcTc -> LHsExpr GhcTc -> SyntaxExpr GhcTc -> HsExpr GhcTc
    forall p. XNegApp p -> LHsExpr p -> SyntaxExpr p -> HsExpr p
    NegApp XNegApp GhcTc
    x)
                    (LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExpr LHsExpr GhcTc
    e)
                    (SrcSpan -> SyntaxExpr GhcTc -> TM (SyntaxExpr GhcTc)
    addTickSyntaxExpr SrcSpan
    hpcSrcSpan SyntaxExpr GhcTc
    neg)
    addTickHsExpr (HsPar XPar GhcTc
    x LHsExpr GhcTc
    e) =
            (LHsExpr GhcTc -> HsExpr GhcTc)
    -> TM (LHsExpr GhcTc) -> TM (HsExpr GhcTc)
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM (XPar GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
    forall p. XPar p -> LHsExpr p -> HsExpr p
    HsPar XPar GhcTc
    x) (LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExprEvalInner LHsExpr GhcTc
    e)
    addTickHsExpr (SectionL XSectionL GhcTc
    x LHsExpr GhcTc
    e1 LHsExpr GhcTc
    e2) =
            (LHsExpr GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc)
    -> TM (LHsExpr GhcTc) -> TM (LHsExpr GhcTc) -> TM (HsExpr GhcTc)
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 (XSectionL GhcTc -> LHsExpr GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
    forall p. XSectionL p -> LHsExpr p -> LHsExpr p -> HsExpr p
    SectionL XSectionL GhcTc
    x)
                    (LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExpr LHsExpr GhcTc
    e1)
                    (LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExprNever LHsExpr GhcTc
    e2)
    addTickHsExpr (SectionR XSectionR GhcTc
    x LHsExpr GhcTc
    e1 LHsExpr GhcTc
    e2) =
            (LHsExpr GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc)
    -> TM (LHsExpr GhcTc) -> TM (LHsExpr GhcTc) -> TM (HsExpr GhcTc)
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 (XSectionR GhcTc -> LHsExpr GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
    forall p. XSectionR p -> LHsExpr p -> LHsExpr p -> HsExpr p
    SectionR XSectionR GhcTc
    x)
                    (LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExprNever LHsExpr GhcTc
    e1)
                    (LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExpr LHsExpr GhcTc
    e2)
    addTickHsExpr (ExplicitTuple XExplicitTuple GhcTc
    x [LHsTupArg GhcTc]
    es Boxity
    boxity) =
            ([LHsTupArg GhcTc] -> Boxity -> HsExpr GhcTc)
    -> TM [LHsTupArg GhcTc] -> TM Boxity -> TM (HsExpr GhcTc)
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 (XExplicitTuple GhcTc -> [LHsTupArg GhcTc] -> Boxity -> HsExpr GhcTc
    forall p. XExplicitTuple p -> [LHsTupArg p] -> Boxity -> HsExpr p
    ExplicitTuple XExplicitTuple GhcTc
    x)
                    ((LHsTupArg GhcTc -> TM (LHsTupArg GhcTc))
    -> [LHsTupArg GhcTc] -> TM [LHsTupArg GhcTc]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM LHsTupArg GhcTc -> TM (LHsTupArg GhcTc)
    addTickTupArg [LHsTupArg GhcTc]
    es)
                    (Boxity -> TM Boxity
    forall (m :: * -> *) a. Monad m => a -> m a
    return Boxity
    boxity)
    addTickHsExpr (ExplicitSum XExplicitSum GhcTc
    ty Int
    tag Int
    arity LHsExpr GhcTc
    e) = do
            LHsExpr GhcTc
    e' <- LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExpr LHsExpr GhcTc
    e
            HsExpr GhcTc -> TM (HsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XExplicitSum GhcTc -> Int -> Int -> LHsExpr GhcTc -> HsExpr GhcTc
    forall p. XExplicitSum p -> Int -> Int -> LHsExpr p -> HsExpr p
    ExplicitSum XExplicitSum GhcTc
    ty Int
    tag Int
    arity LHsExpr GhcTc
    e')
    addTickHsExpr (HsCase XCase GhcTc
    x LHsExpr GhcTc
    e MatchGroup GhcTc (LHsExpr GhcTc)
    mgs) =
            (LHsExpr GhcTc -> MatchGroup GhcTc (LHsExpr GhcTc) -> HsExpr GhcTc)
    -> TM (LHsExpr GhcTc)
    -> TM (MatchGroup GhcTc (LHsExpr GhcTc))
    -> TM (HsExpr GhcTc)
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 (XCase GhcTc
    -> LHsExpr GhcTc
    -> MatchGroup GhcTc (LHsExpr GhcTc)
    -> HsExpr GhcTc
    forall p.
    XCase p -> LHsExpr p -> MatchGroup p (LHsExpr p) -> HsExpr p
    HsCase XCase GhcTc
    x)
                    (LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExpr LHsExpr GhcTc
    e) -- not an EvalInner; e might not necessarily
                                       -- be evaluated.
                    (Bool
    -> MatchGroup GhcTc (LHsExpr GhcTc)
    -> TM (MatchGroup GhcTc (LHsExpr GhcTc))
    addTickMatchGroup Bool
    False MatchGroup GhcTc (LHsExpr GhcTc)
    mgs)
    addTickHsExpr (HsIf XIf GhcTc
    x LHsExpr GhcTc
    e1 LHsExpr GhcTc
    e2 LHsExpr GhcTc
    e3) =
            (LHsExpr GhcTc -> LHsExpr GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc)
    -> TM (LHsExpr GhcTc)
    -> TM (LHsExpr GhcTc)
    -> TM (LHsExpr GhcTc)
    -> TM (HsExpr GhcTc)
    forall (m :: * -> *) a1 a2 a3 r.
    Monad m =>
    (a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
    liftM3 (XIf GhcTc
    -> LHsExpr GhcTc -> LHsExpr GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
    forall p. XIf p -> LHsExpr p -> LHsExpr p -> LHsExpr p -> HsExpr p
    HsIf XIf GhcTc
    x)
                    ((Bool -> BoxLabel) -> LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addBinTickLHsExpr (CondBox -> Bool -> BoxLabel
    BinBox CondBox
    CondBinBox) LHsExpr GhcTc
    e1)
                    (Bool -> LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExprOptAlt Bool
    True LHsExpr GhcTc
    e2)
                    (Bool -> LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExprOptAlt Bool
    True LHsExpr GhcTc
    e3)
    addTickHsExpr (HsMultiIf XMultiIf GhcTc
    ty [LGRHS GhcTc (LHsExpr GhcTc)]
    alts)
      = do { let isOneOfMany :: Bool
    isOneOfMany = case [LGRHS GhcTc (LHsExpr GhcTc)]
    alts of [LGRHS GhcTc (LHsExpr GhcTc)
    _] -> Bool
    False; [LGRHS GhcTc (LHsExpr GhcTc)]
    _ -> Bool
    True
           ; [LGRHS GhcTc (LHsExpr GhcTc)]
    alts' <- (LGRHS GhcTc (LHsExpr GhcTc) -> TM (LGRHS GhcTc (LHsExpr GhcTc)))
    -> [LGRHS GhcTc (LHsExpr GhcTc)]
    -> TM [LGRHS GhcTc (LHsExpr GhcTc)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM ((GRHS GhcTc (LHsExpr GhcTc) -> TM (GRHS GhcTc (LHsExpr GhcTc)))
    -> LGRHS GhcTc (LHsExpr GhcTc) -> TM (LGRHS GhcTc (LHsExpr GhcTc))
    forall (m :: * -> *) a b l.
    Monad m =>
    (a -> m b) -> GenLocated l a -> m (GenLocated l b)
    liftL ((GRHS GhcTc (LHsExpr GhcTc) -> TM (GRHS GhcTc (LHsExpr GhcTc)))
     -> LGRHS GhcTc (LHsExpr GhcTc) -> TM (LGRHS GhcTc (LHsExpr GhcTc)))
    -> (GRHS GhcTc (LHsExpr GhcTc) -> TM (GRHS GhcTc (LHsExpr GhcTc)))
    -> LGRHS GhcTc (LHsExpr GhcTc)
    -> TM (LGRHS GhcTc (LHsExpr GhcTc))
    forall a b. (a -> b) -> a -> b
    $ Bool
    -> Bool
    -> GRHS GhcTc (LHsExpr GhcTc)
    -> TM (GRHS GhcTc (LHsExpr GhcTc))
    addTickGRHS Bool
    isOneOfMany Bool
    False) [LGRHS GhcTc (LHsExpr GhcTc)]
    alts
           ; HsExpr GhcTc -> TM (HsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HsExpr GhcTc -> TM (HsExpr GhcTc))
    -> HsExpr GhcTc -> TM (HsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ XMultiIf GhcTc -> [LGRHS GhcTc (LHsExpr GhcTc)] -> HsExpr GhcTc
    forall p. XMultiIf p -> [LGRHS p (LHsExpr p)] -> HsExpr p
    HsMultiIf XMultiIf GhcTc
    ty [LGRHS GhcTc (LHsExpr GhcTc)]
    alts' }
    addTickHsExpr (HsLet XLet GhcTc
    x (L SrcSpan
    l HsLocalBinds GhcTc
    binds) LHsExpr GhcTc
    e) =
            [Id] -> TM (HsExpr GhcTc) -> TM (HsExpr GhcTc)
    forall a. [Id] -> TM a -> TM a
    bindLocals (HsLocalBinds GhcTc -> [IdP GhcTc]
    forall (idL :: Pass) (idR :: Pass).
    CollectPass (GhcPass idL) =>
    HsLocalBindsLR (GhcPass idL) (GhcPass idR) -> [IdP (GhcPass idL)]
    collectLocalBinders HsLocalBinds GhcTc
    binds) (TM (HsExpr GhcTc) -> TM (HsExpr GhcTc))
    -> TM (HsExpr GhcTc) -> TM (HsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $
              (HsLocalBinds GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc)
    -> TM (HsLocalBinds GhcTc)
    -> TM (LHsExpr GhcTc)
    -> TM (HsExpr GhcTc)
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 (XLet GhcTc
    -> GenLocated SrcSpan (HsLocalBinds GhcTc)
    -> LHsExpr GhcTc
    -> HsExpr GhcTc
    forall p. XLet p -> LHsLocalBinds p -> LHsExpr p -> HsExpr p
    HsLet XLet GhcTc
    x (GenLocated SrcSpan (HsLocalBinds GhcTc)
     -> LHsExpr GhcTc -> HsExpr GhcTc)
    -> (HsLocalBinds GhcTc -> GenLocated SrcSpan (HsLocalBinds GhcTc))
    -> HsLocalBinds GhcTc
    -> LHsExpr GhcTc
    -> HsExpr GhcTc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SrcSpan
    -> HsLocalBinds GhcTc -> GenLocated SrcSpan (HsLocalBinds GhcTc)
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    l)
                      (HsLocalBinds GhcTc -> TM (HsLocalBinds GhcTc)
    addTickHsLocalBinds HsLocalBinds GhcTc
    binds) -- to think about: !patterns.
                      (LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExprLetBody LHsExpr GhcTc
    e)
    addTickHsExpr (HsDo XDo GhcTc
    srcloc HsStmtContext (GhcPass 'Renamed)
    cxt (L SrcSpan
    l [ExprLStmt GhcTc]
    stmts))
      = do { ([ExprLStmt GhcTc]
    stmts', ()
    _) <- Maybe (Bool -> BoxLabel)
    -> [ExprLStmt GhcTc] -> TM () -> TM ([ExprLStmt GhcTc], ())
    forall a.
    Maybe (Bool -> BoxLabel)
    -> [ExprLStmt GhcTc] -> TM a -> TM ([ExprLStmt GhcTc], a)
    addTickLStmts' Maybe (Bool -> BoxLabel)
    forQual [ExprLStmt GhcTc]
    stmts (() -> TM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())
           ; HsExpr GhcTc -> TM (HsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XDo GhcTc
    -> HsStmtContext (GhcPass 'Renamed)
    -> GenLocated SrcSpan [ExprLStmt GhcTc]
    -> HsExpr GhcTc
    forall p.
    XDo p
    -> HsStmtContext (GhcPass 'Renamed)
    -> Located [ExprLStmt p]
    -> HsExpr p
    HsDo XDo GhcTc
    srcloc HsStmtContext (GhcPass 'Renamed)
    cxt (SrcSpan
    -> [ExprLStmt GhcTc] -> GenLocated SrcSpan [ExprLStmt GhcTc]
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    l [ExprLStmt GhcTc]
    stmts')) }
      where
            forQual :: Maybe (Bool -> BoxLabel)
    forQual = case HsStmtContext (GhcPass 'Renamed)
    cxt of
                        HsStmtContext (GhcPass 'Renamed)
    ListComp -> (Bool -> BoxLabel) -> Maybe (Bool -> BoxLabel)
    forall a. a -> Maybe a
    Just ((Bool -> BoxLabel) -> Maybe (Bool -> BoxLabel))
    -> (Bool -> BoxLabel) -> Maybe (Bool -> BoxLabel)
    forall a b. (a -> b) -> a -> b
    $ CondBox -> Bool -> BoxLabel
    BinBox CondBox
    QualBinBox
                        HsStmtContext (GhcPass 'Renamed)
    _        -> Maybe (Bool -> BoxLabel)
    forall a. Maybe a
    Nothing
    addTickHsExpr (ExplicitList XExplicitList GhcTc
    ty Maybe (SyntaxExpr GhcTc)
    wit [LHsExpr GhcTc]
    es) =
            (Type -> Maybe SyntaxExprTc -> [LHsExpr GhcTc] -> HsExpr GhcTc)
    -> TM Type
    -> TM (Maybe SyntaxExprTc)
    -> TM [LHsExpr GhcTc]
    -> TM (HsExpr GhcTc)
    forall (m :: * -> *) a1 a2 a3 r.
    Monad m =>
    (a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
    liftM3 Type -> Maybe SyntaxExprTc -> [LHsExpr GhcTc] -> HsExpr GhcTc
    forall p.
    XExplicitList p -> Maybe (SyntaxExpr p) -> [LHsExpr p] -> HsExpr p
    ExplicitList
                    (Type -> TM Type
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    XExplicitList GhcTc
    ty)
                    (Maybe SyntaxExprTc -> TM (Maybe SyntaxExprTc)
    addTickWit Maybe (SyntaxExpr GhcTc)
    Maybe SyntaxExprTc
    wit)
                    ((LHsExpr GhcTc -> TM (LHsExpr GhcTc))
    -> [LHsExpr GhcTc] -> TM [LHsExpr GhcTc]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExpr) [LHsExpr GhcTc]
    es)
                 where addTickWit :: Maybe SyntaxExprTc -> TM (Maybe SyntaxExprTc)
    addTickWit Maybe SyntaxExprTc
    Nothing = Maybe SyntaxExprTc -> TM (Maybe SyntaxExprTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe SyntaxExprTc
    forall a. Maybe a
    Nothing
                       addTickWit (Just SyntaxExprTc
    fln)
                         = do SyntaxExprTc
    fln' <- SrcSpan -> SyntaxExpr GhcTc -> TM (SyntaxExpr GhcTc)
    addTickSyntaxExpr SrcSpan
    hpcSrcSpan SyntaxExpr GhcTc
    SyntaxExprTc
    fln
                              Maybe SyntaxExprTc -> TM (Maybe SyntaxExprTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SyntaxExprTc -> Maybe SyntaxExprTc
    forall a. a -> Maybe a
    Just SyntaxExprTc
    fln')

    addTickHsExpr (HsStatic XStatic GhcTc
    fvs LHsExpr GhcTc
    e) = XStatic GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
    forall p. XStatic p -> LHsExpr p -> HsExpr p
    HsStatic XStatic GhcTc
    fvs (LHsExpr GhcTc -> HsExpr GhcTc)
    -> TM (LHsExpr GhcTc) -> TM (HsExpr GhcTc)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExpr LHsExpr GhcTc
    e

    addTickHsExpr expr :: HsExpr GhcTc
    expr@(RecordCon { rcon_flds :: forall p. HsExpr p -> HsRecordBinds p
    rcon_flds = HsRecordBinds GhcTc
    rec_binds })
      = do { HsRecordBinds GhcTc
    rec_binds' <- HsRecordBinds GhcTc -> TM (HsRecordBinds GhcTc)
    addTickHsRecordBinds HsRecordBinds GhcTc
    rec_binds
           ; HsExpr GhcTc -> TM (HsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HsExpr GhcTc
    expr { rcon_flds :: HsRecordBinds GhcTc
    rcon_flds = HsRecordBinds GhcTc
    rec_binds' }) }

    addTickHsExpr expr :: HsExpr GhcTc
    expr@(RecordUpd { rupd_expr :: forall p. HsExpr p -> LHsExpr p
    rupd_expr = LHsExpr GhcTc
    e, rupd_flds :: forall p. HsExpr p -> [LHsRecUpdField p]
    rupd_flds = [LHsRecUpdField GhcTc]
    flds })
      = do { LHsExpr GhcTc
    e' <- LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExpr LHsExpr GhcTc
    e
           ; [LHsRecUpdField GhcTc]
    flds' <- (LHsRecUpdField GhcTc -> TM (LHsRecUpdField GhcTc))
    -> [LHsRecUpdField GhcTc] -> TM [LHsRecUpdField GhcTc]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM LHsRecUpdField GhcTc -> TM (LHsRecUpdField GhcTc)
    forall id.
    LHsRecField' id (LHsExpr GhcTc)
    -> TM (LHsRecField' id (LHsExpr GhcTc))
    addTickHsRecField [LHsRecUpdField GhcTc]
    flds
           ; HsExpr GhcTc -> TM (HsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HsExpr GhcTc
    expr { rupd_expr :: LHsExpr GhcTc
    rupd_expr = LHsExpr GhcTc
    e', rupd_flds :: [LHsRecUpdField GhcTc]
    rupd_flds = [LHsRecUpdField GhcTc]
    flds' }) }

    addTickHsExpr (ExprWithTySig XExprWithTySig GhcTc
    x LHsExpr GhcTc
    e LHsSigWcType (NoGhcTc GhcTc)
    ty) =
            (NoExtField
     -> LHsExpr GhcTc
     -> LHsSigWcType (GhcPass 'Renamed)
     -> HsExpr GhcTc)
    -> TM NoExtField
    -> TM (LHsExpr GhcTc)
    -> TM (LHsSigWcType (GhcPass 'Renamed))
    -> TM (HsExpr GhcTc)
    forall (m :: * -> *) a1 a2 a3 r.
    Monad m =>
    (a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
    liftM3 NoExtField
    -> LHsExpr GhcTc -> LHsSigWcType (GhcPass 'Renamed) -> HsExpr GhcTc
    forall p.
    XExprWithTySig p
    -> LHsExpr p -> LHsSigWcType (NoGhcTc p) -> HsExpr p
    ExprWithTySig
                    (NoExtField -> TM NoExtField
    forall (m :: * -> *) a. Monad m => a -> m a
    return NoExtField
    XExprWithTySig GhcTc
    x)
                    (LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExprNever LHsExpr GhcTc
    e) -- No need to tick the inner expression
                                            -- for expressions with signatures
                    (LHsSigWcType (GhcPass 'Renamed)
    -> TM (LHsSigWcType (GhcPass 'Renamed))
    forall (m :: * -> *) a. Monad m => a -> m a
    return LHsSigWcType (GhcPass 'Renamed)
    LHsSigWcType (NoGhcTc GhcTc)
    ty)
    addTickHsExpr (ArithSeq XArithSeq GhcTc
    ty Maybe (SyntaxExpr GhcTc)
    wit ArithSeqInfo GhcTc
    arith_seq) =
            (HsExpr GhcTc
     -> Maybe SyntaxExprTc -> ArithSeqInfo GhcTc -> HsExpr GhcTc)
    -> TM (HsExpr GhcTc)
    -> TM (Maybe SyntaxExprTc)
    -> TM (ArithSeqInfo GhcTc)
    -> TM (HsExpr GhcTc)
    forall (m :: * -> *) a1 a2 a3 r.
    Monad m =>
    (a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
    liftM3 HsExpr GhcTc
    -> Maybe SyntaxExprTc -> ArithSeqInfo GhcTc -> HsExpr GhcTc
    forall p.
    XArithSeq p -> Maybe (SyntaxExpr p) -> ArithSeqInfo p -> HsExpr p
    ArithSeq
                    (HsExpr GhcTc -> TM (HsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return XArithSeq GhcTc
    HsExpr GhcTc
    ty)
                    (Maybe SyntaxExprTc -> TM (Maybe SyntaxExprTc)
    addTickWit Maybe (SyntaxExpr GhcTc)
    Maybe SyntaxExprTc
    wit)
                    (ArithSeqInfo GhcTc -> TM (ArithSeqInfo GhcTc)
    addTickArithSeqInfo ArithSeqInfo GhcTc
    arith_seq)
                 where addTickWit :: Maybe SyntaxExprTc -> TM (Maybe SyntaxExprTc)
    addTickWit Maybe SyntaxExprTc
    Nothing = Maybe SyntaxExprTc -> TM (Maybe SyntaxExprTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe SyntaxExprTc
    forall a. Maybe a
    Nothing
                       addTickWit (Just SyntaxExprTc
    fl) = do SyntaxExprTc
    fl' <- SrcSpan -> SyntaxExpr GhcTc -> TM (SyntaxExpr GhcTc)
    addTickSyntaxExpr SrcSpan
    hpcSrcSpan SyntaxExpr GhcTc
    SyntaxExprTc
    fl
                                                 Maybe SyntaxExprTc -> TM (Maybe SyntaxExprTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SyntaxExprTc -> Maybe SyntaxExprTc
    forall a. a -> Maybe a
    Just SyntaxExprTc
    fl')

    -- We might encounter existing ticks (multiple Coverage passes)
    addTickHsExpr (HsTick XTick GhcTc
    x Tickish (IdP GhcTc)
    t LHsExpr GhcTc
    e) =
            (LHsExpr GhcTc -> HsExpr GhcTc)
    -> TM (LHsExpr GhcTc) -> TM (HsExpr GhcTc)
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM (XTick GhcTc -> Tickish (IdP GhcTc) -> LHsExpr GhcTc -> HsExpr GhcTc
    forall p. XTick p -> Tickish (IdP p) -> LHsExpr p -> HsExpr p
    HsTick XTick GhcTc
    x Tickish (IdP GhcTc)
    t) (LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExprNever LHsExpr GhcTc
    e)
    addTickHsExpr (HsBinTick XBinTick GhcTc
    x Int
    t0 Int
    t1 LHsExpr GhcTc
    e) =
            (LHsExpr GhcTc -> HsExpr GhcTc)
    -> TM (LHsExpr GhcTc) -> TM (HsExpr GhcTc)
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM (XBinTick GhcTc -> Int -> Int -> LHsExpr GhcTc -> HsExpr GhcTc
    forall p. XBinTick p -> Int -> Int -> LHsExpr p -> HsExpr p
    HsBinTick XBinTick GhcTc
    x Int
    t0 Int
    t1) (LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExprNever LHsExpr GhcTc
    e)

    addTickHsExpr (HsPragE XPragE GhcTc
    _ HsPragTick{} (L SrcSpan
    pos HsExpr GhcTc
    e0)) = do
        LHsExpr GhcTc
    e2 <- BoxLabel
    -> Bool
    -> Bool
    -> SrcSpan
    -> TM (HsExpr GhcTc)
    -> TM (LHsExpr GhcTc)
    allocTickBox (Bool -> BoxLabel
    ExpBox Bool
    False) Bool
    False Bool
    False SrcSpan
    pos (TM (HsExpr GhcTc) -> TM (LHsExpr GhcTc))
    -> TM (HsExpr GhcTc) -> TM (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $
                    HsExpr GhcTc -> TM (HsExpr GhcTc)
    addTickHsExpr HsExpr GhcTc
    e0
        HsExpr GhcTc -> TM (HsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HsExpr GhcTc -> TM (HsExpr GhcTc))
    -> HsExpr GhcTc -> TM (HsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ LHsExpr GhcTc -> HsExpr GhcTc
    forall l e. GenLocated l e -> e
    unLoc LHsExpr GhcTc
    e2
    addTickHsExpr (HsPragE XPragE GhcTc
    x HsPragE GhcTc
    p LHsExpr GhcTc
    e) =
            (LHsExpr GhcTc -> HsExpr GhcTc)
    -> TM (LHsExpr GhcTc) -> TM (HsExpr GhcTc)
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM (XPragE GhcTc -> HsPragE GhcTc -> LHsExpr GhcTc -> HsExpr GhcTc
    forall p. XPragE p -> HsPragE p -> LHsExpr p -> HsExpr p
    HsPragE XPragE GhcTc
    x HsPragE GhcTc
    p) (LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExpr LHsExpr GhcTc
    e)
    addTickHsExpr e :: HsExpr GhcTc
    e@(HsBracket     {})   = HsExpr GhcTc -> TM (HsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return HsExpr GhcTc
    e
    addTickHsExpr e :: HsExpr GhcTc
    e@(HsTcBracketOut  {}) = HsExpr GhcTc -> TM (HsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return HsExpr GhcTc
    e
    addTickHsExpr e :: HsExpr GhcTc
    e@(HsRnBracketOut  {}) = HsExpr GhcTc -> TM (HsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return HsExpr GhcTc
    e
    addTickHsExpr e :: HsExpr GhcTc
    e@(HsSpliceE  {})      = HsExpr GhcTc -> TM (HsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return HsExpr GhcTc
    e
    addTickHsExpr (HsProc XProc GhcTc
    x LPat GhcTc
    pat LHsCmdTop GhcTc
    cmdtop) =
            (Located (Pat GhcTc) -> LHsCmdTop GhcTc -> HsExpr GhcTc)
    -> TM (Located (Pat GhcTc))
    -> TM (LHsCmdTop GhcTc)
    -> TM (HsExpr GhcTc)
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 (XProc GhcTc -> LPat GhcTc -> LHsCmdTop GhcTc -> HsExpr GhcTc
    forall p. XProc p -> LPat p -> LHsCmdTop p -> HsExpr p
    HsProc XProc GhcTc
    x)
                    (LPat GhcTc -> TM (LPat GhcTc)
    addTickLPat LPat GhcTc
    pat)
                    ((HsCmdTop GhcTc -> TM (HsCmdTop GhcTc))
    -> LHsCmdTop GhcTc -> TM (LHsCmdTop GhcTc)
    forall (m :: * -> *) a b l.
    Monad m =>
    (a -> m b) -> GenLocated l a -> m (GenLocated l b)
    liftL (HsCmdTop GhcTc -> TM (HsCmdTop GhcTc)
    addTickHsCmdTop) LHsCmdTop GhcTc
    cmdtop)
    addTickHsExpr (XExpr (WrapExpr (HsWrap HsWrapper
    w HsExpr GhcTc
    e))) =
            (HsExpr GhcTc -> HsExpr GhcTc)
    -> TM (HsExpr GhcTc) -> TM (HsExpr GhcTc)
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM (XXExprGhcTc -> HsExpr GhcTc
    forall p. XXExpr p -> HsExpr p
    XExpr (XXExprGhcTc -> HsExpr GhcTc)
    -> (HsExpr GhcTc -> XXExprGhcTc) -> HsExpr GhcTc -> HsExpr GhcTc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HsWrap HsExpr -> XXExprGhcTc
    WrapExpr (HsWrap HsExpr -> XXExprGhcTc)
    -> (HsExpr GhcTc -> HsWrap HsExpr) -> HsExpr GhcTc -> XXExprGhcTc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HsWrapper -> HsExpr GhcTc -> HsWrap HsExpr
    forall (hs_syn :: * -> *).
    HsWrapper -> hs_syn GhcTc -> HsWrap hs_syn
    HsWrap HsWrapper
    w) (TM (HsExpr GhcTc) -> TM (HsExpr GhcTc))
    -> TM (HsExpr GhcTc) -> TM (HsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $
                  (HsExpr GhcTc -> TM (HsExpr GhcTc)
    addTickHsExpr HsExpr GhcTc
    e)        -- Explicitly no tick on inside
    addTickHsExpr (XExpr (ExpansionExpr (HsExpanded HsExpr (GhcPass 'Renamed)
    a HsExpr GhcTc
    b))) =
            (HsExpr GhcTc -> HsExpr GhcTc)
    -> TM (HsExpr GhcTc) -> TM (HsExpr GhcTc)
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM (XXExprGhcTc -> HsExpr GhcTc
    forall p. XXExpr p -> HsExpr p
    XExpr (XXExprGhcTc -> HsExpr GhcTc)
    -> (HsExpr GhcTc -> XXExprGhcTc) -> HsExpr GhcTc -> HsExpr GhcTc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HsExpansion (HsExpr (GhcPass 'Renamed)) (HsExpr GhcTc)
    -> XXExprGhcTc
    ExpansionExpr (HsExpansion (HsExpr (GhcPass 'Renamed)) (HsExpr GhcTc)
     -> XXExprGhcTc)
    -> (HsExpr GhcTc
        -> HsExpansion (HsExpr (GhcPass 'Renamed)) (HsExpr GhcTc))
    -> HsExpr GhcTc
    -> XXExprGhcTc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HsExpr (GhcPass 'Renamed)
    -> HsExpr GhcTc
    -> HsExpansion (HsExpr (GhcPass 'Renamed)) (HsExpr GhcTc)
    forall a b. a -> b -> HsExpansion a b
    HsExpanded HsExpr (GhcPass 'Renamed)
    a) (TM (HsExpr GhcTc) -> TM (HsExpr GhcTc))
    -> TM (HsExpr GhcTc) -> TM (HsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $
                  (HsExpr GhcTc -> TM (HsExpr GhcTc)
    addTickHsExpr HsExpr GhcTc
    b)

    -- Others should never happen in expression content.
    addTickHsExpr HsExpr GhcTc
    e  = FilePath -> SDoc -> TM (HsExpr GhcTc)
    forall a. HasCallStack => FilePath -> SDoc -> a
    pprPanic FilePath
    "addTickHsExpr" (HsExpr GhcTc -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr HsExpr GhcTc
    e)

    addTickTupArg :: LHsTupArg GhcTc -> TM (LHsTupArg GhcTc)
    addTickTupArg :: LHsTupArg GhcTc -> TM (LHsTupArg GhcTc)
    addTickTupArg (L SrcSpan
    l (Present XPresent GhcTc
    x LHsExpr GhcTc
    e))  = do { LHsExpr GhcTc
    e' <- LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExpr LHsExpr GhcTc
    e
                                            ; LHsTupArg GhcTc -> TM (LHsTupArg GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SrcSpan -> HsTupArg GhcTc -> LHsTupArg GhcTc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    l (XPresent GhcTc -> LHsExpr GhcTc -> HsTupArg GhcTc
    forall id. XPresent id -> LHsExpr id -> HsTupArg id
    Present XPresent GhcTc
    x LHsExpr GhcTc
    e')) }
    addTickTupArg (L SrcSpan
    l (Missing XMissing GhcTc
    ty)) = LHsTupArg GhcTc -> TM (LHsTupArg GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SrcSpan -> HsTupArg GhcTc -> LHsTupArg GhcTc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    l (XMissing GhcTc -> HsTupArg GhcTc
    forall id. XMissing id -> HsTupArg id
    Missing XMissing GhcTc
    ty))

    addTickMatchGroup :: Bool{-is lambda-} -> MatchGroup GhcTc (LHsExpr GhcTc)
                      -> TM (MatchGroup GhcTc (LHsExpr GhcTc))
    addTickMatchGroup :: Bool
    -> MatchGroup GhcTc (LHsExpr GhcTc)
    -> TM (MatchGroup GhcTc (LHsExpr GhcTc))
    addTickMatchGroup Bool
    is_lam mg :: MatchGroup GhcTc (LHsExpr GhcTc)
    mg@(MG { mg_alts :: forall p body. MatchGroup p body -> Located [LMatch p body]
    mg_alts = L SrcSpan
    l [LMatch GhcTc (LHsExpr GhcTc)]
    matches }) = do
      let isOneOfMany :: Bool
    isOneOfMany = [LMatch GhcTc (LHsExpr GhcTc)] -> Bool
    forall body. [LMatch GhcTc body] -> Bool
    matchesOneOfMany [LMatch GhcTc (LHsExpr GhcTc)]
    matches
      [LMatch GhcTc (LHsExpr GhcTc)]
    matches' <- (LMatch GhcTc (LHsExpr GhcTc) -> TM (LMatch GhcTc (LHsExpr GhcTc)))
    -> [LMatch GhcTc (LHsExpr GhcTc)]
    -> TM [LMatch GhcTc (LHsExpr GhcTc)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM ((Match GhcTc (LHsExpr GhcTc) -> TM (Match GhcTc (LHsExpr GhcTc)))
    -> LMatch GhcTc (LHsExpr GhcTc)
    -> TM (LMatch GhcTc (LHsExpr GhcTc))
    forall (m :: * -> *) a b l.
    Monad m =>
    (a -> m b) -> GenLocated l a -> m (GenLocated l b)
    liftL (Bool
    -> Bool
    -> Match GhcTc (LHsExpr GhcTc)
    -> TM (Match GhcTc (LHsExpr GhcTc))
    addTickMatch Bool
    isOneOfMany Bool
    is_lam)) [LMatch GhcTc (LHsExpr GhcTc)]
    matches
      MatchGroup GhcTc (LHsExpr GhcTc)
    -> TM (MatchGroup GhcTc (LHsExpr GhcTc))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (MatchGroup GhcTc (LHsExpr GhcTc)
     -> TM (MatchGroup GhcTc (LHsExpr GhcTc)))
    -> MatchGroup GhcTc (LHsExpr GhcTc)
    -> TM (MatchGroup GhcTc (LHsExpr GhcTc))
    forall a b. (a -> b) -> a -> b
    $ MatchGroup GhcTc (LHsExpr GhcTc)
    mg { mg_alts :: GenLocated SrcSpan [LMatch GhcTc (LHsExpr GhcTc)]
    mg_alts = SrcSpan
    -> [LMatch GhcTc (LHsExpr GhcTc)]
    -> GenLocated SrcSpan [LMatch GhcTc (LHsExpr GhcTc)]
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    l [LMatch GhcTc (LHsExpr GhcTc)]
    matches' }

    addTickMatch :: Bool -> Bool -> Match GhcTc (LHsExpr GhcTc)
                 -> TM (Match GhcTc (LHsExpr GhcTc))
    addTickMatch :: Bool
    -> Bool
    -> Match GhcTc (LHsExpr GhcTc)
    -> TM (Match GhcTc (LHsExpr GhcTc))
    addTickMatch Bool
    isOneOfMany Bool
    isLambda match :: Match GhcTc (LHsExpr GhcTc)
    match@(Match { m_pats :: forall p body. Match p body -> [LPat p]
    m_pats = [LPat GhcTc]
    pats
                                                   , m_grhss :: forall p body. Match p body -> GRHSs p body
    m_grhss = GRHSs GhcTc (LHsExpr GhcTc)
    gRHSs }) =
      [Id]
    -> TM (Match GhcTc (LHsExpr GhcTc))
    -> TM (Match GhcTc (LHsExpr GhcTc))
    forall a. [Id] -> TM a -> TM a
    bindLocals ([LPat GhcTc] -> [IdP GhcTc]
    forall p. CollectPass p => [LPat p] -> [IdP p]
    collectPatsBinders [LPat GhcTc]
    pats) (TM (Match GhcTc (LHsExpr GhcTc))
     -> TM (Match GhcTc (LHsExpr GhcTc)))
    -> TM (Match GhcTc (LHsExpr GhcTc))
    -> TM (Match GhcTc (LHsExpr GhcTc))
    forall a b. (a -> b) -> a -> b
    $ do
        GRHSs GhcTc (LHsExpr GhcTc)
    gRHSs' <- Bool
    -> Bool
    -> GRHSs GhcTc (LHsExpr GhcTc)
    -> TM (GRHSs GhcTc (LHsExpr GhcTc))
    addTickGRHSs Bool
    isOneOfMany Bool
    isLambda GRHSs GhcTc (LHsExpr GhcTc)
    gRHSs
        Match GhcTc (LHsExpr GhcTc) -> TM (Match GhcTc (LHsExpr GhcTc))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Match GhcTc (LHsExpr GhcTc) -> TM (Match GhcTc (LHsExpr GhcTc)))
    -> Match GhcTc (LHsExpr GhcTc) -> TM (Match GhcTc (LHsExpr GhcTc))
    forall a b. (a -> b) -> a -> b
    $ Match GhcTc (LHsExpr GhcTc)
    match { m_grhss :: GRHSs GhcTc (LHsExpr GhcTc)
    m_grhss = GRHSs GhcTc (LHsExpr GhcTc)
    gRHSs' }

    addTickGRHSs :: Bool -> Bool -> GRHSs GhcTc (LHsExpr GhcTc)
                 -> TM (GRHSs GhcTc (LHsExpr GhcTc))
    addTickGRHSs :: Bool
    -> Bool
    -> GRHSs GhcTc (LHsExpr GhcTc)
    -> TM (GRHSs GhcTc (LHsExpr GhcTc))
    addTickGRHSs Bool
    isOneOfMany Bool
    isLambda (GRHSs XCGRHSs GhcTc (LHsExpr GhcTc)
    x [LGRHS GhcTc (LHsExpr GhcTc)]
    guarded (L SrcSpan
    l HsLocalBinds GhcTc
    local_binds)) = do
      [Id]
    -> TM (GRHSs GhcTc (LHsExpr GhcTc))
    -> TM (GRHSs GhcTc (LHsExpr GhcTc))
    forall a. [Id] -> TM a -> TM a
    bindLocals [Id]
    [IdP GhcTc]
    binders (TM (GRHSs GhcTc (LHsExpr GhcTc))
     -> TM (GRHSs GhcTc (LHsExpr GhcTc)))
    -> TM (GRHSs GhcTc (LHsExpr GhcTc))
    -> TM (GRHSs GhcTc (LHsExpr GhcTc))
    forall a b. (a -> b) -> a -> b
    $ do
        HsLocalBinds GhcTc
    local_binds' <- HsLocalBinds GhcTc -> TM (HsLocalBinds GhcTc)
    addTickHsLocalBinds HsLocalBinds GhcTc
    local_binds
        [LGRHS GhcTc (LHsExpr GhcTc)]
    guarded' <- (LGRHS GhcTc (LHsExpr GhcTc) -> TM (LGRHS GhcTc (LHsExpr GhcTc)))
    -> [LGRHS GhcTc (LHsExpr GhcTc)]
    -> TM [LGRHS GhcTc (LHsExpr GhcTc)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM ((GRHS GhcTc (LHsExpr GhcTc) -> TM (GRHS GhcTc (LHsExpr GhcTc)))
    -> LGRHS GhcTc (LHsExpr GhcTc) -> TM (LGRHS GhcTc (LHsExpr GhcTc))
    forall (m :: * -> *) a b l.
    Monad m =>
    (a -> m b) -> GenLocated l a -> m (GenLocated l b)
    liftL (Bool
    -> Bool
    -> GRHS GhcTc (LHsExpr GhcTc)
    -> TM (GRHS GhcTc (LHsExpr GhcTc))
    addTickGRHS Bool
    isOneOfMany Bool
    isLambda)) [LGRHS GhcTc (LHsExpr GhcTc)]
    guarded
        GRHSs GhcTc (LHsExpr GhcTc) -> TM (GRHSs GhcTc (LHsExpr GhcTc))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (GRHSs GhcTc (LHsExpr GhcTc) -> TM (GRHSs GhcTc (LHsExpr GhcTc)))
    -> GRHSs GhcTc (LHsExpr GhcTc) -> TM (GRHSs GhcTc (LHsExpr GhcTc))
    forall a b. (a -> b) -> a -> b
    $ XCGRHSs GhcTc (LHsExpr GhcTc)
    -> [LGRHS GhcTc (LHsExpr GhcTc)]
    -> GenLocated SrcSpan (HsLocalBinds GhcTc)
    -> GRHSs GhcTc (LHsExpr GhcTc)
    forall p body.
    XCGRHSs p body -> [LGRHS p body] -> LHsLocalBinds p -> GRHSs p body
    GRHSs XCGRHSs GhcTc (LHsExpr GhcTc)
    x [LGRHS GhcTc (LHsExpr GhcTc)]
    guarded' (SrcSpan
    -> HsLocalBinds GhcTc -> GenLocated SrcSpan (HsLocalBinds GhcTc)
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    l HsLocalBinds GhcTc
    local_binds')
      where
        binders :: [IdP GhcTc]
    binders = HsLocalBinds GhcTc -> [IdP GhcTc]
    forall (idL :: Pass) (idR :: Pass).
    CollectPass (GhcPass idL) =>
    HsLocalBindsLR (GhcPass idL) (GhcPass idR) -> [IdP (GhcPass idL)]
    collectLocalBinders HsLocalBinds GhcTc
    local_binds

    addTickGRHS :: Bool -> Bool -> GRHS GhcTc (LHsExpr GhcTc)
                -> TM (GRHS GhcTc (LHsExpr GhcTc))
    addTickGRHS :: Bool
    -> Bool
    -> GRHS GhcTc (LHsExpr GhcTc)
    -> TM (GRHS GhcTc (LHsExpr GhcTc))
    addTickGRHS Bool
    isOneOfMany Bool
    isLambda (GRHS XCGRHS GhcTc (LHsExpr GhcTc)
    x [ExprLStmt GhcTc]
    stmts LHsExpr GhcTc
    expr) = do
      ([ExprLStmt GhcTc]
    stmts',LHsExpr GhcTc
    expr') <- Maybe (Bool -> BoxLabel)
    -> [ExprLStmt GhcTc]
    -> TM (LHsExpr GhcTc)
    -> TM ([ExprLStmt GhcTc], LHsExpr GhcTc)
    forall a.
    Maybe (Bool -> BoxLabel)
    -> [ExprLStmt GhcTc] -> TM a -> TM ([ExprLStmt GhcTc], a)
    addTickLStmts' ((Bool -> BoxLabel) -> Maybe (Bool -> BoxLabel)
    forall a. a -> Maybe a
    Just ((Bool -> BoxLabel) -> Maybe (Bool -> BoxLabel))
    -> (Bool -> BoxLabel) -> Maybe (Bool -> BoxLabel)
    forall a b. (a -> b) -> a -> b
    $ CondBox -> Bool -> BoxLabel
    BinBox (CondBox -> Bool -> BoxLabel) -> CondBox -> Bool -> BoxLabel
    forall a b. (a -> b) -> a -> b
    $ CondBox
    GuardBinBox) [ExprLStmt GhcTc]
    stmts
                            (Bool -> Bool -> LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickGRHSBody Bool
    isOneOfMany Bool
    isLambda LHsExpr GhcTc
    expr)
      GRHS GhcTc (LHsExpr GhcTc) -> TM (GRHS GhcTc (LHsExpr GhcTc))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (GRHS GhcTc (LHsExpr GhcTc) -> TM (GRHS GhcTc (LHsExpr GhcTc)))
    -> GRHS GhcTc (LHsExpr GhcTc) -> TM (GRHS GhcTc (LHsExpr GhcTc))
    forall a b. (a -> b) -> a -> b
    $ XCGRHS GhcTc (LHsExpr GhcTc)
    -> [ExprLStmt GhcTc] -> LHsExpr GhcTc -> GRHS GhcTc (LHsExpr GhcTc)
    forall p body.
    XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
    GRHS XCGRHS GhcTc (LHsExpr GhcTc)
    x [ExprLStmt GhcTc]
    stmts' LHsExpr GhcTc
    expr'

    addTickGRHSBody :: Bool -> Bool -> LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickGRHSBody :: Bool -> Bool -> LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickGRHSBody Bool
    isOneOfMany Bool
    isLambda expr :: LHsExpr GhcTc
    expr@(L SrcSpan
    pos HsExpr GhcTc
    e0) = do
      TickDensity
    d <- TM TickDensity
    getDensity
      case TickDensity
    d of
        TickDensity
    TickForCoverage  -> Bool -> LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExprOptAlt Bool
    isOneOfMany LHsExpr GhcTc
    expr
        TickDensity
    TickAllFunctions | Bool
    isLambda ->
           FilePath -> TM (LHsExpr GhcTc) -> TM (LHsExpr GhcTc)
    forall a. FilePath -> TM a -> TM a
    addPathEntry FilePath
    "\\" (TM (LHsExpr GhcTc) -> TM (LHsExpr GhcTc))
    -> TM (LHsExpr GhcTc) -> TM (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $
             BoxLabel
    -> Bool
    -> Bool
    -> SrcSpan
    -> TM (HsExpr GhcTc)
    -> TM (LHsExpr GhcTc)
    allocTickBox (Bool -> BoxLabel
    ExpBox Bool
    False) Bool
    True{-count-} Bool
    False{-not top-} SrcSpan
    pos (TM (HsExpr GhcTc) -> TM (LHsExpr GhcTc))
    -> TM (HsExpr GhcTc) -> TM (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $
               HsExpr GhcTc -> TM (HsExpr GhcTc)
    addTickHsExpr HsExpr GhcTc
    e0
        TickDensity
    _otherwise ->
           LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExprRHS LHsExpr GhcTc
    expr

    addTickLStmts :: (Maybe (Bool -> BoxLabel)) -> [ExprLStmt GhcTc]
                  -> TM [ExprLStmt GhcTc]
    addTickLStmts :: Maybe (Bool -> BoxLabel)
    -> [ExprLStmt GhcTc] -> TM [ExprLStmt GhcTc]
    addTickLStmts Maybe (Bool -> BoxLabel)
    isGuard [ExprLStmt GhcTc]
    stmts = do
      ([ExprLStmt GhcTc]
    stmts, ()
    _) <- Maybe (Bool -> BoxLabel)
    -> [ExprLStmt GhcTc] -> TM () -> TM ([ExprLStmt GhcTc], ())
    forall a.
    Maybe (Bool -> BoxLabel)
    -> [ExprLStmt GhcTc] -> TM a -> TM ([ExprLStmt GhcTc], a)
    addTickLStmts' Maybe (Bool -> BoxLabel)
    isGuard [ExprLStmt GhcTc]
    stmts (() -> TM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())
      [ExprLStmt GhcTc] -> TM [ExprLStmt GhcTc]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [ExprLStmt GhcTc]
    stmts

    addTickLStmts' :: (Maybe (Bool -> BoxLabel)) -> [ExprLStmt GhcTc] -> TM a
                   -> TM ([ExprLStmt GhcTc], a)
    addTickLStmts' :: forall a.
    Maybe (Bool -> BoxLabel)
    -> [ExprLStmt GhcTc] -> TM a -> TM ([ExprLStmt GhcTc], a)
    addTickLStmts' Maybe (Bool -> BoxLabel)
    isGuard [ExprLStmt GhcTc]
    lstmts TM a
    res
      = [Id] -> TM ([ExprLStmt GhcTc], a) -> TM ([ExprLStmt GhcTc], a)
    forall a. [Id] -> TM a -> TM a
    bindLocals ([ExprLStmt GhcTc] -> [IdP GhcTc]
    forall (idL :: Pass) (idR :: Pass) body.
    CollectPass (GhcPass idL) =>
    [LStmtLR (GhcPass idL) (GhcPass idR) body] -> [IdP (GhcPass idL)]
    collectLStmtsBinders [ExprLStmt GhcTc]
    lstmts) (TM ([ExprLStmt GhcTc], a) -> TM ([ExprLStmt GhcTc], a))
    -> TM ([ExprLStmt GhcTc], a) -> TM ([ExprLStmt GhcTc], a)
    forall a b. (a -> b) -> a -> b
    $
        do { [ExprLStmt GhcTc]
    lstmts' <- (ExprLStmt GhcTc -> TM (ExprLStmt GhcTc))
    -> [ExprLStmt GhcTc] -> TM [ExprLStmt GhcTc]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM ((Stmt GhcTc (LHsExpr GhcTc) -> TM (Stmt GhcTc (LHsExpr GhcTc)))
    -> ExprLStmt GhcTc -> TM (ExprLStmt GhcTc)
    forall (m :: * -> *) a b l.
    Monad m =>
    (a -> m b) -> GenLocated l a -> m (GenLocated l b)
    liftL (Maybe (Bool -> BoxLabel)
    -> Stmt GhcTc (LHsExpr GhcTc) -> TM (Stmt GhcTc (LHsExpr GhcTc))
    addTickStmt Maybe (Bool -> BoxLabel)
    isGuard)) [ExprLStmt GhcTc]
    lstmts
           ; a
    a <- TM a
    res
           ; ([ExprLStmt GhcTc], a) -> TM ([ExprLStmt GhcTc], a)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([ExprLStmt GhcTc]
    lstmts', a
    a) }

    addTickStmt :: (Maybe (Bool -> BoxLabel)) -> Stmt GhcTc (LHsExpr GhcTc)
                -> TM (Stmt GhcTc (LHsExpr GhcTc))
    addTickStmt :: Maybe (Bool -> BoxLabel)
    -> Stmt GhcTc (LHsExpr GhcTc) -> TM (Stmt GhcTc (LHsExpr GhcTc))
    addTickStmt Maybe (Bool -> BoxLabel)
    _isGuard (LastStmt XLastStmt GhcTc GhcTc (LHsExpr GhcTc)
    x LHsExpr GhcTc
    e Maybe Bool
    noret SyntaxExpr GhcTc
    ret) = do
            (LHsExpr GhcTc
     -> Maybe Bool -> SyntaxExprTc -> Stmt GhcTc (LHsExpr GhcTc))
    -> TM (LHsExpr GhcTc)
    -> TM (Maybe Bool)
    -> TM SyntaxExprTc
    -> TM (Stmt GhcTc (LHsExpr GhcTc))
    forall (m :: * -> *) a1 a2 a3 r.
    Monad m =>
    (a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
    liftM3 (XLastStmt GhcTc GhcTc (LHsExpr GhcTc)
    -> LHsExpr GhcTc
    -> Maybe Bool
    -> SyntaxExpr GhcTc
    -> Stmt GhcTc (LHsExpr GhcTc)
    forall idL idR body.
    XLastStmt idL idR body
    -> body -> Maybe Bool -> SyntaxExpr idR -> StmtLR idL idR body
    LastStmt XLastStmt GhcTc GhcTc (LHsExpr GhcTc)
    x)
                    (LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExpr LHsExpr GhcTc
    e)
                    (Maybe Bool -> TM (Maybe Bool)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe Bool
    noret)
                    (SrcSpan -> SyntaxExpr GhcTc -> TM (SyntaxExpr GhcTc)
    addTickSyntaxExpr SrcSpan
    hpcSrcSpan SyntaxExpr GhcTc
    ret)
    addTickStmt Maybe (Bool -> BoxLabel)
    _isGuard (BindStmt XBindStmt GhcTc GhcTc (LHsExpr GhcTc)
    xbs LPat GhcTc
    pat LHsExpr GhcTc
    e) = do
            (SyntaxExprTc
     -> Maybe SyntaxExprTc
     -> Located (Pat GhcTc)
     -> LHsExpr GhcTc
     -> Stmt GhcTc (LHsExpr GhcTc))
    -> TM SyntaxExprTc
    -> TM (Maybe SyntaxExprTc)
    -> TM (Located (Pat GhcTc))
    -> TM (LHsExpr GhcTc)
    -> TM (Stmt GhcTc (LHsExpr GhcTc))
    forall (m :: * -> *) a1 a2 a3 a4 r.
    Monad m =>
    (a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r
    liftM4 (\SyntaxExprTc
    b Maybe SyntaxExprTc
    f -> XBindStmt GhcTc GhcTc (LHsExpr GhcTc)
    -> LPat GhcTc -> LHsExpr GhcTc -> Stmt GhcTc (LHsExpr GhcTc)
    forall idL idR body.
    XBindStmt idL idR body -> LPat idL -> body -> StmtLR idL idR body
    BindStmt (XBindStmt GhcTc GhcTc (LHsExpr GhcTc)
     -> LPat GhcTc -> LHsExpr GhcTc -> Stmt GhcTc (LHsExpr GhcTc))
    -> XBindStmt GhcTc GhcTc (LHsExpr GhcTc)
    -> LPat GhcTc
    -> LHsExpr GhcTc
    -> Stmt GhcTc (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ XBindStmtTc :: SyntaxExpr GhcTc
    -> Type -> Type -> Maybe (SyntaxExpr GhcTc) -> XBindStmtTc
    XBindStmtTc
                        { xbstc_bindOp :: SyntaxExpr GhcTc
    xbstc_bindOp = SyntaxExpr GhcTc
    SyntaxExprTc
    b
                        , xbstc_boundResultType :: Type
    xbstc_boundResultType = XBindStmtTc -> Type
    xbstc_boundResultType XBindStmt GhcTc GhcTc (LHsExpr GhcTc)
    XBindStmtTc
    xbs
                        , xbstc_boundResultMult :: Type
    xbstc_boundResultMult = XBindStmtTc -> Type
    xbstc_boundResultMult XBindStmt GhcTc GhcTc (LHsExpr GhcTc)
    XBindStmtTc
    xbs
                        , xbstc_failOp :: Maybe (SyntaxExpr GhcTc)
    xbstc_failOp = Maybe (SyntaxExpr GhcTc)
    Maybe SyntaxExprTc
    f
                        })
                    (SrcSpan -> SyntaxExpr GhcTc -> TM (SyntaxExpr GhcTc)
    addTickSyntaxExpr SrcSpan
    hpcSrcSpan (XBindStmtTc -> SyntaxExpr GhcTc
    xbstc_bindOp XBindStmt GhcTc GhcTc (LHsExpr GhcTc)
    XBindStmtTc
    xbs))
                    ((SyntaxExprTc -> TM SyntaxExprTc)
    -> Maybe SyntaxExprTc -> TM (Maybe SyntaxExprTc)
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (SrcSpan -> SyntaxExpr GhcTc -> TM (SyntaxExpr GhcTc)
    addTickSyntaxExpr SrcSpan
    hpcSrcSpan) (XBindStmtTc -> Maybe (SyntaxExpr GhcTc)
    xbstc_failOp XBindStmt GhcTc GhcTc (LHsExpr GhcTc)
    XBindStmtTc
    xbs))
                    (LPat GhcTc -> TM (LPat GhcTc)
    addTickLPat LPat GhcTc
    pat)
                    (LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExprRHS LHsExpr GhcTc
    e)
    addTickStmt Maybe (Bool -> BoxLabel)
    isGuard (BodyStmt XBodyStmt GhcTc GhcTc (LHsExpr GhcTc)
    x LHsExpr GhcTc
    e SyntaxExpr GhcTc
    bind' SyntaxExpr GhcTc
    guard') = do
            (LHsExpr GhcTc
     -> SyntaxExprTc -> SyntaxExprTc -> Stmt GhcTc (LHsExpr GhcTc))
    -> TM (LHsExpr GhcTc)
    -> TM SyntaxExprTc
    -> TM SyntaxExprTc
    -> TM (Stmt GhcTc (LHsExpr GhcTc))
    forall (m :: * -> *) a1 a2 a3 r.
    Monad m =>
    (a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
    liftM3 (XBodyStmt GhcTc GhcTc (LHsExpr GhcTc)
    -> LHsExpr GhcTc
    -> SyntaxExpr GhcTc
    -> SyntaxExpr GhcTc
    -> Stmt GhcTc (LHsExpr GhcTc)
    forall idL idR body.
    XBodyStmt idL idR body
    -> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
    BodyStmt XBodyStmt GhcTc GhcTc (LHsExpr GhcTc)
    x)
                    (Maybe (Bool -> BoxLabel) -> LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTick Maybe (Bool -> BoxLabel)
    isGuard LHsExpr GhcTc
    e)
                    (SrcSpan -> SyntaxExpr GhcTc -> TM (SyntaxExpr GhcTc)
    addTickSyntaxExpr SrcSpan
    hpcSrcSpan SyntaxExpr GhcTc
    bind')
                    (SrcSpan -> SyntaxExpr GhcTc -> TM (SyntaxExpr GhcTc)
    addTickSyntaxExpr SrcSpan
    hpcSrcSpan SyntaxExpr GhcTc
    guard')
    addTickStmt Maybe (Bool -> BoxLabel)
    _isGuard (LetStmt XLetStmt GhcTc GhcTc (LHsExpr GhcTc)
    x (L SrcSpan
    l HsLocalBinds GhcTc
    binds)) = do
            (HsLocalBinds GhcTc -> Stmt GhcTc (LHsExpr GhcTc))
    -> TM (HsLocalBinds GhcTc) -> TM (Stmt GhcTc (LHsExpr GhcTc))
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM (XLetStmt GhcTc GhcTc (LHsExpr GhcTc)
    -> GenLocated SrcSpan (HsLocalBinds GhcTc)
    -> Stmt GhcTc (LHsExpr GhcTc)
    forall idL idR body.
    XLetStmt idL idR body
    -> LHsLocalBindsLR idL idR -> StmtLR idL idR body
    LetStmt XLetStmt GhcTc GhcTc (LHsExpr GhcTc)
    x (GenLocated SrcSpan (HsLocalBinds GhcTc)
     -> Stmt GhcTc (LHsExpr GhcTc))
    -> (HsLocalBinds GhcTc -> GenLocated SrcSpan (HsLocalBinds GhcTc))
    -> HsLocalBinds GhcTc
    -> Stmt GhcTc (LHsExpr GhcTc)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SrcSpan
    -> HsLocalBinds GhcTc -> GenLocated SrcSpan (HsLocalBinds GhcTc)
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    l)
                    (HsLocalBinds GhcTc -> TM (HsLocalBinds GhcTc)
    addTickHsLocalBinds HsLocalBinds GhcTc
    binds)
    addTickStmt Maybe (Bool -> BoxLabel)
    isGuard (ParStmt XParStmt GhcTc GhcTc (LHsExpr GhcTc)
    x [ParStmtBlock GhcTc GhcTc]
    pairs HsExpr GhcTc
    mzipExpr SyntaxExpr GhcTc
    bindExpr) = do
        ([ParStmtBlock GhcTc GhcTc]
     -> HsExpr GhcTc -> SyntaxExprTc -> Stmt GhcTc (LHsExpr GhcTc))
    -> TM [ParStmtBlock GhcTc GhcTc]
    -> TM (HsExpr GhcTc)
    -> TM SyntaxExprTc
    -> TM (Stmt GhcTc (LHsExpr GhcTc))
    forall (m :: * -> *) a1 a2 a3 r.
    Monad m =>
    (a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
    liftM3 (XParStmt GhcTc GhcTc (LHsExpr GhcTc)
    -> [ParStmtBlock GhcTc GhcTc]
    -> HsExpr GhcTc
    -> SyntaxExpr GhcTc
    -> Stmt GhcTc (LHsExpr GhcTc)
    forall idL idR body.
    XParStmt idL idR body
    -> [ParStmtBlock idL idR]
    -> HsExpr idR
    -> SyntaxExpr idR
    -> StmtLR idL idR body
    ParStmt XParStmt GhcTc GhcTc (LHsExpr GhcTc)
    x)
            ((ParStmtBlock GhcTc GhcTc -> TM (ParStmtBlock GhcTc GhcTc))
    -> [ParStmtBlock GhcTc GhcTc] -> TM [ParStmtBlock GhcTc GhcTc]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (Maybe (Bool -> BoxLabel)
    -> ParStmtBlock GhcTc GhcTc -> TM (ParStmtBlock GhcTc GhcTc)
    addTickStmtAndBinders Maybe (Bool -> BoxLabel)
    isGuard) [ParStmtBlock GhcTc GhcTc]
    pairs)
            (LHsExpr GhcTc -> HsExpr GhcTc
    forall l e. GenLocated l e -> e
    unLoc (LHsExpr GhcTc -> HsExpr GhcTc)
    -> TM (LHsExpr GhcTc) -> TM (HsExpr GhcTc)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExpr (SrcSpan -> HsExpr GhcTc -> LHsExpr GhcTc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    hpcSrcSpan HsExpr GhcTc
    mzipExpr))
            (SrcSpan -> SyntaxExpr GhcTc -> TM (SyntaxExpr GhcTc)
    addTickSyntaxExpr SrcSpan
    hpcSrcSpan SyntaxExpr GhcTc
    bindExpr)
    addTickStmt Maybe (Bool -> BoxLabel)
    isGuard (ApplicativeStmt XApplicativeStmt GhcTc GhcTc (LHsExpr GhcTc)
    body_ty [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
    args Maybe (SyntaxExpr GhcTc)
    mb_join) = do
        [(SyntaxExprTc, ApplicativeArg GhcTc)]
    args' <- ((SyntaxExprTc, ApplicativeArg GhcTc)
     -> TM (SyntaxExprTc, ApplicativeArg GhcTc))
    -> [(SyntaxExprTc, ApplicativeArg GhcTc)]
    -> TM [(SyntaxExprTc, ApplicativeArg GhcTc)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (Maybe (Bool -> BoxLabel)
    -> (SyntaxExpr GhcTc, ApplicativeArg GhcTc)
    -> TM (SyntaxExpr GhcTc, ApplicativeArg GhcTc)
    addTickApplicativeArg Maybe (Bool -> BoxLabel)
    isGuard) [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
    [(SyntaxExprTc, ApplicativeArg GhcTc)]
    args
        Stmt GhcTc (LHsExpr GhcTc) -> TM (Stmt GhcTc (LHsExpr GhcTc))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XApplicativeStmt GhcTc GhcTc (LHsExpr GhcTc)
    -> [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
    -> Maybe (SyntaxExpr GhcTc)
    -> Stmt GhcTc (LHsExpr GhcTc)
    forall idL idR body.
    XApplicativeStmt idL idR body
    -> [(SyntaxExpr idR, ApplicativeArg idL)]
    -> Maybe (SyntaxExpr idR)
    -> StmtLR idL idR body
    ApplicativeStmt XApplicativeStmt GhcTc GhcTc (LHsExpr GhcTc)
    body_ty [(SyntaxExpr GhcTc, ApplicativeArg GhcTc)]
    [(SyntaxExprTc, ApplicativeArg GhcTc)]
    args' Maybe (SyntaxExpr GhcTc)
    mb_join)

    addTickStmt Maybe (Bool -> BoxLabel)
    isGuard stmt :: Stmt GhcTc (LHsExpr GhcTc)
    stmt@(TransStmt { trS_stmts :: forall idL idR body. StmtLR idL idR body -> [ExprLStmt idL]
    trS_stmts = [ExprLStmt GhcTc]
    stmts
                                        , trS_by :: forall idL idR body. StmtLR idL idR body -> Maybe (LHsExpr idR)
    trS_by = Maybe (LHsExpr GhcTc)
    by, trS_using :: forall idL idR body. StmtLR idL idR body -> LHsExpr idR
    trS_using = LHsExpr GhcTc
    using
                                        , trS_ret :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
    trS_ret = SyntaxExpr GhcTc
    returnExpr, trS_bind :: forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
    trS_bind = SyntaxExpr GhcTc
    bindExpr
                                        , trS_fmap :: forall idL idR body. StmtLR idL idR body -> HsExpr idR
    trS_fmap = HsExpr GhcTc
    liftMExpr }) = do
        [ExprLStmt GhcTc]
    t_s <- Maybe (Bool -> BoxLabel)
    -> [ExprLStmt GhcTc] -> TM [ExprLStmt GhcTc]
    addTickLStmts Maybe (Bool -> BoxLabel)
    isGuard [ExprLStmt GhcTc]
    stmts
        Maybe (LHsExpr GhcTc)
    t_y <- (LHsExpr GhcTc -> TM (LHsExpr GhcTc))
    -> Maybe (LHsExpr GhcTc) -> TM (Maybe (LHsExpr GhcTc))
    forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> Maybe a -> m (Maybe b)
    fmapMaybeM  LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExprRHS Maybe (LHsExpr GhcTc)
    by
        LHsExpr GhcTc
    t_u <- LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExprRHS LHsExpr GhcTc
    using
        SyntaxExprTc
    t_f <- SrcSpan -> SyntaxExpr GhcTc -> TM (SyntaxExpr GhcTc)
    addTickSyntaxExpr SrcSpan
    hpcSrcSpan SyntaxExpr GhcTc
    returnExpr
        SyntaxExprTc
    t_b <- SrcSpan -> SyntaxExpr GhcTc -> TM (SyntaxExpr GhcTc)
    addTickSyntaxExpr SrcSpan
    hpcSrcSpan SyntaxExpr GhcTc
    bindExpr
        HsExpr GhcTc
    t_m <- (LHsExpr GhcTc -> HsExpr GhcTc)
    -> TM (LHsExpr GhcTc) -> TM (HsExpr GhcTc)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap LHsExpr GhcTc -> HsExpr GhcTc
    forall l e. GenLocated l e -> e
    unLoc (LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExpr (SrcSpan -> HsExpr GhcTc -> LHsExpr GhcTc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    hpcSrcSpan HsExpr GhcTc
    liftMExpr))
        Stmt GhcTc (LHsExpr GhcTc) -> TM (Stmt GhcTc (LHsExpr GhcTc))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Stmt GhcTc (LHsExpr GhcTc) -> TM (Stmt GhcTc (LHsExpr GhcTc)))
    -> Stmt GhcTc (LHsExpr GhcTc) -> TM (Stmt GhcTc (LHsExpr GhcTc))
    forall a b. (a -> b) -> a -> b
    $ Stmt GhcTc (LHsExpr GhcTc)
    stmt { trS_stmts :: [ExprLStmt GhcTc]
    trS_stmts = [ExprLStmt GhcTc]
    t_s, trS_by :: Maybe (LHsExpr GhcTc)
    trS_by = Maybe (LHsExpr GhcTc)
    t_y, trS_using :: LHsExpr GhcTc
    trS_using = LHsExpr GhcTc
    t_u
                      , trS_ret :: SyntaxExpr GhcTc
    trS_ret = SyntaxExpr GhcTc
    SyntaxExprTc
    t_f, trS_bind :: SyntaxExpr GhcTc
    trS_bind = SyntaxExpr GhcTc
    SyntaxExprTc
    t_b, trS_fmap :: HsExpr GhcTc
    trS_fmap = HsExpr GhcTc
    t_m }

    addTickStmt Maybe (Bool -> BoxLabel)
    isGuard stmt :: Stmt GhcTc (LHsExpr GhcTc)
    stmt@(RecStmt {})
      = do { [ExprLStmt GhcTc]
    stmts' <- Maybe (Bool -> BoxLabel)
    -> [ExprLStmt GhcTc] -> TM [ExprLStmt GhcTc]
    addTickLStmts Maybe (Bool -> BoxLabel)
    isGuard (Stmt GhcTc (LHsExpr GhcTc) -> [ExprLStmt GhcTc]
    forall idL idR body. StmtLR idL idR body -> [LStmtLR idL idR body]
    recS_stmts Stmt GhcTc (LHsExpr GhcTc)
    stmt)
           ; SyntaxExprTc
    ret'   <- SrcSpan -> SyntaxExpr GhcTc -> TM (SyntaxExpr GhcTc)
    addTickSyntaxExpr SrcSpan
    hpcSrcSpan (Stmt GhcTc (LHsExpr GhcTc) -> SyntaxExpr GhcTc
    forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
    recS_ret_fn Stmt GhcTc (LHsExpr GhcTc)
    stmt)
           ; SyntaxExprTc
    mfix'  <- SrcSpan -> SyntaxExpr GhcTc -> TM (SyntaxExpr GhcTc)
    addTickSyntaxExpr SrcSpan
    hpcSrcSpan (Stmt GhcTc (LHsExpr GhcTc) -> SyntaxExpr GhcTc
    forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
    recS_mfix_fn Stmt GhcTc (LHsExpr GhcTc)
    stmt)
           ; SyntaxExprTc
    bind'  <- SrcSpan -> SyntaxExpr GhcTc -> TM (SyntaxExpr GhcTc)
    addTickSyntaxExpr SrcSpan
    hpcSrcSpan (Stmt GhcTc (LHsExpr GhcTc) -> SyntaxExpr GhcTc
    forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
    recS_bind_fn Stmt GhcTc (LHsExpr GhcTc)
    stmt)
           ; Stmt GhcTc (LHsExpr GhcTc) -> TM (Stmt GhcTc (LHsExpr GhcTc))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Stmt GhcTc (LHsExpr GhcTc)
    stmt { recS_stmts :: [ExprLStmt GhcTc]
    recS_stmts = [ExprLStmt GhcTc]
    stmts', recS_ret_fn :: SyntaxExpr GhcTc
    recS_ret_fn = SyntaxExpr GhcTc
    SyntaxExprTc
    ret'
                          , recS_mfix_fn :: SyntaxExpr GhcTc
    recS_mfix_fn = SyntaxExpr GhcTc
    SyntaxExprTc
    mfix', recS_bind_fn :: SyntaxExpr GhcTc
    recS_bind_fn = SyntaxExpr GhcTc
    SyntaxExprTc
    bind' }) }

    addTick :: Maybe (Bool -> BoxLabel) -> LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTick :: Maybe (Bool -> BoxLabel) -> LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTick Maybe (Bool -> BoxLabel)
    isGuard LHsExpr GhcTc
    e | Just Bool -> BoxLabel
    fn <- Maybe (Bool -> BoxLabel)
    isGuard = (Bool -> BoxLabel) -> LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addBinTickLHsExpr Bool -> BoxLabel
    fn LHsExpr GhcTc
    e
                      | Bool
    otherwise          = LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExprRHS LHsExpr GhcTc
    e

    addTickApplicativeArg
      :: Maybe (Bool -> BoxLabel) -> (SyntaxExpr GhcTc, ApplicativeArg GhcTc)
      -> TM (SyntaxExpr GhcTc, ApplicativeArg GhcTc)
    addTickApplicativeArg :: Maybe (Bool -> BoxLabel)
    -> (SyntaxExpr GhcTc, ApplicativeArg GhcTc)
    -> TM (SyntaxExpr GhcTc, ApplicativeArg GhcTc)
    addTickApplicativeArg Maybe (Bool -> BoxLabel)
    isGuard (SyntaxExpr GhcTc
    op, ApplicativeArg GhcTc
    arg) =
      (SyntaxExprTc
     -> ApplicativeArg GhcTc -> (SyntaxExprTc, ApplicativeArg GhcTc))
    -> TM SyntaxExprTc
    -> TM (ApplicativeArg GhcTc)
    -> TM (SyntaxExprTc, ApplicativeArg GhcTc)
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 (,) (SrcSpan -> SyntaxExpr GhcTc -> TM (SyntaxExpr GhcTc)
    addTickSyntaxExpr SrcSpan
    hpcSrcSpan SyntaxExpr GhcTc
    op) (ApplicativeArg GhcTc -> TM (ApplicativeArg GhcTc)
    addTickArg ApplicativeArg GhcTc
    arg)
     where
      addTickArg :: ApplicativeArg GhcTc -> TM (ApplicativeArg GhcTc)
    addTickArg (ApplicativeArgOne XApplicativeArgOne GhcTc
    m_fail LPat GhcTc
    pat LHsExpr GhcTc
    expr Bool
    isBody) =
        Maybe SyntaxExprTc
    -> Located (Pat GhcTc)
    -> LHsExpr GhcTc
    -> Bool
    -> ApplicativeArg GhcTc
    forall idL.
    XApplicativeArgOne idL
    -> LPat idL -> LHsExpr idL -> Bool -> ApplicativeArg idL
    ApplicativeArgOne
          (Maybe SyntaxExprTc
     -> Located (Pat GhcTc)
     -> LHsExpr GhcTc
     -> Bool
     -> ApplicativeArg GhcTc)
    -> TM (Maybe SyntaxExprTc)
    -> TM
         (Located (Pat GhcTc)
          -> LHsExpr GhcTc -> Bool -> ApplicativeArg GhcTc)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (SyntaxExprTc -> TM SyntaxExprTc)
    -> Maybe SyntaxExprTc -> TM (Maybe SyntaxExprTc)
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (SrcSpan -> SyntaxExpr GhcTc -> TM (SyntaxExpr GhcTc)
    addTickSyntaxExpr SrcSpan
    hpcSrcSpan) Maybe SyntaxExprTc
    XApplicativeArgOne GhcTc
    m_fail
          TM
      (Located (Pat GhcTc)
       -> LHsExpr GhcTc -> Bool -> ApplicativeArg GhcTc)
    -> TM (Located (Pat GhcTc))
    -> TM (LHsExpr GhcTc -> Bool -> ApplicativeArg GhcTc)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> LPat GhcTc -> TM (LPat GhcTc)
    addTickLPat LPat GhcTc
    pat
          TM (LHsExpr GhcTc -> Bool -> ApplicativeArg GhcTc)
    -> TM (LHsExpr GhcTc) -> TM (Bool -> ApplicativeArg GhcTc)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExpr LHsExpr GhcTc
    expr
          TM (Bool -> ApplicativeArg GhcTc)
    -> TM Bool -> TM (ApplicativeArg GhcTc)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Bool -> TM Bool
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    isBody
      addTickArg (ApplicativeArgMany XApplicativeArgMany GhcTc
    x [ExprLStmt GhcTc]
    stmts HsExpr GhcTc
    ret LPat GhcTc
    pat HsStmtContext (GhcPass 'Renamed)
    ctxt) =
        (XApplicativeArgMany GhcTc
    -> [ExprLStmt GhcTc]
    -> HsExpr GhcTc
    -> LPat GhcTc
    -> HsStmtContext (GhcPass 'Renamed)
    -> ApplicativeArg GhcTc
    forall idL.
    XApplicativeArgMany idL
    -> [ExprLStmt idL]
    -> HsExpr idL
    -> LPat idL
    -> HsStmtContext (GhcPass 'Renamed)
    -> ApplicativeArg idL
    ApplicativeArgMany XApplicativeArgMany GhcTc
    x)
          ([ExprLStmt GhcTc]
     -> HsExpr GhcTc
     -> Located (Pat GhcTc)
     -> HsStmtContext (GhcPass 'Renamed)
     -> ApplicativeArg GhcTc)
    -> TM [ExprLStmt GhcTc]
    -> TM
         (HsExpr GhcTc
          -> Located (Pat GhcTc)
          -> HsStmtContext (GhcPass 'Renamed)
          -> ApplicativeArg GhcTc)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Maybe (Bool -> BoxLabel)
    -> [ExprLStmt GhcTc] -> TM [ExprLStmt GhcTc]
    addTickLStmts Maybe (Bool -> BoxLabel)
    isGuard [ExprLStmt GhcTc]
    stmts
          TM
      (HsExpr GhcTc
       -> Located (Pat GhcTc)
       -> HsStmtContext (GhcPass 'Renamed)
       -> ApplicativeArg GhcTc)
    -> TM (HsExpr GhcTc)
    -> TM
         (Located (Pat GhcTc)
          -> HsStmtContext (GhcPass 'Renamed) -> ApplicativeArg GhcTc)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (LHsExpr GhcTc -> HsExpr GhcTc
    forall l e. GenLocated l e -> e
    unLoc (LHsExpr GhcTc -> HsExpr GhcTc)
    -> TM (LHsExpr GhcTc) -> TM (HsExpr GhcTc)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExpr (SrcSpan -> HsExpr GhcTc -> LHsExpr GhcTc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    hpcSrcSpan HsExpr GhcTc
    ret))
          TM
      (Located (Pat GhcTc)
       -> HsStmtContext (GhcPass 'Renamed) -> ApplicativeArg GhcTc)
    -> TM (Located (Pat GhcTc))
    -> TM (HsStmtContext (GhcPass 'Renamed) -> ApplicativeArg GhcTc)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> LPat GhcTc -> TM (LPat GhcTc)
    addTickLPat LPat GhcTc
    pat
          TM (HsStmtContext (GhcPass 'Renamed) -> ApplicativeArg GhcTc)
    -> TM (HsStmtContext (GhcPass 'Renamed))
    -> TM (ApplicativeArg GhcTc)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> HsStmtContext (GhcPass 'Renamed)
    -> TM (HsStmtContext (GhcPass 'Renamed))
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure HsStmtContext (GhcPass 'Renamed)
    ctxt

    addTickStmtAndBinders :: Maybe (Bool -> BoxLabel) -> ParStmtBlock GhcTc GhcTc
                          -> TM (ParStmtBlock GhcTc GhcTc)
    addTickStmtAndBinders :: Maybe (Bool -> BoxLabel)
    -> ParStmtBlock GhcTc GhcTc -> TM (ParStmtBlock GhcTc GhcTc)
    addTickStmtAndBinders Maybe (Bool -> BoxLabel)
    isGuard (ParStmtBlock XParStmtBlock GhcTc GhcTc
    x [ExprLStmt GhcTc]
    stmts [IdP GhcTc]
    ids SyntaxExpr GhcTc
    returnExpr) =
        ([ExprLStmt GhcTc]
     -> [Id] -> SyntaxExprTc -> ParStmtBlock GhcTc GhcTc)
    -> TM [ExprLStmt GhcTc]
    -> TM [Id]
    -> TM SyntaxExprTc
    -> TM (ParStmtBlock GhcTc GhcTc)
    forall (m :: * -> *) a1 a2 a3 r.
    Monad m =>
    (a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
    liftM3 (XParStmtBlock GhcTc GhcTc
    -> [ExprLStmt GhcTc]
    -> [IdP GhcTc]
    -> SyntaxExpr GhcTc
    -> ParStmtBlock GhcTc GhcTc
    forall idL idR.
    XParStmtBlock idL idR
    -> [ExprLStmt idL]
    -> [IdP idR]
    -> SyntaxExpr idR
    -> ParStmtBlock idL idR
    ParStmtBlock XParStmtBlock GhcTc GhcTc
    x)
            (Maybe (Bool -> BoxLabel)
    -> [ExprLStmt GhcTc] -> TM [ExprLStmt GhcTc]
    addTickLStmts Maybe (Bool -> BoxLabel)
    isGuard [ExprLStmt GhcTc]
    stmts)
            ([Id] -> TM [Id]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [Id]
    [IdP GhcTc]
    ids)
            (SrcSpan -> SyntaxExpr GhcTc -> TM (SyntaxExpr GhcTc)
    addTickSyntaxExpr SrcSpan
    hpcSrcSpan SyntaxExpr GhcTc
    returnExpr)

    addTickHsLocalBinds :: HsLocalBinds GhcTc -> TM (HsLocalBinds GhcTc)
    addTickHsLocalBinds :: HsLocalBinds GhcTc -> TM (HsLocalBinds GhcTc)
    addTickHsLocalBinds (HsValBinds XHsValBinds GhcTc GhcTc
    x HsValBindsLR GhcTc GhcTc
    binds) =
            (HsValBindsLR GhcTc GhcTc -> HsLocalBinds GhcTc)
    -> TM (HsValBindsLR GhcTc GhcTc) -> TM (HsLocalBinds GhcTc)
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM (XHsValBinds GhcTc GhcTc
    -> HsValBindsLR GhcTc GhcTc -> HsLocalBinds GhcTc
    forall idL idR.
    XHsValBinds idL idR
    -> HsValBindsLR idL idR -> HsLocalBindsLR idL idR
    HsValBinds XHsValBinds GhcTc GhcTc
    x)
                    (HsValBindsLR GhcTc GhcTc -> TM (HsValBindsLR GhcTc GhcTc)
    forall (a :: Pass) (b :: Pass).
    HsValBindsLR GhcTc (GhcPass a)
    -> TM (HsValBindsLR GhcTc (GhcPass b))
    addTickHsValBinds HsValBindsLR GhcTc GhcTc
    binds)
    addTickHsLocalBinds (HsIPBinds XHsIPBinds GhcTc GhcTc
    x HsIPBinds GhcTc
    binds)  =
            (HsIPBinds GhcTc -> HsLocalBinds GhcTc)
    -> TM (HsIPBinds GhcTc) -> TM (HsLocalBinds GhcTc)
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM (XHsIPBinds GhcTc GhcTc -> HsIPBinds GhcTc -> HsLocalBinds GhcTc
    forall idL idR.
    XHsIPBinds idL idR -> HsIPBinds idR -> HsLocalBindsLR idL idR
    HsIPBinds XHsIPBinds GhcTc GhcTc
    x)
                    (HsIPBinds GhcTc -> TM (HsIPBinds GhcTc)
    addTickHsIPBinds HsIPBinds GhcTc
    binds)
    addTickHsLocalBinds (EmptyLocalBinds XEmptyLocalBinds GhcTc GhcTc
    x)  = HsLocalBinds GhcTc -> TM (HsLocalBinds GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XEmptyLocalBinds GhcTc GhcTc -> HsLocalBinds GhcTc
    forall idL idR. XEmptyLocalBinds idL idR -> HsLocalBindsLR idL idR
    EmptyLocalBinds XEmptyLocalBinds GhcTc GhcTc
    x)

    addTickHsValBinds :: HsValBindsLR GhcTc (GhcPass a)
                      -> TM (HsValBindsLR GhcTc (GhcPass b))
    addTickHsValBinds :: forall (a :: Pass) (b :: Pass).
    HsValBindsLR GhcTc (GhcPass a)
    -> TM (HsValBindsLR GhcTc (GhcPass b))
    addTickHsValBinds (XValBindsLR (NValBinds [(RecFlag, LHsBinds GhcTc)]
    binds [LSig (GhcPass 'Renamed)]
    sigs)) = do
            NHsValBindsLR GhcTc
    b <- ([(RecFlag, LHsBinds GhcTc)]
     -> [LSig (GhcPass 'Renamed)] -> NHsValBindsLR GhcTc)
    -> TM [(RecFlag, LHsBinds GhcTc)]
    -> TM [LSig (GhcPass 'Renamed)]
    -> TM (NHsValBindsLR GhcTc)
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 [(RecFlag, LHsBinds GhcTc)]
    -> [LSig (GhcPass 'Renamed)] -> NHsValBindsLR GhcTc
    forall idL.
    [(RecFlag, LHsBinds idL)]
    -> [LSig (GhcPass 'Renamed)] -> NHsValBindsLR idL
    NValBinds
                    (((RecFlag, LHsBinds GhcTc) -> TM (RecFlag, LHsBinds GhcTc))
    -> [(RecFlag, LHsBinds GhcTc)] -> TM [(RecFlag, LHsBinds GhcTc)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM (\ (RecFlag
    rec,LHsBinds GhcTc
    binds') ->
                                    (RecFlag -> LHsBinds GhcTc -> (RecFlag, LHsBinds GhcTc))
    -> TM RecFlag
    -> TM (LHsBinds GhcTc)
    -> TM (RecFlag, LHsBinds GhcTc)
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 (,)
                                            (RecFlag -> TM RecFlag
    forall (m :: * -> *) a. Monad m => a -> m a
    return RecFlag
    rec)
                                            (LHsBinds GhcTc -> TM (LHsBinds GhcTc)
    addTickLHsBinds LHsBinds GhcTc
    binds'))
                            [(RecFlag, LHsBinds GhcTc)]
    binds)
                    ([LSig (GhcPass 'Renamed)] -> TM [LSig (GhcPass 'Renamed)]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [LSig (GhcPass 'Renamed)]
    sigs)
            HsValBindsLR GhcTc (GhcPass b)
    -> TM (HsValBindsLR GhcTc (GhcPass b))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (HsValBindsLR GhcTc (GhcPass b)
     -> TM (HsValBindsLR GhcTc (GhcPass b)))
    -> HsValBindsLR GhcTc (GhcPass b)
    -> TM (HsValBindsLR GhcTc (GhcPass b))
    forall a b. (a -> b) -> a -> b
    $ XXValBindsLR GhcTc (GhcPass b) -> HsValBindsLR GhcTc (GhcPass b)
    forall idL idR. XXValBindsLR idL idR -> HsValBindsLR idL idR
    XValBindsLR XXValBindsLR GhcTc (GhcPass b)
    NHsValBindsLR GhcTc
    b
    addTickHsValBinds HsValBindsLR GhcTc (GhcPass a)
    _ = FilePath -> TM (HsValBindsLR GhcTc (GhcPass b))
    forall a. FilePath -> a
    panic FilePath
    "addTickHsValBinds"

    addTickHsIPBinds :: HsIPBinds GhcTc -> TM (HsIPBinds GhcTc)
    addTickHsIPBinds :: HsIPBinds GhcTc -> TM (HsIPBinds GhcTc)
    addTickHsIPBinds (IPBinds XIPBinds GhcTc
    dictbinds [LIPBind GhcTc]
    ipbinds) =
            (TcEvBinds -> [LIPBind GhcTc] -> HsIPBinds GhcTc)
    -> TM TcEvBinds -> TM [LIPBind GhcTc] -> TM (HsIPBinds GhcTc)
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 TcEvBinds -> [LIPBind GhcTc] -> HsIPBinds GhcTc
    forall id. XIPBinds id -> [LIPBind id] -> HsIPBinds id
    IPBinds
                    (TcEvBinds -> TM TcEvBinds
    forall (m :: * -> *) a. Monad m => a -> m a
    return XIPBinds GhcTc
    TcEvBinds
    dictbinds)
                    ((LIPBind GhcTc -> TM (LIPBind GhcTc))
    -> [LIPBind GhcTc] -> TM [LIPBind GhcTc]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM ((IPBind GhcTc -> TM (IPBind GhcTc))
    -> LIPBind GhcTc -> TM (LIPBind GhcTc)
    forall (m :: * -> *) a b l.
    Monad m =>
    (a -> m b) -> GenLocated l a -> m (GenLocated l b)
    liftL (IPBind GhcTc -> TM (IPBind GhcTc)
    addTickIPBind)) [LIPBind GhcTc]
    ipbinds)

    addTickIPBind :: IPBind GhcTc -> TM (IPBind GhcTc)
    addTickIPBind :: IPBind GhcTc -> TM (IPBind GhcTc)
    addTickIPBind (IPBind XCIPBind GhcTc
    x Either (Located HsIPName) (IdP GhcTc)
    nm LHsExpr GhcTc
    e) =
            (Either (Located HsIPName) Id -> LHsExpr GhcTc -> IPBind GhcTc)
    -> TM (Either (Located HsIPName) Id)
    -> TM (LHsExpr GhcTc)
    -> TM (IPBind GhcTc)
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 (XCIPBind GhcTc
    -> Either (Located HsIPName) (IdP GhcTc)
    -> LHsExpr GhcTc
    -> IPBind GhcTc
    forall id.
    XCIPBind id
    -> Either (Located HsIPName) (IdP id) -> LHsExpr id -> IPBind id
    IPBind XCIPBind GhcTc
    x)
                    (Either (Located HsIPName) Id -> TM (Either (Located HsIPName) Id)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Either (Located HsIPName) Id
    Either (Located HsIPName) (IdP GhcTc)
    nm)
                    (LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExpr LHsExpr GhcTc
    e)

    -- There is no location here, so we might need to use a context location??
    addTickSyntaxExpr :: SrcSpan -> SyntaxExpr GhcTc -> TM (SyntaxExpr GhcTc)
    addTickSyntaxExpr :: SrcSpan -> SyntaxExpr GhcTc -> TM (SyntaxExpr GhcTc)
    addTickSyntaxExpr SrcSpan
    pos syn :: SyntaxExpr GhcTc
    syn@(SyntaxExprTc { syn_expr :: SyntaxExprTc -> HsExpr GhcTc
    syn_expr = HsExpr GhcTc
    x }) = do
            HsExpr GhcTc
    x' <- (LHsExpr GhcTc -> HsExpr GhcTc)
    -> TM (LHsExpr GhcTc) -> TM (HsExpr GhcTc)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap LHsExpr GhcTc -> HsExpr GhcTc
    forall l e. GenLocated l e -> e
    unLoc (LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExpr (SrcSpan -> HsExpr GhcTc -> LHsExpr GhcTc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    pos HsExpr GhcTc
    x))
            SyntaxExprTc -> TM SyntaxExprTc
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SyntaxExprTc -> TM SyntaxExprTc)
    -> SyntaxExprTc -> TM SyntaxExprTc
    forall a b. (a -> b) -> a -> b
    $ SyntaxExpr GhcTc
    SyntaxExprTc
    syn { syn_expr :: HsExpr GhcTc
    syn_expr = HsExpr GhcTc
    x' }
    addTickSyntaxExpr SrcSpan
    _ SyntaxExpr GhcTc
    SyntaxExprTc
    NoSyntaxExprTc = SyntaxExprTc -> TM SyntaxExprTc
    forall (m :: * -> *) a. Monad m => a -> m a
    return SyntaxExprTc
    NoSyntaxExprTc

    -- we do not walk into patterns.
    addTickLPat :: LPat GhcTc -> TM (LPat GhcTc)
    addTickLPat :: LPat GhcTc -> TM (LPat GhcTc)
    addTickLPat LPat GhcTc
    pat = Located (Pat GhcTc) -> TM (Located (Pat GhcTc))
    forall (m :: * -> *) a. Monad m => a -> m a
    return Located (Pat GhcTc)
    LPat GhcTc
    pat

    addTickHsCmdTop :: HsCmdTop GhcTc -> TM (HsCmdTop GhcTc)
    addTickHsCmdTop :: HsCmdTop GhcTc -> TM (HsCmdTop GhcTc)
    addTickHsCmdTop (HsCmdTop XCmdTop GhcTc
    x LHsCmd GhcTc
    cmd) =
            (CmdTopTc -> LHsCmd GhcTc -> HsCmdTop GhcTc)
    -> TM CmdTopTc -> TM (LHsCmd GhcTc) -> TM (HsCmdTop GhcTc)
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 CmdTopTc -> LHsCmd GhcTc -> HsCmdTop GhcTc
    forall p. XCmdTop p -> LHsCmd p -> HsCmdTop p
    HsCmdTop
                    (CmdTopTc -> TM CmdTopTc
    forall (m :: * -> *) a. Monad m => a -> m a
    return XCmdTop GhcTc
    CmdTopTc
    x)
                    (LHsCmd GhcTc -> TM (LHsCmd GhcTc)
    addTickLHsCmd LHsCmd GhcTc
    cmd)

    addTickLHsCmd ::  LHsCmd GhcTc -> TM (LHsCmd GhcTc)
    addTickLHsCmd :: LHsCmd GhcTc -> TM (LHsCmd GhcTc)
    addTickLHsCmd (L SrcSpan
    pos HsCmd GhcTc
    c0) = do
            HsCmd GhcTc
    c1 <- HsCmd GhcTc -> TM (HsCmd GhcTc)
    addTickHsCmd HsCmd GhcTc
    c0
            LHsCmd GhcTc -> TM (LHsCmd GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LHsCmd GhcTc -> TM (LHsCmd GhcTc))
    -> LHsCmd GhcTc -> TM (LHsCmd GhcTc)
    forall a b. (a -> b) -> a -> b
    $ SrcSpan -> HsCmd GhcTc -> LHsCmd GhcTc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    pos HsCmd GhcTc
    c1

    addTickHsCmd :: HsCmd GhcTc -> TM (HsCmd GhcTc)
    addTickHsCmd :: HsCmd GhcTc -> TM (HsCmd GhcTc)
    addTickHsCmd (HsCmdLam XCmdLam GhcTc
    x MatchGroup GhcTc (LHsCmd GhcTc)
    matchgroup) =
            (MatchGroup GhcTc (LHsCmd GhcTc) -> HsCmd GhcTc)
    -> TM (MatchGroup GhcTc (LHsCmd GhcTc)) -> TM (HsCmd GhcTc)
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM (XCmdLam GhcTc -> MatchGroup GhcTc (LHsCmd GhcTc) -> HsCmd GhcTc
    forall id. XCmdLam id -> MatchGroup id (LHsCmd id) -> HsCmd id
    HsCmdLam XCmdLam GhcTc
    x) (MatchGroup GhcTc (LHsCmd GhcTc)
    -> TM (MatchGroup GhcTc (LHsCmd GhcTc))
    addTickCmdMatchGroup MatchGroup GhcTc (LHsCmd GhcTc)
    matchgroup)
    addTickHsCmd (HsCmdApp XCmdApp GhcTc
    x LHsCmd GhcTc
    c LHsExpr GhcTc
    e) =
            (LHsCmd GhcTc -> LHsExpr GhcTc -> HsCmd GhcTc)
    -> TM (LHsCmd GhcTc) -> TM (LHsExpr GhcTc) -> TM (HsCmd GhcTc)
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 (XCmdApp GhcTc -> LHsCmd GhcTc -> LHsExpr GhcTc -> HsCmd GhcTc
    forall id. XCmdApp id -> LHsCmd id -> LHsExpr id -> HsCmd id
    HsCmdApp XCmdApp GhcTc
    x) (LHsCmd GhcTc -> TM (LHsCmd GhcTc)
    addTickLHsCmd LHsCmd GhcTc
    c) (LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExpr LHsExpr GhcTc
    e)
    {-
    addTickHsCmd (OpApp e1 c2 fix c3) =
            liftM4 OpApp
                    (addTickLHsExpr e1)
                    (addTickLHsCmd c2)
                    (return fix)
                    (addTickLHsCmd c3)
    -}
    addTickHsCmd (HsCmdPar XCmdPar GhcTc
    x LHsCmd GhcTc
    e) = (LHsCmd GhcTc -> HsCmd GhcTc)
    -> TM (LHsCmd GhcTc) -> TM (HsCmd GhcTc)
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM (XCmdPar GhcTc -> LHsCmd GhcTc -> HsCmd GhcTc
    forall id. XCmdPar id -> LHsCmd id -> HsCmd id
    HsCmdPar XCmdPar GhcTc
    x) (LHsCmd GhcTc -> TM (LHsCmd GhcTc)
    addTickLHsCmd LHsCmd GhcTc
    e)
    addTickHsCmd (HsCmdCase XCmdCase GhcTc
    x LHsExpr GhcTc
    e MatchGroup GhcTc (LHsCmd GhcTc)
    mgs) =
            (LHsExpr GhcTc -> MatchGroup GhcTc (LHsCmd GhcTc) -> HsCmd GhcTc)
    -> TM (LHsExpr GhcTc)
    -> TM (MatchGroup GhcTc (LHsCmd GhcTc))
    -> TM (HsCmd GhcTc)
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 (XCmdCase GhcTc
    -> LHsExpr GhcTc -> MatchGroup GhcTc (LHsCmd GhcTc) -> HsCmd GhcTc
    forall id.
    XCmdCase id -> LHsExpr id -> MatchGroup id (LHsCmd id) -> HsCmd id
    HsCmdCase XCmdCase GhcTc
    x)
                    (LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExpr LHsExpr GhcTc
    e)
                    (MatchGroup GhcTc (LHsCmd GhcTc)
    -> TM (MatchGroup GhcTc (LHsCmd GhcTc))
    addTickCmdMatchGroup MatchGroup GhcTc (LHsCmd GhcTc)
    mgs)
    addTickHsCmd (HsCmdLamCase XCmdLamCase GhcTc
    x MatchGroup GhcTc (LHsCmd GhcTc)
    mgs) =
            (MatchGroup GhcTc (LHsCmd GhcTc) -> HsCmd GhcTc)
    -> TM (MatchGroup GhcTc (LHsCmd GhcTc)) -> TM (HsCmd GhcTc)
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM (XCmdLamCase GhcTc -> MatchGroup GhcTc (LHsCmd GhcTc) -> HsCmd GhcTc
    forall id. XCmdLamCase id -> MatchGroup id (LHsCmd id) -> HsCmd id
    HsCmdLamCase XCmdLamCase GhcTc
    x) (MatchGroup GhcTc (LHsCmd GhcTc)
    -> TM (MatchGroup GhcTc (LHsCmd GhcTc))
    addTickCmdMatchGroup MatchGroup GhcTc (LHsCmd GhcTc)
    mgs)
    addTickHsCmd (HsCmdIf XCmdIf GhcTc
    x SyntaxExpr GhcTc
    cnd LHsExpr GhcTc
    e1 LHsCmd GhcTc
    c2 LHsCmd GhcTc
    c3) =
            (LHsExpr GhcTc -> LHsCmd GhcTc -> LHsCmd GhcTc -> HsCmd GhcTc)
    -> TM (LHsExpr GhcTc)
    -> TM (LHsCmd GhcTc)
    -> TM (LHsCmd GhcTc)
    -> TM (HsCmd GhcTc)
    forall (m :: * -> *) a1 a2 a3 r.
    Monad m =>
    (a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
    liftM3 (XCmdIf GhcTc
    -> SyntaxExpr GhcTc
    -> LHsExpr GhcTc
    -> LHsCmd GhcTc
    -> LHsCmd GhcTc
    -> HsCmd GhcTc
    forall id.
    XCmdIf id
    -> SyntaxExpr id
    -> LHsExpr id
    -> LHsCmd id
    -> LHsCmd id
    -> HsCmd id
    HsCmdIf XCmdIf GhcTc
    x SyntaxExpr GhcTc
    cnd)
                    ((Bool -> BoxLabel) -> LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addBinTickLHsExpr (CondBox -> Bool -> BoxLabel
    BinBox CondBox
    CondBinBox) LHsExpr GhcTc
    e1)
                    (LHsCmd GhcTc -> TM (LHsCmd GhcTc)
    addTickLHsCmd LHsCmd GhcTc
    c2)
                    (LHsCmd GhcTc -> TM (LHsCmd GhcTc)
    addTickLHsCmd LHsCmd GhcTc
    c3)
    addTickHsCmd (HsCmdLet XCmdLet GhcTc
    x (L SrcSpan
    l HsLocalBinds GhcTc
    binds) LHsCmd GhcTc
    c) =
            [Id] -> TM (HsCmd GhcTc) -> TM (HsCmd GhcTc)
    forall a. [Id] -> TM a -> TM a
    bindLocals (HsLocalBinds GhcTc -> [IdP GhcTc]
    forall (idL :: Pass) (idR :: Pass).
    CollectPass (GhcPass idL) =>
    HsLocalBindsLR (GhcPass idL) (GhcPass idR) -> [IdP (GhcPass idL)]
    collectLocalBinders HsLocalBinds GhcTc
    binds) (TM (HsCmd GhcTc) -> TM (HsCmd GhcTc))
    -> TM (HsCmd GhcTc) -> TM (HsCmd GhcTc)
    forall a b. (a -> b) -> a -> b
    $
              (HsLocalBinds GhcTc -> LHsCmd GhcTc -> HsCmd GhcTc)
    -> TM (HsLocalBinds GhcTc) -> TM (LHsCmd GhcTc) -> TM (HsCmd GhcTc)
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 (XCmdLet GhcTc
    -> GenLocated SrcSpan (HsLocalBinds GhcTc)
    -> LHsCmd GhcTc
    -> HsCmd GhcTc
    forall id. XCmdLet id -> LHsLocalBinds id -> LHsCmd id -> HsCmd id
    HsCmdLet XCmdLet GhcTc
    x (GenLocated SrcSpan (HsLocalBinds GhcTc)
     -> LHsCmd GhcTc -> HsCmd GhcTc)
    -> (HsLocalBinds GhcTc -> GenLocated SrcSpan (HsLocalBinds GhcTc))
    -> HsLocalBinds GhcTc
    -> LHsCmd GhcTc
    -> HsCmd GhcTc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SrcSpan
    -> HsLocalBinds GhcTc -> GenLocated SrcSpan (HsLocalBinds GhcTc)
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    l)
                       (HsLocalBinds GhcTc -> TM (HsLocalBinds GhcTc)
    addTickHsLocalBinds HsLocalBinds GhcTc
    binds) -- to think about: !patterns.
                       (LHsCmd GhcTc -> TM (LHsCmd GhcTc)
    addTickLHsCmd LHsCmd GhcTc
    c)
    addTickHsCmd (HsCmdDo XCmdDo GhcTc
    srcloc (L SrcSpan
    l [CmdLStmt GhcTc]
    stmts))
      = do { ([CmdLStmt GhcTc]
    stmts', ()
    _) <- [CmdLStmt GhcTc] -> TM () -> TM ([CmdLStmt GhcTc], ())
    forall a. [CmdLStmt GhcTc] -> TM a -> TM ([CmdLStmt GhcTc], a)
    addTickLCmdStmts' [CmdLStmt GhcTc]
    stmts (() -> TM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())
           ; HsCmd GhcTc -> TM (HsCmd GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (XCmdDo GhcTc -> GenLocated SrcSpan [CmdLStmt GhcTc] -> HsCmd GhcTc
    forall id. XCmdDo id -> Located [CmdLStmt id] -> HsCmd id
    HsCmdDo XCmdDo GhcTc
    srcloc (SrcSpan -> [CmdLStmt GhcTc] -> GenLocated SrcSpan [CmdLStmt GhcTc]
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    l [CmdLStmt GhcTc]
    stmts')) }

    addTickHsCmd (HsCmdArrApp  XCmdArrApp GhcTc
    arr_ty LHsExpr GhcTc
    e1 LHsExpr GhcTc
    e2 HsArrAppType
    ty1 Bool
    lr) =
            (Type
     -> LHsExpr GhcTc
     -> LHsExpr GhcTc
     -> HsArrAppType
     -> Bool
     -> HsCmd GhcTc)
    -> TM Type
    -> TM (LHsExpr GhcTc)
    -> TM (LHsExpr GhcTc)
    -> TM HsArrAppType
    -> TM Bool
    -> TM (HsCmd GhcTc)
    forall (m :: * -> *) a1 a2 a3 a4 a5 r.
    Monad m =>
    (a1 -> a2 -> a3 -> a4 -> a5 -> r)
    -> m a1 -> m a2 -> m a3 -> m a4 -> m a5 -> m r
    liftM5 Type
    -> LHsExpr GhcTc
    -> LHsExpr GhcTc
    -> HsArrAppType
    -> Bool
    -> HsCmd GhcTc
    forall id.
    XCmdArrApp id
    -> LHsExpr id -> LHsExpr id -> HsArrAppType -> Bool -> HsCmd id
    HsCmdArrApp
                   (Type -> TM Type
    forall (m :: * -> *) a. Monad m => a -> m a
    return Type
    XCmdArrApp GhcTc
    arr_ty)
                   (LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExpr LHsExpr GhcTc
    e1)
                   (LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExpr LHsExpr GhcTc
    e2)
                   (HsArrAppType -> TM HsArrAppType
    forall (m :: * -> *) a. Monad m => a -> m a
    return HsArrAppType
    ty1)
                   (Bool -> TM Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    lr)
    addTickHsCmd (HsCmdArrForm XCmdArrForm GhcTc
    x LHsExpr GhcTc
    e LexicalFixity
    f Maybe Fixity
    fix [LHsCmdTop GhcTc]
    cmdtop) =
            (LHsExpr GhcTc
     -> LexicalFixity
     -> Maybe Fixity
     -> [LHsCmdTop GhcTc]
     -> HsCmd GhcTc)
    -> TM (LHsExpr GhcTc)
    -> TM LexicalFixity
    -> TM (Maybe Fixity)
    -> TM [LHsCmdTop GhcTc]
    -> TM (HsCmd GhcTc)
    forall (m :: * -> *) a1 a2 a3 a4 r.
    Monad m =>
    (a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r
    liftM4 (XCmdArrForm GhcTc
    -> LHsExpr GhcTc
    -> LexicalFixity
    -> Maybe Fixity
    -> [LHsCmdTop GhcTc]
    -> HsCmd GhcTc
    forall id.
    XCmdArrForm id
    -> LHsExpr id
    -> LexicalFixity
    -> Maybe Fixity
    -> [LHsCmdTop id]
    -> HsCmd id
    HsCmdArrForm XCmdArrForm GhcTc
    x)
                   (LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExpr LHsExpr GhcTc
    e)
                   (LexicalFixity -> TM LexicalFixity
    forall (m :: * -> *) a. Monad m => a -> m a
    return LexicalFixity
    f)
                   (Maybe Fixity -> TM (Maybe Fixity)
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe Fixity
    fix)
                   ((LHsCmdTop GhcTc -> TM (LHsCmdTop GhcTc))
    -> [LHsCmdTop GhcTc] -> TM [LHsCmdTop GhcTc]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM ((HsCmdTop GhcTc -> TM (HsCmdTop GhcTc))
    -> LHsCmdTop GhcTc -> TM (LHsCmdTop GhcTc)
    forall (m :: * -> *) a b l.
    Monad m =>
    (a -> m b) -> GenLocated l a -> m (GenLocated l b)
    liftL (HsCmdTop GhcTc -> TM (HsCmdTop GhcTc)
    addTickHsCmdTop)) [LHsCmdTop GhcTc]
    cmdtop)

    addTickHsCmd (XCmd (HsWrap HsWrapper
    w HsCmd GhcTc
    cmd)) =
      (HsWrap HsCmd -> HsCmd GhcTc)
    -> TM (HsWrap HsCmd) -> TM (HsCmd GhcTc)
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM HsWrap HsCmd -> HsCmd GhcTc
    forall id. XXCmd id -> HsCmd id
    XCmd (TM (HsWrap HsCmd) -> TM (HsCmd GhcTc))
    -> TM (HsWrap HsCmd) -> TM (HsCmd GhcTc)
    forall a b. (a -> b) -> a -> b
    $
      (HsCmd GhcTc -> HsWrap HsCmd)
    -> TM (HsCmd GhcTc) -> TM (HsWrap HsCmd)
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM (HsWrapper -> HsCmd GhcTc -> HsWrap HsCmd
    forall (hs_syn :: * -> *).
    HsWrapper -> hs_syn GhcTc -> HsWrap hs_syn
    HsWrap HsWrapper
    w) (HsCmd GhcTc -> TM (HsCmd GhcTc)
    addTickHsCmd HsCmd GhcTc
    cmd)

    -- Others should never happen in a command context.
    --addTickHsCmd e  = pprPanic "addTickHsCmd" (ppr e)

    addTickCmdMatchGroup :: MatchGroup GhcTc (LHsCmd GhcTc)
                         -> TM (MatchGroup GhcTc (LHsCmd GhcTc))
    addTickCmdMatchGroup :: MatchGroup GhcTc (LHsCmd GhcTc)
    -> TM (MatchGroup GhcTc (LHsCmd GhcTc))
    addTickCmdMatchGroup mg :: MatchGroup GhcTc (LHsCmd GhcTc)
    mg@(MG { mg_alts :: forall p body. MatchGroup p body -> Located [LMatch p body]
    mg_alts = (L SrcSpan
    l [LMatch GhcTc (LHsCmd GhcTc)]
    matches) }) = do
      [LMatch GhcTc (LHsCmd GhcTc)]
    matches' <- (LMatch GhcTc (LHsCmd GhcTc) -> TM (LMatch GhcTc (LHsCmd GhcTc)))
    -> [LMatch GhcTc (LHsCmd GhcTc)]
    -> TM [LMatch GhcTc (LHsCmd GhcTc)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM ((Match GhcTc (LHsCmd GhcTc) -> TM (Match GhcTc (LHsCmd GhcTc)))
    -> LMatch GhcTc (LHsCmd GhcTc) -> TM (LMatch GhcTc (LHsCmd GhcTc))
    forall (m :: * -> *) a b l.
    Monad m =>
    (a -> m b) -> GenLocated l a -> m (GenLocated l b)
    liftL Match GhcTc (LHsCmd GhcTc) -> TM (Match GhcTc (LHsCmd GhcTc))
    addTickCmdMatch) [LMatch GhcTc (LHsCmd GhcTc)]
    matches
      MatchGroup GhcTc (LHsCmd GhcTc)
    -> TM (MatchGroup GhcTc (LHsCmd GhcTc))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (MatchGroup GhcTc (LHsCmd GhcTc)
     -> TM (MatchGroup GhcTc (LHsCmd GhcTc)))
    -> MatchGroup GhcTc (LHsCmd GhcTc)
    -> TM (MatchGroup GhcTc (LHsCmd GhcTc))
    forall a b. (a -> b) -> a -> b
    $ MatchGroup GhcTc (LHsCmd GhcTc)
    mg { mg_alts :: GenLocated SrcSpan [LMatch GhcTc (LHsCmd GhcTc)]
    mg_alts = SrcSpan
    -> [LMatch GhcTc (LHsCmd GhcTc)]
    -> GenLocated SrcSpan [LMatch GhcTc (LHsCmd GhcTc)]
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    l [LMatch GhcTc (LHsCmd GhcTc)]
    matches' }

    addTickCmdMatch :: Match GhcTc (LHsCmd GhcTc) -> TM (Match GhcTc (LHsCmd GhcTc))
    addTickCmdMatch :: Match GhcTc (LHsCmd GhcTc) -> TM (Match GhcTc (LHsCmd GhcTc))
    addTickCmdMatch match :: Match GhcTc (LHsCmd GhcTc)
    match@(Match { m_pats :: forall p body. Match p body -> [LPat p]
    m_pats = [LPat GhcTc]
    pats, m_grhss :: forall p body. Match p body -> GRHSs p body
    m_grhss = GRHSs GhcTc (LHsCmd GhcTc)
    gRHSs }) =
      [Id]
    -> TM (Match GhcTc (LHsCmd GhcTc))
    -> TM (Match GhcTc (LHsCmd GhcTc))
    forall a. [Id] -> TM a -> TM a
    bindLocals ([LPat GhcTc] -> [IdP GhcTc]
    forall p. CollectPass p => [LPat p] -> [IdP p]
    collectPatsBinders [LPat GhcTc]
    pats) (TM (Match GhcTc (LHsCmd GhcTc))
     -> TM (Match GhcTc (LHsCmd GhcTc)))
    -> TM (Match GhcTc (LHsCmd GhcTc))
    -> TM (Match GhcTc (LHsCmd GhcTc))
    forall a b. (a -> b) -> a -> b
    $ do
        GRHSs GhcTc (LHsCmd GhcTc)
    gRHSs' <- GRHSs GhcTc (LHsCmd GhcTc) -> TM (GRHSs GhcTc (LHsCmd GhcTc))
    addTickCmdGRHSs GRHSs GhcTc (LHsCmd GhcTc)
    gRHSs
        Match GhcTc (LHsCmd GhcTc) -> TM (Match GhcTc (LHsCmd GhcTc))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Match GhcTc (LHsCmd GhcTc) -> TM (Match GhcTc (LHsCmd GhcTc)))
    -> Match GhcTc (LHsCmd GhcTc) -> TM (Match GhcTc (LHsCmd GhcTc))
    forall a b. (a -> b) -> a -> b
    $ Match GhcTc (LHsCmd GhcTc)
    match { m_grhss :: GRHSs GhcTc (LHsCmd GhcTc)
    m_grhss = GRHSs GhcTc (LHsCmd GhcTc)
    gRHSs' }

    addTickCmdGRHSs :: GRHSs GhcTc (LHsCmd GhcTc) -> TM (GRHSs GhcTc (LHsCmd GhcTc))
    addTickCmdGRHSs :: GRHSs GhcTc (LHsCmd GhcTc) -> TM (GRHSs GhcTc (LHsCmd GhcTc))
    addTickCmdGRHSs (GRHSs XCGRHSs GhcTc (LHsCmd GhcTc)
    x [LGRHS GhcTc (LHsCmd GhcTc)]
    guarded (L SrcSpan
    l HsLocalBinds GhcTc
    local_binds)) = do
      [Id]
    -> TM (GRHSs GhcTc (LHsCmd GhcTc))
    -> TM (GRHSs GhcTc (LHsCmd GhcTc))
    forall a. [Id] -> TM a -> TM a
    bindLocals [Id]
    [IdP GhcTc]
    binders (TM (GRHSs GhcTc (LHsCmd GhcTc))
     -> TM (GRHSs GhcTc (LHsCmd GhcTc)))
    -> TM (GRHSs GhcTc (LHsCmd GhcTc))
    -> TM (GRHSs GhcTc (LHsCmd GhcTc))
    forall a b. (a -> b) -> a -> b
    $ do
        HsLocalBinds GhcTc
    local_binds' <- HsLocalBinds GhcTc -> TM (HsLocalBinds GhcTc)
    addTickHsLocalBinds HsLocalBinds GhcTc
    local_binds
        [LGRHS GhcTc (LHsCmd GhcTc)]
    guarded' <- (LGRHS GhcTc (LHsCmd GhcTc) -> TM (LGRHS GhcTc (LHsCmd GhcTc)))
    -> [LGRHS GhcTc (LHsCmd GhcTc)] -> TM [LGRHS GhcTc (LHsCmd GhcTc)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM ((GRHS GhcTc (LHsCmd GhcTc) -> TM (GRHS GhcTc (LHsCmd GhcTc)))
    -> LGRHS GhcTc (LHsCmd GhcTc) -> TM (LGRHS GhcTc (LHsCmd GhcTc))
    forall (m :: * -> *) a b l.
    Monad m =>
    (a -> m b) -> GenLocated l a -> m (GenLocated l b)
    liftL GRHS GhcTc (LHsCmd GhcTc) -> TM (GRHS GhcTc (LHsCmd GhcTc))
    addTickCmdGRHS) [LGRHS GhcTc (LHsCmd GhcTc)]
    guarded
        GRHSs GhcTc (LHsCmd GhcTc) -> TM (GRHSs GhcTc (LHsCmd GhcTc))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (GRHSs GhcTc (LHsCmd GhcTc) -> TM (GRHSs GhcTc (LHsCmd GhcTc)))
    -> GRHSs GhcTc (LHsCmd GhcTc) -> TM (GRHSs GhcTc (LHsCmd GhcTc))
    forall a b. (a -> b) -> a -> b
    $ XCGRHSs GhcTc (LHsCmd GhcTc)
    -> [LGRHS GhcTc (LHsCmd GhcTc)]
    -> GenLocated SrcSpan (HsLocalBinds GhcTc)
    -> GRHSs GhcTc (LHsCmd GhcTc)
    forall p body.
    XCGRHSs p body -> [LGRHS p body] -> LHsLocalBinds p -> GRHSs p body
    GRHSs XCGRHSs GhcTc (LHsCmd GhcTc)
    x [LGRHS GhcTc (LHsCmd GhcTc)]
    guarded' (SrcSpan
    -> HsLocalBinds GhcTc -> GenLocated SrcSpan (HsLocalBinds GhcTc)
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    l HsLocalBinds GhcTc
    local_binds')
      where
        binders :: [IdP GhcTc]
    binders = HsLocalBinds GhcTc -> [IdP GhcTc]
    forall (idL :: Pass) (idR :: Pass).
    CollectPass (GhcPass idL) =>
    HsLocalBindsLR (GhcPass idL) (GhcPass idR) -> [IdP (GhcPass idL)]
    collectLocalBinders HsLocalBinds GhcTc
    local_binds

    addTickCmdGRHS :: GRHS GhcTc (LHsCmd GhcTc) -> TM (GRHS GhcTc (LHsCmd GhcTc))
    -- The *guards* are *not* Cmds, although the body is
    -- C.f. addTickGRHS for the BinBox stuff
    addTickCmdGRHS :: GRHS GhcTc (LHsCmd GhcTc) -> TM (GRHS GhcTc (LHsCmd GhcTc))
    addTickCmdGRHS (GRHS XCGRHS GhcTc (LHsCmd GhcTc)
    x [ExprLStmt GhcTc]
    stmts LHsCmd GhcTc
    cmd)
      = do { ([ExprLStmt GhcTc]
    stmts',LHsCmd GhcTc
    expr') <- Maybe (Bool -> BoxLabel)
    -> [ExprLStmt GhcTc]
    -> TM (LHsCmd GhcTc)
    -> TM ([ExprLStmt GhcTc], LHsCmd GhcTc)
    forall a.
    Maybe (Bool -> BoxLabel)
    -> [ExprLStmt GhcTc] -> TM a -> TM ([ExprLStmt GhcTc], a)
    addTickLStmts' ((Bool -> BoxLabel) -> Maybe (Bool -> BoxLabel)
    forall a. a -> Maybe a
    Just ((Bool -> BoxLabel) -> Maybe (Bool -> BoxLabel))
    -> (Bool -> BoxLabel) -> Maybe (Bool -> BoxLabel)
    forall a b. (a -> b) -> a -> b
    $ CondBox -> Bool -> BoxLabel
    BinBox (CondBox -> Bool -> BoxLabel) -> CondBox -> Bool -> BoxLabel
    forall a b. (a -> b) -> a -> b
    $ CondBox
    GuardBinBox)
                                       [ExprLStmt GhcTc]
    stmts (LHsCmd GhcTc -> TM (LHsCmd GhcTc)
    addTickLHsCmd LHsCmd GhcTc
    cmd)
           ; GRHS GhcTc (LHsCmd GhcTc) -> TM (GRHS GhcTc (LHsCmd GhcTc))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (GRHS GhcTc (LHsCmd GhcTc) -> TM (GRHS GhcTc (LHsCmd GhcTc)))
    -> GRHS GhcTc (LHsCmd GhcTc) -> TM (GRHS GhcTc (LHsCmd GhcTc))
    forall a b. (a -> b) -> a -> b
    $ XCGRHS GhcTc (LHsCmd GhcTc)
    -> [ExprLStmt GhcTc] -> LHsCmd GhcTc -> GRHS GhcTc (LHsCmd GhcTc)
    forall p body.
    XCGRHS p body -> [GuardLStmt p] -> body -> GRHS p body
    GRHS XCGRHS GhcTc (LHsCmd GhcTc)
    x [ExprLStmt GhcTc]
    stmts' LHsCmd GhcTc
    expr' }

    addTickLCmdStmts :: [LStmt GhcTc (LHsCmd GhcTc)]
                     -> TM [LStmt GhcTc (LHsCmd GhcTc)]
    addTickLCmdStmts :: [CmdLStmt GhcTc] -> TM [CmdLStmt GhcTc]
    addTickLCmdStmts [CmdLStmt GhcTc]
    stmts = do
      ([CmdLStmt GhcTc]
    stmts, ()
    _) <- [CmdLStmt GhcTc] -> TM () -> TM ([CmdLStmt GhcTc], ())
    forall a. [CmdLStmt GhcTc] -> TM a -> TM ([CmdLStmt GhcTc], a)
    addTickLCmdStmts' [CmdLStmt GhcTc]
    stmts (() -> TM ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())
      [CmdLStmt GhcTc] -> TM [CmdLStmt GhcTc]
    forall (m :: * -> *) a. Monad m => a -> m a
    return [CmdLStmt GhcTc]
    stmts

    addTickLCmdStmts' :: [LStmt GhcTc (LHsCmd GhcTc)] -> TM a
                      -> TM ([LStmt GhcTc (LHsCmd GhcTc)], a)
    addTickLCmdStmts' :: forall a. [CmdLStmt GhcTc] -> TM a -> TM ([CmdLStmt GhcTc], a)
    addTickLCmdStmts' [CmdLStmt GhcTc]
    lstmts TM a
    res
      = [Id] -> TM ([CmdLStmt GhcTc], a) -> TM ([CmdLStmt GhcTc], a)
    forall a. [Id] -> TM a -> TM a
    bindLocals [Id]
    [IdP GhcTc]
    binders (TM ([CmdLStmt GhcTc], a) -> TM ([CmdLStmt GhcTc], a))
    -> TM ([CmdLStmt GhcTc], a) -> TM ([CmdLStmt GhcTc], a)
    forall a b. (a -> b) -> a -> b
    $ do
            [CmdLStmt GhcTc]
    lstmts' <- (CmdLStmt GhcTc -> TM (CmdLStmt GhcTc))
    -> [CmdLStmt GhcTc] -> TM [CmdLStmt GhcTc]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM ((Stmt GhcTc (LHsCmd GhcTc) -> TM (Stmt GhcTc (LHsCmd GhcTc)))
    -> CmdLStmt GhcTc -> TM (CmdLStmt GhcTc)
    forall (m :: * -> *) a b l.
    Monad m =>
    (a -> m b) -> GenLocated l a -> m (GenLocated l b)
    liftL Stmt GhcTc (LHsCmd GhcTc) -> TM (Stmt GhcTc (LHsCmd GhcTc))
    addTickCmdStmt) [CmdLStmt GhcTc]
    lstmts
            a
    a <- TM a
    res
            ([CmdLStmt GhcTc], a) -> TM ([CmdLStmt GhcTc], a)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([CmdLStmt GhcTc]
    lstmts', a
    a)
      where
            binders :: [IdP GhcTc]
    binders = [CmdLStmt GhcTc] -> [IdP GhcTc]
    forall (idL :: Pass) (idR :: Pass) body.
    CollectPass (GhcPass idL) =>
    [LStmtLR (GhcPass idL) (GhcPass idR) body] -> [IdP (GhcPass idL)]
    collectLStmtsBinders [CmdLStmt GhcTc]
    lstmts

    addTickCmdStmt :: Stmt GhcTc (LHsCmd GhcTc) -> TM (Stmt GhcTc (LHsCmd GhcTc))
    addTickCmdStmt :: Stmt GhcTc (LHsCmd GhcTc) -> TM (Stmt GhcTc (LHsCmd GhcTc))
    addTickCmdStmt (BindStmt XBindStmt GhcTc GhcTc (LHsCmd GhcTc)
    x LPat GhcTc
    pat LHsCmd GhcTc
    c) = do
            (Located (Pat GhcTc) -> LHsCmd GhcTc -> Stmt GhcTc (LHsCmd GhcTc))
    -> TM (Located (Pat GhcTc))
    -> TM (LHsCmd GhcTc)
    -> TM (Stmt GhcTc (LHsCmd GhcTc))
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 (XBindStmt GhcTc GhcTc (LHsCmd GhcTc)
    -> LPat GhcTc -> LHsCmd GhcTc -> Stmt GhcTc (LHsCmd GhcTc)
    forall idL idR body.
    XBindStmt idL idR body -> LPat idL -> body -> StmtLR idL idR body
    BindStmt XBindStmt GhcTc GhcTc (LHsCmd GhcTc)
    x)
                    (LPat GhcTc -> TM (LPat GhcTc)
    addTickLPat LPat GhcTc
    pat)
                    (LHsCmd GhcTc -> TM (LHsCmd GhcTc)
    addTickLHsCmd LHsCmd GhcTc
    c)
    addTickCmdStmt (LastStmt XLastStmt GhcTc GhcTc (LHsCmd GhcTc)
    x LHsCmd GhcTc
    c Maybe Bool
    noret SyntaxExpr GhcTc
    ret) = do
            (LHsCmd GhcTc
     -> Maybe Bool -> SyntaxExprTc -> Stmt GhcTc (LHsCmd GhcTc))
    -> TM (LHsCmd GhcTc)
    -> TM (Maybe Bool)
    -> TM SyntaxExprTc
    -> TM (Stmt GhcTc (LHsCmd GhcTc))
    forall (m :: * -> *) a1 a2 a3 r.
    Monad m =>
    (a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
    liftM3 (XLastStmt GhcTc GhcTc (LHsCmd GhcTc)
    -> LHsCmd GhcTc
    -> Maybe Bool
    -> SyntaxExpr GhcTc
    -> Stmt GhcTc (LHsCmd GhcTc)
    forall idL idR body.
    XLastStmt idL idR body
    -> body -> Maybe Bool -> SyntaxExpr idR -> StmtLR idL idR body
    LastStmt XLastStmt GhcTc GhcTc (LHsCmd GhcTc)
    x)
                    (LHsCmd GhcTc -> TM (LHsCmd GhcTc)
    addTickLHsCmd LHsCmd GhcTc
    c)
                    (Maybe Bool -> TM (Maybe Bool)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe Bool
    noret)
                    (SrcSpan -> SyntaxExpr GhcTc -> TM (SyntaxExpr GhcTc)
    addTickSyntaxExpr SrcSpan
    hpcSrcSpan SyntaxExpr GhcTc
    ret)
    addTickCmdStmt (BodyStmt XBodyStmt GhcTc GhcTc (LHsCmd GhcTc)
    x LHsCmd GhcTc
    c SyntaxExpr GhcTc
    bind' SyntaxExpr GhcTc
    guard') = do
            (LHsCmd GhcTc
     -> SyntaxExprTc -> SyntaxExprTc -> Stmt GhcTc (LHsCmd GhcTc))
    -> TM (LHsCmd GhcTc)
    -> TM SyntaxExprTc
    -> TM SyntaxExprTc
    -> TM (Stmt GhcTc (LHsCmd GhcTc))
    forall (m :: * -> *) a1 a2 a3 r.
    Monad m =>
    (a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
    liftM3 (XBodyStmt GhcTc GhcTc (LHsCmd GhcTc)
    -> LHsCmd GhcTc
    -> SyntaxExpr GhcTc
    -> SyntaxExpr GhcTc
    -> Stmt GhcTc (LHsCmd GhcTc)
    forall idL idR body.
    XBodyStmt idL idR body
    -> body -> SyntaxExpr idR -> SyntaxExpr idR -> StmtLR idL idR body
    BodyStmt XBodyStmt GhcTc GhcTc (LHsCmd GhcTc)
    x)
                    (LHsCmd GhcTc -> TM (LHsCmd GhcTc)
    addTickLHsCmd LHsCmd GhcTc
    c)
                    (SrcSpan -> SyntaxExpr GhcTc -> TM (SyntaxExpr GhcTc)
    addTickSyntaxExpr SrcSpan
    hpcSrcSpan SyntaxExpr GhcTc
    bind')
                    (SrcSpan -> SyntaxExpr GhcTc -> TM (SyntaxExpr GhcTc)
    addTickSyntaxExpr SrcSpan
    hpcSrcSpan SyntaxExpr GhcTc
    guard')
    addTickCmdStmt (LetStmt XLetStmt GhcTc GhcTc (LHsCmd GhcTc)
    x (L SrcSpan
    l HsLocalBinds GhcTc
    binds)) = do
            (HsLocalBinds GhcTc -> Stmt GhcTc (LHsCmd GhcTc))
    -> TM (HsLocalBinds GhcTc) -> TM (Stmt GhcTc (LHsCmd GhcTc))
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM (XLetStmt GhcTc GhcTc (LHsCmd GhcTc)
    -> GenLocated SrcSpan (HsLocalBinds GhcTc)
    -> Stmt GhcTc (LHsCmd GhcTc)
    forall idL idR body.
    XLetStmt idL idR body
    -> LHsLocalBindsLR idL idR -> StmtLR idL idR body
    LetStmt XLetStmt GhcTc GhcTc (LHsCmd GhcTc)
    x (GenLocated SrcSpan (HsLocalBinds GhcTc)
     -> Stmt GhcTc (LHsCmd GhcTc))
    -> (HsLocalBinds GhcTc -> GenLocated SrcSpan (HsLocalBinds GhcTc))
    -> HsLocalBinds GhcTc
    -> Stmt GhcTc (LHsCmd GhcTc)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SrcSpan
    -> HsLocalBinds GhcTc -> GenLocated SrcSpan (HsLocalBinds GhcTc)
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    l)
                    (HsLocalBinds GhcTc -> TM (HsLocalBinds GhcTc)
    addTickHsLocalBinds HsLocalBinds GhcTc
    binds)
    addTickCmdStmt stmt :: Stmt GhcTc (LHsCmd GhcTc)
    stmt@(RecStmt {})
      = do { [CmdLStmt GhcTc]
    stmts' <- [CmdLStmt GhcTc] -> TM [CmdLStmt GhcTc]
    addTickLCmdStmts (Stmt GhcTc (LHsCmd GhcTc) -> [CmdLStmt GhcTc]
    forall idL idR body. StmtLR idL idR body -> [LStmtLR idL idR body]
    recS_stmts Stmt GhcTc (LHsCmd GhcTc)
    stmt)
           ; SyntaxExprTc
    ret'   <- SrcSpan -> SyntaxExpr GhcTc -> TM (SyntaxExpr GhcTc)
    addTickSyntaxExpr SrcSpan
    hpcSrcSpan (Stmt GhcTc (LHsCmd GhcTc) -> SyntaxExpr GhcTc
    forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
    recS_ret_fn Stmt GhcTc (LHsCmd GhcTc)
    stmt)
           ; SyntaxExprTc
    mfix'  <- SrcSpan -> SyntaxExpr GhcTc -> TM (SyntaxExpr GhcTc)
    addTickSyntaxExpr SrcSpan
    hpcSrcSpan (Stmt GhcTc (LHsCmd GhcTc) -> SyntaxExpr GhcTc
    forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
    recS_mfix_fn Stmt GhcTc (LHsCmd GhcTc)
    stmt)
           ; SyntaxExprTc
    bind'  <- SrcSpan -> SyntaxExpr GhcTc -> TM (SyntaxExpr GhcTc)
    addTickSyntaxExpr SrcSpan
    hpcSrcSpan (Stmt GhcTc (LHsCmd GhcTc) -> SyntaxExpr GhcTc
    forall idL idR body. StmtLR idL idR body -> SyntaxExpr idR
    recS_bind_fn Stmt GhcTc (LHsCmd GhcTc)
    stmt)
           ; Stmt GhcTc (LHsCmd GhcTc) -> TM (Stmt GhcTc (LHsCmd GhcTc))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Stmt GhcTc (LHsCmd GhcTc)
    stmt { recS_stmts :: [CmdLStmt GhcTc]
    recS_stmts = [CmdLStmt GhcTc]
    stmts', recS_ret_fn :: SyntaxExpr GhcTc
    recS_ret_fn = SyntaxExpr GhcTc
    SyntaxExprTc
    ret'
                          , recS_mfix_fn :: SyntaxExpr GhcTc
    recS_mfix_fn = SyntaxExpr GhcTc
    SyntaxExprTc
    mfix', recS_bind_fn :: SyntaxExpr GhcTc
    recS_bind_fn = SyntaxExpr GhcTc
    SyntaxExprTc
    bind' }) }
    addTickCmdStmt ApplicativeStmt{} =
      FilePath -> TM (Stmt GhcTc (LHsCmd GhcTc))
    forall a. FilePath -> a
    panic FilePath
    "ToDo: addTickCmdStmt ApplicativeLastStmt"

    -- Others should never happen in a command context.
    addTickCmdStmt Stmt GhcTc (LHsCmd GhcTc)
    stmt  = FilePath -> SDoc -> TM (Stmt GhcTc (LHsCmd GhcTc))
    forall a. HasCallStack => FilePath -> SDoc -> a
    pprPanic FilePath
    "addTickHsCmd" (Stmt GhcTc (LHsCmd GhcTc) -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Stmt GhcTc (LHsCmd GhcTc)
    stmt)

    addTickHsRecordBinds :: HsRecordBinds GhcTc -> TM (HsRecordBinds GhcTc)
    addTickHsRecordBinds :: HsRecordBinds GhcTc -> TM (HsRecordBinds GhcTc)
    addTickHsRecordBinds (HsRecFields [LHsRecField GhcTc (LHsExpr GhcTc)]
    fields Maybe (Located Int)
    dd)
      = do  { [LHsRecField GhcTc (LHsExpr GhcTc)]
    fields' <- (LHsRecField GhcTc (LHsExpr GhcTc)
     -> TM (LHsRecField GhcTc (LHsExpr GhcTc)))
    -> [LHsRecField GhcTc (LHsExpr GhcTc)]
    -> TM [LHsRecField GhcTc (LHsExpr GhcTc)]
    forall (t :: * -> *) (m :: * -> *) a b.
    (Traversable t, Monad m) =>
    (a -> m b) -> t a -> m (t b)
    mapM LHsRecField GhcTc (LHsExpr GhcTc)
    -> TM (LHsRecField GhcTc (LHsExpr GhcTc))
    forall id.
    LHsRecField' id (LHsExpr GhcTc)
    -> TM (LHsRecField' id (LHsExpr GhcTc))
    addTickHsRecField [LHsRecField GhcTc (LHsExpr GhcTc)]
    fields
            ; HsRecordBinds GhcTc -> TM (HsRecordBinds GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return ([LHsRecField GhcTc (LHsExpr GhcTc)]
    -> Maybe (Located Int) -> HsRecordBinds GhcTc
    forall p arg.
    [LHsRecField p arg] -> Maybe (Located Int) -> HsRecFields p arg
    HsRecFields [LHsRecField GhcTc (LHsExpr GhcTc)]
    fields' Maybe (Located Int)
    dd) }

    addTickHsRecField :: LHsRecField' id (LHsExpr GhcTc)
                      -> TM (LHsRecField' id (LHsExpr GhcTc))
    addTickHsRecField :: forall id.
    LHsRecField' id (LHsExpr GhcTc)
    -> TM (LHsRecField' id (LHsExpr GhcTc))
    addTickHsRecField (L SrcSpan
    l (HsRecField Located id
    id LHsExpr GhcTc
    expr Bool
    pun))
            = do { LHsExpr GhcTc
    expr' <- LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExpr LHsExpr GhcTc
    expr
                 ; GenLocated SrcSpan (HsRecField' id (LHsExpr GhcTc))
    -> TM (GenLocated SrcSpan (HsRecField' id (LHsExpr GhcTc)))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SrcSpan
    -> HsRecField' id (LHsExpr GhcTc)
    -> GenLocated SrcSpan (HsRecField' id (LHsExpr GhcTc))
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    l (Located id
    -> LHsExpr GhcTc -> Bool -> HsRecField' id (LHsExpr GhcTc)
    forall id arg. Located id -> arg -> Bool -> HsRecField' id arg
    HsRecField Located id
    id LHsExpr GhcTc
    expr' Bool
    pun)) }

    addTickArithSeqInfo :: ArithSeqInfo GhcTc -> TM (ArithSeqInfo GhcTc)
    addTickArithSeqInfo :: ArithSeqInfo GhcTc -> TM (ArithSeqInfo GhcTc)
    addTickArithSeqInfo (From LHsExpr GhcTc
    e1) =
            (LHsExpr GhcTc -> ArithSeqInfo GhcTc)
    -> TM (LHsExpr GhcTc) -> TM (ArithSeqInfo GhcTc)
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM LHsExpr GhcTc -> ArithSeqInfo GhcTc
    forall id. LHsExpr id -> ArithSeqInfo id
    From
                    (LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExpr LHsExpr GhcTc
    e1)
    addTickArithSeqInfo (FromThen LHsExpr GhcTc
    e1 LHsExpr GhcTc
    e2) =
            (LHsExpr GhcTc -> LHsExpr GhcTc -> ArithSeqInfo GhcTc)
    -> TM (LHsExpr GhcTc)
    -> TM (LHsExpr GhcTc)
    -> TM (ArithSeqInfo GhcTc)
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 LHsExpr GhcTc -> LHsExpr GhcTc -> ArithSeqInfo GhcTc
    forall id. LHsExpr id -> LHsExpr id -> ArithSeqInfo id
    FromThen
                    (LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExpr LHsExpr GhcTc
    e1)
                    (LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExpr LHsExpr GhcTc
    e2)
    addTickArithSeqInfo (FromTo LHsExpr GhcTc
    e1 LHsExpr GhcTc
    e2) =
            (LHsExpr GhcTc -> LHsExpr GhcTc -> ArithSeqInfo GhcTc)
    -> TM (LHsExpr GhcTc)
    -> TM (LHsExpr GhcTc)
    -> TM (ArithSeqInfo GhcTc)
    forall (m :: * -> *) a1 a2 r.
    Monad m =>
    (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
    liftM2 LHsExpr GhcTc -> LHsExpr GhcTc -> ArithSeqInfo GhcTc
    forall id. LHsExpr id -> LHsExpr id -> ArithSeqInfo id
    FromTo
                    (LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExpr LHsExpr GhcTc
    e1)
                    (LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExpr LHsExpr GhcTc
    e2)
    addTickArithSeqInfo (FromThenTo LHsExpr GhcTc
    e1 LHsExpr GhcTc
    e2 LHsExpr GhcTc
    e3) =
            (LHsExpr GhcTc
     -> LHsExpr GhcTc -> LHsExpr GhcTc -> ArithSeqInfo GhcTc)
    -> TM (LHsExpr GhcTc)
    -> TM (LHsExpr GhcTc)
    -> TM (LHsExpr GhcTc)
    -> TM (ArithSeqInfo GhcTc)
    forall (m :: * -> *) a1 a2 a3 r.
    Monad m =>
    (a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
    liftM3 LHsExpr GhcTc
    -> LHsExpr GhcTc -> LHsExpr GhcTc -> ArithSeqInfo GhcTc
    forall id.
    LHsExpr id -> LHsExpr id -> LHsExpr id -> ArithSeqInfo id
    FromThenTo
                    (LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExpr LHsExpr GhcTc
    e1)
                    (LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExpr LHsExpr GhcTc
    e2)
                    (LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    addTickLHsExpr LHsExpr GhcTc
    e3)

    data TickTransState = TT { TickTransState -> Int
    tickBoxCount:: !Int
                             , TickTransState -> [MixEntry_]
    mixEntries  :: [MixEntry_]
                             , TickTransState -> CostCentreState
    ccIndices   :: !CostCentreState
                             }

    addMixEntry :: MixEntry_ -> TM Int
    addMixEntry :: MixEntry_ -> TM Int
    addMixEntry MixEntry_
    ent = do
      Int
    c <- TickTransState -> Int
    tickBoxCount (TickTransState -> Int) -> TM TickTransState -> TM Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> TM TickTransState
    getState
      (TickTransState -> TickTransState) -> TM ()
    setState ((TickTransState -> TickTransState) -> TM ())
    -> (TickTransState -> TickTransState) -> TM ()
    forall a b. (a -> b) -> a -> b
    $ \TickTransState
    st ->
        TickTransState
    st { tickBoxCount :: Int
    tickBoxCount = Int
    c Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1
           , mixEntries :: [MixEntry_]
    mixEntries = MixEntry_
    ent MixEntry_ -> [MixEntry_] -> [MixEntry_]
    forall a. a -> [a] -> [a]
    : TickTransState -> [MixEntry_]
    mixEntries TickTransState
    st
           }
      Int -> TM Int
    forall (m :: * -> *) a. Monad m => a -> m a
    return Int
    c

    data TickTransEnv = TTE { TickTransEnv -> FastString
    fileName     :: FastString
                            , TickTransEnv -> TickDensity
    density      :: TickDensity
                            , TickTransEnv -> DynFlags
    tte_dflags   :: DynFlags
                            , TickTransEnv -> NameSet
    exports      :: NameSet
                            , TickTransEnv -> VarSet
    inlines      :: VarSet
                            , TickTransEnv -> [FilePath]
    declPath     :: [String]
                            , TickTransEnv -> VarSet
    inScope      :: VarSet
                            , TickTransEnv -> Set RealSrcSpan
    blackList    :: Set RealSrcSpan
                            , TickTransEnv -> Module
    this_mod     :: Module
                            , TickTransEnv -> TickishType
    tickishType  :: TickishType
                            }

    --      deriving Show

    data TickishType = ProfNotes | HpcTicks | Breakpoints | SourceNotes
                     deriving (TickishType -> TickishType -> Bool
    (TickishType -> TickishType -> Bool)
    -> (TickishType -> TickishType -> Bool) -> Eq TickishType
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    /= :: TickishType -> TickishType -> Bool
    $c/= :: TickishType -> TickishType -> Bool
    == :: TickishType -> TickishType -> Bool
    $c== :: TickishType -> TickishType -> Bool
    Eq)

    coveragePasses :: DynFlags -> [TickishType]
    coveragePasses :: DynFlags -> [TickishType]
    coveragePasses DynFlags
    dflags =
        Bool -> TickishType -> [TickishType] -> [TickishType]
    forall {a}. Bool -> a -> [a] -> [a]
    ifa (DynFlags -> Bool
    breakpointsEnabled DynFlags
    dflags)          TickishType
    Breakpoints ([TickishType] -> [TickishType]) -> [TickishType] -> [TickishType]
    forall a b. (a -> b) -> a -> b
    $
        Bool -> TickishType -> [TickishType] -> [TickishType]
    forall {a}. Bool -> a -> [a] -> [a]
    ifa (GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_Hpc DynFlags
    dflags)                TickishType
    HpcTicks ([TickishType] -> [TickishType]) -> [TickishType] -> [TickishType]
    forall a b. (a -> b) -> a -> b
    $
        Bool -> TickishType -> [TickishType] -> [TickishType]
    forall {a}. Bool -> a -> [a] -> [a]
    ifa (DynFlags -> Bool
    sccProfilingEnabled DynFlags
    dflags Bool -> Bool -> Bool
    &&
             DynFlags -> ProfAuto
    profAuto DynFlags
    dflags ProfAuto -> ProfAuto -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ProfAuto
    NoProfAuto)      TickishType
    ProfNotes ([TickishType] -> [TickishType]) -> [TickishType] -> [TickishType]
    forall a b. (a -> b) -> a -> b
    $
        Bool -> TickishType -> [TickishType] -> [TickishType]
    forall {a}. Bool -> a -> [a] -> [a]
    ifa (DynFlags -> Int
    debugLevel DynFlags
    dflags Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    0)              TickishType
    SourceNotes []
      where ifa :: Bool -> a -> [a] -> [a]
    ifa Bool
    f a
    x [a]
    xs | Bool
    f         = a
    xa -> [a] -> [a]
    forall a. a -> [a] -> [a]
    :[a]
    xs
                       | Bool
    otherwise = [a]
    xs

    -- | Should we produce 'Breakpoint' ticks?
    breakpointsEnabled :: DynFlags -> Bool
    breakpointsEnabled :: DynFlags -> Bool
    breakpointsEnabled DynFlags
    dflags = DynFlags -> HscTarget
    hscTarget DynFlags
    dflags HscTarget -> HscTarget -> Bool
    forall a. Eq a => a -> a -> Bool
    == HscTarget
    HscInterpreted

    -- | Tickishs that only make sense when their source code location
    -- refers to the current file. This might not always be true due to
    -- LINE pragmas in the code - which would confuse at least HPC.
    tickSameFileOnly :: TickishType -> Bool
    tickSameFileOnly :: TickishType -> Bool
    tickSameFileOnly TickishType
    HpcTicks = Bool
    True
    tickSameFileOnly TickishType
    _other   = Bool
    False

    type FreeVars = OccEnv Id
    noFVs :: FreeVars
    noFVs :: FreeVars
    noFVs = FreeVars
    forall a. OccEnv a
    emptyOccEnv

    -- Note [freevars]
    --   For breakpoints we want to collect the free variables of an
    --   expression for pinning on the HsTick.  We don't want to collect
    --   *all* free variables though: in particular there's no point pinning
    --   on free variables that are will otherwise be in scope at the GHCi
    --   prompt, which means all top-level bindings.  Unfortunately detecting
    --   top-level bindings isn't easy (collectHsBindsBinders on the top-level
    --   bindings doesn't do it), so we keep track of a set of "in-scope"
    --   variables in addition to the free variables, and the former is used
    --   to filter additions to the latter.  This gives us complete control
    --   over what free variables we track.

    newtype TM a = TM { forall a.
    TM a
    -> TickTransEnv -> TickTransState -> (a, FreeVars, TickTransState)
    unTM :: TickTransEnv -> TickTransState -> (a,FreeVars,TickTransState) }
        deriving ((forall a b. (a -> b) -> TM a -> TM b)
    -> (forall a b. a -> TM b -> TM a) -> Functor TM
    forall a b. a -> TM b -> TM a
    forall a b. (a -> b) -> TM a -> TM b
    forall (f :: * -> *).
    (forall a b. (a -> b) -> f a -> f b)
    -> (forall a b. a -> f b -> f a) -> Functor f
    <$ :: forall a b. a -> TM b -> TM a
    $c<$ :: forall a b. a -> TM b -> TM a
    fmap :: forall a b. (a -> b) -> TM a -> TM b
    $cfmap :: forall a b. (a -> b) -> TM a -> TM b
    Functor)
            -- a combination of a state monad (TickTransState) and a writer
            -- monad (FreeVars).

    instance Applicative TM where
        pure :: forall a. a -> TM a
    pure a
    a = (TickTransEnv -> TickTransState -> (a, FreeVars, TickTransState))
    -> TM a
    forall a.
    (TickTransEnv -> TickTransState -> (a, FreeVars, TickTransState))
    -> TM a
    TM ((TickTransEnv -> TickTransState -> (a, FreeVars, TickTransState))
     -> TM a)
    -> (TickTransEnv
        -> TickTransState -> (a, FreeVars, TickTransState))
    -> TM a
    forall a b. (a -> b) -> a -> b
    $ \ TickTransEnv
    _env TickTransState
    st -> (a
    a,FreeVars
    noFVs,TickTransState
    st)
        <*> :: forall a b. TM (a -> b) -> TM a -> TM b
    (<*>) = TM (a -> b) -> TM a -> TM b
    forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
    ap

    instance Monad TM where
      (TM TickTransEnv -> TickTransState -> (a, FreeVars, TickTransState)
    m) >>= :: forall a b. TM a -> (a -> TM b) -> TM b
    >>= a -> TM b
    k = (TickTransEnv -> TickTransState -> (b, FreeVars, TickTransState))
    -> TM b
    forall a.
    (TickTransEnv -> TickTransState -> (a, FreeVars, TickTransState))
    -> TM a
    TM ((TickTransEnv -> TickTransState -> (b, FreeVars, TickTransState))
     -> TM b)
    -> (TickTransEnv
        -> TickTransState -> (b, FreeVars, TickTransState))
    -> TM b
    forall a b. (a -> b) -> a -> b
    $ \ TickTransEnv
    env TickTransState
    st ->
                                    case TickTransEnv -> TickTransState -> (a, FreeVars, TickTransState)
    m TickTransEnv
    env TickTransState
    st of
                                      (a
    r1,FreeVars
    fv1,TickTransState
    st1) ->
                                         case TM b
    -> TickTransEnv -> TickTransState -> (b, FreeVars, TickTransState)
    forall a.
    TM a
    -> TickTransEnv -> TickTransState -> (a, FreeVars, TickTransState)
    unTM (a -> TM b
    k a
    r1) TickTransEnv
    env TickTransState
    st1 of
                                           (b
    r2,FreeVars
    fv2,TickTransState
    st2) ->
                                              (b
    r2, FreeVars
    fv1 FreeVars -> FreeVars -> FreeVars
    forall a. OccEnv a -> OccEnv a -> OccEnv a
    `plusOccEnv` FreeVars
    fv2, TickTransState
    st2)

    instance HasDynFlags TM where
      getDynFlags :: TM DynFlags
    getDynFlags = (TickTransEnv
     -> TickTransState -> (DynFlags, FreeVars, TickTransState))
    -> TM DynFlags
    forall a.
    (TickTransEnv -> TickTransState -> (a, FreeVars, TickTransState))
    -> TM a
    TM ((TickTransEnv
      -> TickTransState -> (DynFlags, FreeVars, TickTransState))
     -> TM DynFlags)
    -> (TickTransEnv
        -> TickTransState -> (DynFlags, FreeVars, TickTransState))
    -> TM DynFlags
    forall a b. (a -> b) -> a -> b
    $ \ TickTransEnv
    env TickTransState
    st -> (TickTransEnv -> DynFlags
    tte_dflags TickTransEnv
    env, FreeVars
    noFVs, TickTransState
    st)

    -- | Get the next HPC cost centre index for a given centre name
    getCCIndexM :: FastString -> TM CostCentreIndex
    getCCIndexM :: FastString -> TM CostCentreIndex
    getCCIndexM FastString
    n = (TickTransEnv
     -> TickTransState -> (CostCentreIndex, FreeVars, TickTransState))
    -> TM CostCentreIndex
    forall a.
    (TickTransEnv -> TickTransState -> (a, FreeVars, TickTransState))
    -> TM a
    TM ((TickTransEnv
      -> TickTransState -> (CostCentreIndex, FreeVars, TickTransState))
     -> TM CostCentreIndex)
    -> (TickTransEnv
        -> TickTransState -> (CostCentreIndex, FreeVars, TickTransState))
    -> TM CostCentreIndex
    forall a b. (a -> b) -> a -> b
    $ \TickTransEnv
    _ TickTransState
    st -> let (CostCentreIndex
    idx, CostCentreState
    is') = FastString -> CostCentreState -> (CostCentreIndex, CostCentreState)
    getCCIndex FastString
    n (CostCentreState -> (CostCentreIndex, CostCentreState))
    -> CostCentreState -> (CostCentreIndex, CostCentreState)
    forall a b. (a -> b) -> a -> b
    $
                                                     TickTransState -> CostCentreState
    ccIndices TickTransState
    st
                                  in (CostCentreIndex
    idx, FreeVars
    noFVs, TickTransState
    st { ccIndices :: CostCentreState
    ccIndices = CostCentreState
    is' })

    getState :: TM TickTransState
    getState :: TM TickTransState
    getState = (TickTransEnv
     -> TickTransState -> (TickTransState, FreeVars, TickTransState))
    -> TM TickTransState
    forall a.
    (TickTransEnv -> TickTransState -> (a, FreeVars, TickTransState))
    -> TM a
    TM ((TickTransEnv
      -> TickTransState -> (TickTransState, FreeVars, TickTransState))
     -> TM TickTransState)
    -> (TickTransEnv
        -> TickTransState -> (TickTransState, FreeVars, TickTransState))
    -> TM TickTransState
    forall a b. (a -> b) -> a -> b
    $ \ TickTransEnv
    _ TickTransState
    st -> (TickTransState
    st, FreeVars
    noFVs, TickTransState
    st)

    setState :: (TickTransState -> TickTransState) -> TM ()
    setState :: (TickTransState -> TickTransState) -> TM ()
    setState TickTransState -> TickTransState
    f = (TickTransEnv -> TickTransState -> ((), FreeVars, TickTransState))
    -> TM ()
    forall a.
    (TickTransEnv -> TickTransState -> (a, FreeVars, TickTransState))
    -> TM a
    TM ((TickTransEnv -> TickTransState -> ((), FreeVars, TickTransState))
     -> TM ())
    -> (TickTransEnv
        -> TickTransState -> ((), FreeVars, TickTransState))
    -> TM ()
    forall a b. (a -> b) -> a -> b
    $ \ TickTransEnv
    _ TickTransState
    st -> ((), FreeVars
    noFVs, TickTransState -> TickTransState
    f TickTransState
    st)

    getEnv :: TM TickTransEnv
    getEnv :: TM TickTransEnv
    getEnv = (TickTransEnv
     -> TickTransState -> (TickTransEnv, FreeVars, TickTransState))
    -> TM TickTransEnv
    forall a.
    (TickTransEnv -> TickTransState -> (a, FreeVars, TickTransState))
    -> TM a
    TM ((TickTransEnv
      -> TickTransState -> (TickTransEnv, FreeVars, TickTransState))
     -> TM TickTransEnv)
    -> (TickTransEnv
        -> TickTransState -> (TickTransEnv, FreeVars, TickTransState))
    -> TM TickTransEnv
    forall a b. (a -> b) -> a -> b
    $ \ TickTransEnv
    env TickTransState
    st -> (TickTransEnv
    env, FreeVars
    noFVs, TickTransState
    st)

    withEnv :: (TickTransEnv -> TickTransEnv) -> TM a -> TM a
    withEnv :: forall a. (TickTransEnv -> TickTransEnv) -> TM a -> TM a
    withEnv TickTransEnv -> TickTransEnv
    f (TM TickTransEnv -> TickTransState -> (a, FreeVars, TickTransState)
    m) = (TickTransEnv -> TickTransState -> (a, FreeVars, TickTransState))
    -> TM a
    forall a.
    (TickTransEnv -> TickTransState -> (a, FreeVars, TickTransState))
    -> TM a
    TM ((TickTransEnv -> TickTransState -> (a, FreeVars, TickTransState))
     -> TM a)
    -> (TickTransEnv
        -> TickTransState -> (a, FreeVars, TickTransState))
    -> TM a
    forall a b. (a -> b) -> a -> b
    $ \ TickTransEnv
    env TickTransState
    st ->
                                     case TickTransEnv -> TickTransState -> (a, FreeVars, TickTransState)
    m (TickTransEnv -> TickTransEnv
    f TickTransEnv
    env) TickTransState
    st of
                                       (a
    a, FreeVars
    fvs, TickTransState
    st') -> (a
    a, FreeVars
    fvs, TickTransState
    st')

    getDensity :: TM TickDensity
    getDensity :: TM TickDensity
    getDensity = (TickTransEnv
     -> TickTransState -> (TickDensity, FreeVars, TickTransState))
    -> TM TickDensity
    forall a.
    (TickTransEnv -> TickTransState -> (a, FreeVars, TickTransState))
    -> TM a
    TM ((TickTransEnv
      -> TickTransState -> (TickDensity, FreeVars, TickTransState))
     -> TM TickDensity)
    -> (TickTransEnv
        -> TickTransState -> (TickDensity, FreeVars, TickTransState))
    -> TM TickDensity
    forall a b. (a -> b) -> a -> b
    $ \TickTransEnv
    env TickTransState
    st -> (TickTransEnv -> TickDensity
    density TickTransEnv
    env, FreeVars
    noFVs, TickTransState
    st)

    ifDensity :: TickDensity -> TM a -> TM a -> TM a
    ifDensity :: forall a. TickDensity -> TM a -> TM a -> TM a
    ifDensity TickDensity
    d TM a
    th TM a
    el = do TickDensity
    d0 <- TM TickDensity
    getDensity; if TickDensity
    d TickDensity -> TickDensity -> Bool
    forall a. Eq a => a -> a -> Bool
    == TickDensity
    d0 then TM a
    th else TM a
    el

    getFreeVars :: TM a -> TM (FreeVars, a)
    getFreeVars :: forall a. TM a -> TM (FreeVars, a)
    getFreeVars (TM TickTransEnv -> TickTransState -> (a, FreeVars, TickTransState)
    m)
      = (TickTransEnv
     -> TickTransState -> ((FreeVars, a), FreeVars, TickTransState))
    -> TM (FreeVars, a)
    forall a.
    (TickTransEnv -> TickTransState -> (a, FreeVars, TickTransState))
    -> TM a
    TM ((TickTransEnv
      -> TickTransState -> ((FreeVars, a), FreeVars, TickTransState))
     -> TM (FreeVars, a))
    -> (TickTransEnv
        -> TickTransState -> ((FreeVars, a), FreeVars, TickTransState))
    -> TM (FreeVars, a)
    forall a b. (a -> b) -> a -> b
    $ \ TickTransEnv
    env TickTransState
    st -> case TickTransEnv -> TickTransState -> (a, FreeVars, TickTransState)
    m TickTransEnv
    env TickTransState
    st of (a
    a, FreeVars
    fv, TickTransState
    st') -> ((FreeVars
    fv,a
    a), FreeVars
    fv, TickTransState
    st')

    freeVar :: Id -> TM ()
    freeVar :: Id -> TM ()
    freeVar Id
    id = (TickTransEnv -> TickTransState -> ((), FreeVars, TickTransState))
    -> TM ()
    forall a.
    (TickTransEnv -> TickTransState -> (a, FreeVars, TickTransState))
    -> TM a
    TM ((TickTransEnv -> TickTransState -> ((), FreeVars, TickTransState))
     -> TM ())
    -> (TickTransEnv
        -> TickTransState -> ((), FreeVars, TickTransState))
    -> TM ()
    forall a b. (a -> b) -> a -> b
    $ \ TickTransEnv
    env TickTransState
    st ->
                    if Id
    id Id -> VarSet -> Bool
    `elemVarSet` TickTransEnv -> VarSet
    inScope TickTransEnv
    env
                       then ((), OccName -> Id -> FreeVars
    forall a. OccName -> a -> OccEnv a
    unitOccEnv (Name -> OccName
    nameOccName (Id -> Name
    idName Id
    id)) Id
    id, TickTransState
    st)
                       else ((), FreeVars
    noFVs, TickTransState
    st)

    addPathEntry :: String -> TM a -> TM a
    addPathEntry :: forall a. FilePath -> TM a -> TM a
    addPathEntry FilePath
    nm = (TickTransEnv -> TickTransEnv) -> TM a -> TM a
    forall a. (TickTransEnv -> TickTransEnv) -> TM a -> TM a
    withEnv (\ TickTransEnv
    env -> TickTransEnv
    env { declPath :: [FilePath]
    declPath = TickTransEnv -> [FilePath]
    declPath TickTransEnv
    env [FilePath] -> [FilePath] -> [FilePath]
    forall a. [a] -> [a] -> [a]
    ++ [FilePath
    nm] })

    getPathEntry :: TM [String]
    getPathEntry :: TM [FilePath]
    getPathEntry = TickTransEnv -> [FilePath]
    declPath (TickTransEnv -> [FilePath]) -> TM TickTransEnv -> TM [FilePath]
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    `liftM` TM TickTransEnv
    getEnv

    getFileName :: TM FastString
    getFileName :: TM FastString
    getFileName = TickTransEnv -> FastString
    fileName (TickTransEnv -> FastString) -> TM TickTransEnv -> TM FastString
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    `liftM` TM TickTransEnv
    getEnv

    isGoodSrcSpan' :: SrcSpan -> Bool
    isGoodSrcSpan' :: SrcSpan -> Bool
    isGoodSrcSpan' pos :: SrcSpan
    pos@(RealSrcSpan RealSrcSpan
    _ Maybe BufSpan
    _) = SrcSpan -> SrcLoc
    srcSpanStart SrcSpan
    pos SrcLoc -> SrcLoc -> Bool
    forall a. Eq a => a -> a -> Bool
    /= SrcSpan -> SrcLoc
    srcSpanEnd SrcSpan
    pos
    isGoodSrcSpan' (UnhelpfulSpan UnhelpfulSpanReason
    _) = Bool
    False

    isGoodTickSrcSpan :: SrcSpan -> TM Bool
    isGoodTickSrcSpan :: SrcSpan -> TM Bool
    isGoodTickSrcSpan SrcSpan
    pos = do
      FastString
    file_name <- TM FastString
    getFileName
      TickishType
    tickish <- TickTransEnv -> TickishType
    tickishType (TickTransEnv -> TickishType) -> TM TickTransEnv -> TM TickishType
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    `liftM` TM TickTransEnv
    getEnv
      let need_same_file :: Bool
    need_same_file = TickishType -> Bool
    tickSameFileOnly TickishType
    tickish
          same_file :: Bool
    same_file      = FastString -> Maybe FastString
    forall a. a -> Maybe a
    Just FastString
    file_name Maybe FastString -> Maybe FastString -> Bool
    forall a. Eq a => a -> a -> Bool
    == SrcSpan -> Maybe FastString
    srcSpanFileName_maybe SrcSpan
    pos
      Bool -> TM Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SrcSpan -> Bool
    isGoodSrcSpan' SrcSpan
    pos Bool -> Bool -> Bool
    && (Bool -> Bool
    not Bool
    need_same_file Bool -> Bool -> Bool
    || Bool
    same_file))

    ifGoodTickSrcSpan :: SrcSpan -> TM a -> TM a -> TM a
    ifGoodTickSrcSpan :: forall a. SrcSpan -> TM a -> TM a -> TM a
    ifGoodTickSrcSpan SrcSpan
    pos TM a
    then_code TM a
    else_code = do
      Bool
    good <- SrcSpan -> TM Bool
    isGoodTickSrcSpan SrcSpan
    pos
      if Bool
    good then TM a
    then_code else TM a
    else_code

    bindLocals :: [Id] -> TM a -> TM a
    bindLocals :: forall a. [Id] -> TM a -> TM a
    bindLocals [Id]
    new_ids (TM TickTransEnv -> TickTransState -> (a, FreeVars, TickTransState)
    m)
      = (TickTransEnv -> TickTransState -> (a, FreeVars, TickTransState))
    -> TM a
    forall a.
    (TickTransEnv -> TickTransState -> (a, FreeVars, TickTransState))
    -> TM a
    TM ((TickTransEnv -> TickTransState -> (a, FreeVars, TickTransState))
     -> TM a)
    -> (TickTransEnv
        -> TickTransState -> (a, FreeVars, TickTransState))
    -> TM a
    forall a b. (a -> b) -> a -> b
    $ \ TickTransEnv
    env TickTransState
    st ->
                     case TickTransEnv -> TickTransState -> (a, FreeVars, TickTransState)
    m TickTransEnv
    env{ inScope :: VarSet
    inScope = TickTransEnv -> VarSet
    inScope TickTransEnv
    env VarSet -> [Id] -> VarSet
    `extendVarSetList` [Id]
    new_ids } TickTransState
    st of
                       (a
    r, FreeVars
    fv, TickTransState
    st') -> (a
    r, FreeVars
    fv FreeVars -> [OccName] -> FreeVars
    forall a. OccEnv a -> [OccName] -> OccEnv a
    `delListFromOccEnv` [OccName]
    occs, TickTransState
    st')
      where occs :: [OccName]
    occs = [ Name -> OccName
    nameOccName (Id -> Name
    idName Id
    id) | Id
    id <- [Id]
    new_ids ]

    isBlackListed :: SrcSpan -> TM Bool
    isBlackListed :: SrcSpan -> TM Bool
    isBlackListed (RealSrcSpan RealSrcSpan
    pos Maybe BufSpan
    _) = (TickTransEnv
     -> TickTransState -> (Bool, FreeVars, TickTransState))
    -> TM Bool
    forall a.
    (TickTransEnv -> TickTransState -> (a, FreeVars, TickTransState))
    -> TM a
    TM ((TickTransEnv
      -> TickTransState -> (Bool, FreeVars, TickTransState))
     -> TM Bool)
    -> (TickTransEnv
        -> TickTransState -> (Bool, FreeVars, TickTransState))
    -> TM Bool
    forall a b. (a -> b) -> a -> b
    $ \ TickTransEnv
    env TickTransState
    st -> (RealSrcSpan -> Set RealSrcSpan -> Bool
    forall a. Ord a => a -> Set a -> Bool
    Set.member RealSrcSpan
    pos (TickTransEnv -> Set RealSrcSpan
    blackList TickTransEnv
    env), FreeVars
    noFVs, TickTransState
    st)
    isBlackListed (UnhelpfulSpan UnhelpfulSpanReason
    _) = Bool -> TM Bool
    forall (m :: * -> *) a. Monad m => a -> m a
    return Bool
    False

    -- the tick application inherits the source position of its
    -- expression argument to support nested box allocations
    allocTickBox :: BoxLabel -> Bool -> Bool -> SrcSpan -> TM (HsExpr GhcTc)
                 -> TM (LHsExpr GhcTc)
    allocTickBox :: BoxLabel
    -> Bool
    -> Bool
    -> SrcSpan
    -> TM (HsExpr GhcTc)
    -> TM (LHsExpr GhcTc)
    allocTickBox BoxLabel
    boxLabel Bool
    countEntries Bool
    topOnly SrcSpan
    pos TM (HsExpr GhcTc)
    m =
      SrcSpan
    -> TM (LHsExpr GhcTc) -> TM (LHsExpr GhcTc) -> TM (LHsExpr GhcTc)
    forall a. SrcSpan -> TM a -> TM a -> TM a
    ifGoodTickSrcSpan SrcSpan
    pos (do
        (FreeVars
    fvs, HsExpr GhcTc
    e) <- TM (HsExpr GhcTc) -> TM (FreeVars, HsExpr GhcTc)
    forall a. TM a -> TM (FreeVars, a)
    getFreeVars TM (HsExpr GhcTc)
    m
        TickTransEnv
    env <- TM TickTransEnv
    getEnv
        Tickish Id
    tickish <- BoxLabel
    -> Bool
    -> Bool
    -> SrcSpan
    -> FreeVars
    -> [FilePath]
    -> TM (Tickish Id)
    mkTickish BoxLabel
    boxLabel Bool
    countEntries Bool
    topOnly SrcSpan
    pos FreeVars
    fvs (TickTransEnv -> [FilePath]
    declPath TickTransEnv
    env)
        LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SrcSpan -> HsExpr GhcTc -> LHsExpr GhcTc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    pos (XTick GhcTc -> Tickish (IdP GhcTc) -> LHsExpr GhcTc -> HsExpr GhcTc
    forall p. XTick p -> Tickish (IdP p) -> LHsExpr p -> HsExpr p
    HsTick NoExtField
    XTick GhcTc
    noExtField Tickish Id
    Tickish (IdP GhcTc)
    tickish (SrcSpan -> HsExpr GhcTc -> LHsExpr GhcTc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    pos HsExpr GhcTc
    e)))
      ) (do
        HsExpr GhcTc
    e <- TM (HsExpr GhcTc)
    m
        LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (SrcSpan -> HsExpr GhcTc -> LHsExpr GhcTc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    pos HsExpr GhcTc
    e)
      )

    -- the tick application inherits the source position of its
    -- expression argument to support nested box allocations
    allocATickBox :: BoxLabel -> Bool -> Bool -> SrcSpan -> FreeVars
                  -> TM (Maybe (Tickish Id))
    allocATickBox :: BoxLabel
    -> Bool -> Bool -> SrcSpan -> FreeVars -> TM (Maybe (Tickish Id))
    allocATickBox BoxLabel
    boxLabel Bool
    countEntries Bool
    topOnly  SrcSpan
    pos FreeVars
    fvs =
      SrcSpan
    -> TM (Maybe (Tickish Id))
    -> TM (Maybe (Tickish Id))
    -> TM (Maybe (Tickish Id))
    forall a. SrcSpan -> TM a -> TM a -> TM a
    ifGoodTickSrcSpan SrcSpan
    pos (do
        let
          mydecl_path :: [FilePath]
    mydecl_path = case BoxLabel
    boxLabel of
                          TopLevelBox [FilePath]
    x -> [FilePath]
    x
                          LocalBox [FilePath]
    xs  -> [FilePath]
    xs
                          BoxLabel
    _ -> FilePath -> [FilePath]
    forall a. FilePath -> a
    panic FilePath
    "allocATickBox"
        Tickish Id
    tickish <- BoxLabel
    -> Bool
    -> Bool
    -> SrcSpan
    -> FreeVars
    -> [FilePath]
    -> TM (Tickish Id)
    mkTickish BoxLabel
    boxLabel Bool
    countEntries Bool
    topOnly SrcSpan
    pos FreeVars
    fvs [FilePath]
    mydecl_path
        Maybe (Tickish Id) -> TM (Maybe (Tickish Id))
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Tickish Id -> Maybe (Tickish Id)
    forall a. a -> Maybe a
    Just Tickish Id
    tickish)
      ) (Maybe (Tickish Id) -> TM (Maybe (Tickish Id))
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (Tickish Id)
    forall a. Maybe a
    Nothing)

    mkTickish :: BoxLabel -> Bool -> Bool -> SrcSpan -> OccEnv Id -> [String]
              -> TM (Tickish Id)
    mkTickish :: BoxLabel
    -> Bool
    -> Bool
    -> SrcSpan
    -> FreeVars
    -> [FilePath]
    -> TM (Tickish Id)
    mkTickish BoxLabel
    boxLabel Bool
    countEntries Bool
    topOnly SrcSpan
    pos FreeVars
    fvs [FilePath]
    decl_path = do

      let ids :: [Id]
    ids = (Id -> Bool) -> [Id] -> [Id]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> (Id -> Bool) -> Id -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . HasDebugCallStack => Type -> Bool
    Type -> Bool
    isUnliftedType (Type -> Bool) -> (Id -> Type) -> Id -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Id -> Type
    idType) ([Id] -> [Id]) -> [Id] -> [Id]
    forall a b. (a -> b) -> a -> b
    $ FreeVars -> [Id]
    forall a. OccEnv a -> [a]
    occEnvElts FreeVars
    fvs
              -- unlifted types cause two problems here:
              --   * we can't bind them  at the GHCi prompt
              --     (bindLocalsAtBreakpoint already filters them out),
              --   * the simplifier might try to substitute a literal for
              --     the Id, and we can't handle that.

          me :: MixEntry_
    me = (SrcSpan
    pos, [FilePath]
    decl_path, (Id -> OccName) -> [Id] -> [OccName]
    forall a b. (a -> b) -> [a] -> [b]
    map (Name -> OccName
    nameOccName(Name -> OccName) -> (Id -> Name) -> Id -> OccName
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Id -> Name
    idName) [Id]
    ids, BoxLabel
    boxLabel)

          cc_name :: FilePath
    cc_name | Bool
    topOnly   = [FilePath] -> FilePath
    forall a. [a] -> a
    head [FilePath]
    decl_path
                  | Bool
    otherwise = [FilePath] -> FilePath
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat (FilePath -> [FilePath] -> [FilePath]
    forall a. a -> [a] -> [a]
    intersperse FilePath
    "." [FilePath]
    decl_path)

      DynFlags
    dflags <- TM DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
      TickTransEnv
    env <- TM TickTransEnv
    getEnv
      case TickTransEnv -> TickishType
    tickishType TickTransEnv
    env of
        TickishType
    HpcTicks -> Module -> Int -> Tickish Id
    forall id. Module -> Int -> Tickish id
    HpcTick (TickTransEnv -> Module
    this_mod TickTransEnv
    env) (Int -> Tickish Id) -> TM Int -> TM (Tickish Id)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> MixEntry_ -> TM Int
    addMixEntry MixEntry_
    me

        TickishType
    ProfNotes -> do
          let nm :: FastString
    nm = FilePath -> FastString
    mkFastString FilePath
    cc_name
          CCFlavour
    flavour <- CostCentreIndex -> CCFlavour
    HpcCC (CostCentreIndex -> CCFlavour)
    -> TM CostCentreIndex -> TM CCFlavour
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> FastString -> TM CostCentreIndex
    getCCIndexM FastString
    nm
          let cc :: CostCentre
    cc = FastString -> Module -> SrcSpan -> CCFlavour -> CostCentre
    mkUserCC FastString
    nm (TickTransEnv -> Module
    this_mod TickTransEnv
    env) SrcSpan
    pos CCFlavour
    flavour
              count :: Bool
    count = Bool
    countEntries Bool -> Bool -> Bool
    && GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_ProfCountEntries DynFlags
    dflags
          Tickish Id -> TM (Tickish Id)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Tickish Id -> TM (Tickish Id)) -> Tickish Id -> TM (Tickish Id)
    forall a b. (a -> b) -> a -> b
    $ CostCentre -> Bool -> Bool -> Tickish Id
    forall id. CostCentre -> Bool -> Bool -> Tickish id
    ProfNote CostCentre
    cc Bool
    count Bool
    True{-scopes-}

        TickishType
    Breakpoints -> Int -> [Id] -> Tickish Id
    forall id. Int -> [id] -> Tickish id
    Breakpoint (Int -> [Id] -> Tickish Id) -> TM Int -> TM ([Id] -> Tickish Id)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> MixEntry_ -> TM Int
    addMixEntry MixEntry_
    me TM ([Id] -> Tickish Id) -> TM [Id] -> TM (Tickish Id)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> [Id] -> TM [Id]
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [Id]
    ids

        TickishType
    SourceNotes | RealSrcSpan RealSrcSpan
    pos' Maybe BufSpan
    _ <- SrcSpan
    pos ->
          Tickish Id -> TM (Tickish Id)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Tickish Id -> TM (Tickish Id)) -> Tickish Id -> TM (Tickish Id)
    forall a b. (a -> b) -> a -> b
    $ RealSrcSpan -> FilePath -> Tickish Id
    forall id. RealSrcSpan -> FilePath -> Tickish id
    SourceNote RealSrcSpan
    pos' FilePath
    cc_name

        TickishType
    _otherwise -> FilePath -> TM (Tickish Id)
    forall a. FilePath -> a
    panic FilePath
    "mkTickish: bad source span!"

    allocBinTickBox :: (Bool -> BoxLabel) -> SrcSpan -> TM (HsExpr GhcTc)
                    -> TM (LHsExpr GhcTc)
    allocBinTickBox :: (Bool -> BoxLabel)
    -> SrcSpan -> TM (HsExpr GhcTc) -> TM (LHsExpr GhcTc)
    allocBinTickBox Bool -> BoxLabel
    boxLabel SrcSpan
    pos TM (HsExpr GhcTc)
    m = do
      TickTransEnv
    env <- TM TickTransEnv
    getEnv
      case TickTransEnv -> TickishType
    tickishType TickTransEnv
    env of
        TickishType
    HpcTicks -> do LHsExpr GhcTc
    e <- (HsExpr GhcTc -> LHsExpr GhcTc)
    -> TM (HsExpr GhcTc) -> TM (LHsExpr GhcTc)
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM (SrcSpan -> HsExpr GhcTc -> LHsExpr GhcTc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    pos) TM (HsExpr GhcTc)
    m
                       SrcSpan
    -> TM (LHsExpr GhcTc) -> TM (LHsExpr GhcTc) -> TM (LHsExpr GhcTc)
    forall a. SrcSpan -> TM a -> TM a -> TM a
    ifGoodTickSrcSpan SrcSpan
    pos
                         ((Bool -> BoxLabel)
    -> SrcSpan -> LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    mkBinTickBoxHpc Bool -> BoxLabel
    boxLabel SrcSpan
    pos LHsExpr GhcTc
    e)
                         (LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return LHsExpr GhcTc
    e)
        TickishType
    _other   -> BoxLabel
    -> Bool
    -> Bool
    -> SrcSpan
    -> TM (HsExpr GhcTc)
    -> TM (LHsExpr GhcTc)
    allocTickBox (Bool -> BoxLabel
    ExpBox Bool
    False) Bool
    False Bool
    False SrcSpan
    pos TM (HsExpr GhcTc)
    m

    mkBinTickBoxHpc :: (Bool -> BoxLabel) -> SrcSpan -> LHsExpr GhcTc
                    -> TM (LHsExpr GhcTc)
    mkBinTickBoxHpc :: (Bool -> BoxLabel)
    -> SrcSpan -> LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    mkBinTickBoxHpc Bool -> BoxLabel
    boxLabel SrcSpan
    pos LHsExpr GhcTc
    e = do
      TickTransEnv
    env <- TM TickTransEnv
    getEnv
      HsExpr GhcTc
    binTick <- XBinTick GhcTc -> Int -> Int -> LHsExpr GhcTc -> HsExpr GhcTc
    forall p. XBinTick p -> Int -> Int -> LHsExpr p -> HsExpr p
    HsBinTick NoExtField
    XBinTick GhcTc
    noExtField
        (Int -> Int -> LHsExpr GhcTc -> HsExpr GhcTc)
    -> TM Int -> TM (Int -> LHsExpr GhcTc -> HsExpr GhcTc)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> MixEntry_ -> TM Int
    addMixEntry (SrcSpan
    pos,TickTransEnv -> [FilePath]
    declPath TickTransEnv
    env, [],Bool -> BoxLabel
    boxLabel Bool
    True)
        TM (Int -> LHsExpr GhcTc -> HsExpr GhcTc)
    -> TM Int -> TM (LHsExpr GhcTc -> HsExpr GhcTc)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> MixEntry_ -> TM Int
    addMixEntry (SrcSpan
    pos,TickTransEnv -> [FilePath]
    declPath TickTransEnv
    env, [],Bool -> BoxLabel
    boxLabel Bool
    False)
        TM (LHsExpr GhcTc -> HsExpr GhcTc)
    -> TM (LHsExpr GhcTc) -> TM (HsExpr GhcTc)
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure LHsExpr GhcTc
    e
      Tickish Id
    tick <- Module -> Int -> Tickish Id
    forall id. Module -> Int -> Tickish id
    HpcTick (TickTransEnv -> Module
    this_mod TickTransEnv
    env)
        (Int -> Tickish Id) -> TM Int -> TM (Tickish Id)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> MixEntry_ -> TM Int
    addMixEntry (SrcSpan
    pos,TickTransEnv -> [FilePath]
    declPath TickTransEnv
    env, [],Bool -> BoxLabel
    ExpBox Bool
    False)
      LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    forall (m :: * -> *) a. Monad m => a -> m a
    return (LHsExpr GhcTc -> TM (LHsExpr GhcTc))
    -> LHsExpr GhcTc -> TM (LHsExpr GhcTc)
    forall a b. (a -> b) -> a -> b
    $ SrcSpan -> HsExpr GhcTc -> LHsExpr GhcTc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    pos (HsExpr GhcTc -> LHsExpr GhcTc) -> HsExpr GhcTc -> LHsExpr GhcTc
    forall a b. (a -> b) -> a -> b
    $ XTick GhcTc -> Tickish (IdP GhcTc) -> LHsExpr GhcTc -> HsExpr GhcTc
    forall p. XTick p -> Tickish (IdP p) -> LHsExpr p -> HsExpr p
    HsTick NoExtField
    XTick GhcTc
    noExtField Tickish Id
    Tickish (IdP GhcTc)
    tick (SrcSpan -> HsExpr GhcTc -> LHsExpr GhcTc
    forall l e. l -> e -> GenLocated l e
    L SrcSpan
    pos HsExpr GhcTc
    binTick)

    mkHpcPos :: SrcSpan -> HpcPos
    mkHpcPos :: SrcSpan -> HpcPos
    mkHpcPos pos :: SrcSpan
    pos@(RealSrcSpan RealSrcSpan
    s Maybe BufSpan
    _)
       | SrcSpan -> Bool
    isGoodSrcSpan' SrcSpan
    pos = (Int, Int, Int, Int) -> HpcPos
    toHpcPos (RealSrcSpan -> Int
    srcSpanStartLine RealSrcSpan
    s,
                                        RealSrcSpan -> Int
    srcSpanStartCol RealSrcSpan
    s,
                                        RealSrcSpan -> Int
    srcSpanEndLine RealSrcSpan
    s,
                                        RealSrcSpan -> Int
    srcSpanEndCol RealSrcSpan
    s Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    1)
                                  -- the end column of a SrcSpan is one
                                  -- greater than the last column of the
                                  -- span (see SrcLoc), whereas HPC
                                  -- expects to the column range to be
                                  -- inclusive, hence we subtract one above.
    mkHpcPos SrcSpan
    _ = FilePath -> HpcPos
    forall a. FilePath -> a
    panic FilePath
    "bad source span; expected such spans to be filtered out"

    hpcSrcSpan :: SrcSpan
    hpcSrcSpan :: SrcSpan
    hpcSrcSpan = FastString -> SrcSpan
    mkGeneralSrcSpan (FilePath -> FastString
    fsLit FilePath
    "Haskell Program Coverage internals")

    matchesOneOfMany :: [LMatch GhcTc body] -> Bool
    matchesOneOfMany :: forall body. [LMatch GhcTc body] -> Bool
    matchesOneOfMany [LMatch GhcTc body]
    lmatches = [Int] -> Int
    forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
    sum ((LMatch GhcTc body -> Int) -> [LMatch GhcTc body] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map LMatch GhcTc body -> Int
    forall body. LMatch GhcTc body -> Int
    matchCount [LMatch GhcTc body]
    lmatches) Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    > Int
    1
      where
            matchCount :: LMatch GhcTc body -> Int
            matchCount :: forall body. LMatch GhcTc body -> Int
    matchCount (L SrcSpan
    _ (Match { m_grhss :: forall p body. Match p body -> GRHSs p body
    m_grhss = GRHSs XCGRHSs GhcTc body
    _ [LGRHS GhcTc body]
    grhss GenLocated SrcSpan (HsLocalBinds GhcTc)
    _ }))
              = [LGRHS GhcTc body] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [LGRHS GhcTc body]
    grhss

    type MixEntry_ = (SrcSpan, [String], [OccName], BoxLabel)

    -- For the hash value, we hash everything: the file name,
    --  the timestamp of the original source file, the tab stop,
    --  and the mix entries. We cheat, and hash the show'd string.
    -- This hash only has to be hashed at Mix creation time,
    -- and is for sanity checking only.

    mixHash :: FilePath -> UTCTime -> Int -> [MixEntry] -> Int
    mixHash :: FilePath -> UTCTime -> Int -> [(HpcPos, BoxLabel)] -> Int
    mixHash FilePath
    file UTCTime
    tm Int
    tabstop [(HpcPos, BoxLabel)]
    entries = Int32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int32 -> Int) -> Int32 -> Int
    forall a b. (a -> b) -> a -> b
    $ FilePath -> Int32
    hashString
            (Mix -> FilePath
    forall a. Show a => a -> FilePath
    show (Mix -> FilePath) -> Mix -> FilePath
    forall a b. (a -> b) -> a -> b
    $ FilePath -> UTCTime -> Hash -> Int -> [(HpcPos, BoxLabel)] -> Mix
    Mix FilePath
    file UTCTime
    tm Hash
    0 Int
    tabstop [(HpcPos, BoxLabel)]
    entries)

    {-
    ************************************************************************
    *                                                                      *
    *              initialisation
    *                                                                      *
    ************************************************************************

    Each module compiled with -fhpc declares an initialisation function of
    the form `hpc_init_<module>()`, which is emitted into the _stub.c file
    and annotated with __attribute__((constructor)) so that it gets
    executed at startup time.

    The function's purpose is to call hs_hpc_module to register this
    module with the RTS, and it looks something like this:

    static void hpc_init_Main(void) __attribute__((constructor));
    static void hpc_init_Main(void)
    {extern StgWord64 _hpc_tickboxes_Main_hpc[];
     hs_hpc_module("Main",8,1150288664,_hpc_tickboxes_Main_hpc);}
    -}

    hpcInitCode :: Module -> HpcInfo -> SDoc
    hpcInitCode :: Module -> HpcInfo -> SDoc
    hpcInitCode Module
    _ (NoHpcInfo {}) = SDoc
    Outputable.empty
    hpcInitCode Module
    this_mod (HpcInfo Int
    tickCount Int
    hashNo)
     = [SDoc] -> SDoc
    vcat
        [ FilePath -> SDoc
    text FilePath
    "static void hpc_init_" SDoc -> SDoc -> SDoc
    <> Module -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Module
    this_mod
             SDoc -> SDoc -> SDoc
    <> FilePath -> SDoc
    text FilePath
    "(void) __attribute__((constructor));"
        , FilePath -> SDoc
    text FilePath
    "static void hpc_init_" SDoc -> SDoc -> SDoc
    <> Module -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr Module
    this_mod SDoc -> SDoc -> SDoc
    <> FilePath -> SDoc
    text FilePath
    "(void)"
        , SDoc -> SDoc
    braces ([SDoc] -> SDoc
    vcat [
            FilePath -> SDoc
    text FilePath
    "extern StgWord64 " SDoc -> SDoc -> SDoc
    <> SDoc
    tickboxes SDoc -> SDoc -> SDoc
    <>
                   FilePath -> SDoc
    text FilePath
    "[]" SDoc -> SDoc -> SDoc
    <> SDoc
    semi,
            FilePath -> SDoc
    text FilePath
    "hs_hpc_module" SDoc -> SDoc -> SDoc
    <>
              SDoc -> SDoc
    parens ([SDoc] -> SDoc
    hcat (SDoc -> [SDoc] -> [SDoc]
    punctuate SDoc
    comma [
                  SDoc -> SDoc
    doubleQuotes SDoc
    full_name_str,
                  Int -> SDoc
    int Int
    tickCount, -- really StgWord32
                  Int -> SDoc
    int Int
    hashNo,    -- really StgWord32
                  SDoc
    tickboxes
                ])) SDoc -> SDoc -> SDoc
    <> SDoc
    semi
           ])
        ]
      where
        tickboxes :: SDoc
    tickboxes = CLabel -> SDoc
    forall a. Outputable a => a -> SDoc
    ppr (Module -> CLabel
    mkHpcTicksLabel (Module -> CLabel) -> Module -> CLabel
    forall a b. (a -> b) -> a -> b
    $ Module
    this_mod)

        module_name :: SDoc
    module_name  = [SDoc] -> SDoc
    hcat ((Word8 -> SDoc) -> [Word8] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (FilePath -> SDoc
    text(FilePath -> SDoc) -> (Word8 -> FilePath) -> Word8 -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Word8 -> FilePath
    charToC) ([Word8] -> [SDoc]) -> [Word8] -> [SDoc]
    forall a b. (a -> b) -> a -> b
    $ ByteString -> [Word8]
    BS.unpack (ByteString -> [Word8]) -> ByteString -> [Word8]
    forall a b. (a -> b) -> a -> b
    $
                             FastString -> ByteString
    bytesFS (ModuleName -> FastString
    moduleNameFS (Module -> ModuleName
    forall unit. GenModule unit -> ModuleName
    moduleName Module
    this_mod)))
        package_name :: SDoc
    package_name = [SDoc] -> SDoc
    hcat ((Word8 -> SDoc) -> [Word8] -> [SDoc]
    forall a b. (a -> b) -> [a] -> [b]
    map (FilePath -> SDoc
    text(FilePath -> SDoc) -> (Word8 -> FilePath) -> Word8 -> SDoc
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .Word8 -> FilePath
    charToC) ([Word8] -> [SDoc]) -> [Word8] -> [SDoc]
    forall a b. (a -> b) -> a -> b
    $ ByteString -> [Word8]
    BS.unpack (ByteString -> [Word8]) -> ByteString -> [Word8]
    forall a b. (a -> b) -> a -> b
    $
                             FastString -> ByteString
    bytesFS (Unit -> FastString
    unitFS  (Module -> Unit
    forall unit. GenModule unit -> unit
    moduleUnit Module
    this_mod)))
        full_name_str :: SDoc
    full_name_str
           | Module -> Unit
    forall unit. GenModule unit -> unit
    moduleUnit Module
    this_mod Unit -> Unit -> Bool
    forall a. Eq a => a -> a -> Bool
    == Unit
    mainUnit
           = SDoc
    module_name
           | Bool
    otherwise
           = SDoc
    package_name SDoc -> SDoc -> SDoc
    <> Char -> SDoc
    char Char
    '/' SDoc -> SDoc -> SDoc
    <> SDoc
    module_name