    -----------------------------------------------------------------------------
    -- A Parser monad with access to the 'DynFlags'.
    --
    -- The 'P' monad only has access to the subset of 'DynFlags'
    -- required for parsing Haskell.

    -- The parser for C-- requires access to a lot more of the 'DynFlags',
    -- so 'PD' provides access to 'DynFlags' via a 'HasDynFlags' instance.
    -----------------------------------------------------------------------------
    module GHC.Cmm.Parser.Monad (
        PD(..)
      , liftP
      , failMsgPD
      , getProfile
      , getPlatform
      , getHomeUnitId
      ) where

    import GHC.Prelude

    import GHC.Platform
    import GHC.Platform.Profile

    import Control.Monad

    import GHC.Driver.Session
    import GHC.Parser.Lexer
    import GHC.Parser.Errors.Types
    import GHC.Types.Error ( MsgEnvelope )
    import GHC.Types.SrcLoc
    import GHC.Unit.Types
    import GHC.Unit.Home

    newtype PD a = PD { forall a. PD a -> DynFlags -> HomeUnit -> PState -> ParseResult a
    unPD :: DynFlags -> HomeUnit -> PState -> ParseResult a }

    instance Functor PD where
      fmap :: forall a b. (a -> b) -> PD a -> PD b
    fmap = (a -> b) -> PD a -> PD b
    forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM

    instance Applicative PD where
      pure :: forall a. a -> PD a
    pure = a -> PD a
    forall a. a -> PD a
    returnPD
      <*> :: forall a b. PD (a -> b) -> PD a -> PD b
    (<*>) = PD (a -> b) -> PD a -> PD b
    forall (m :: * -> *) a b. Monad m => m (a -> b) -> m a -> m b
    ap

    instance Monad PD where
      >>= :: forall a b. PD a -> (a -> PD b) -> PD b
    (>>=) = PD a -> (a -> PD b) -> PD b
    forall a b. PD a -> (a -> PD b) -> PD b
    thenPD

    liftP :: P a -> PD a
    liftP :: forall a. P a -> PD a
    liftP (P PState -> ParseResult a
    f) = (DynFlags -> HomeUnit -> PState -> ParseResult a) -> PD a
    forall a. (DynFlags -> HomeUnit -> PState -> ParseResult a) -> PD a
    PD ((DynFlags -> HomeUnit -> PState -> ParseResult a) -> PD a)
    -> (DynFlags -> HomeUnit -> PState -> ParseResult a) -> PD a
    forall a b. (a -> b) -> a -> b
    $ \DynFlags
    _ HomeUnit
    _ PState
    s -> PState -> ParseResult a
    f PState
    s

    failMsgPD :: (SrcSpan -> MsgEnvelope PsMessage) -> PD a
    failMsgPD :: forall a. (SrcSpan -> MsgEnvelope PsMessage) -> PD a
    failMsgPD = P a -> PD a
    forall a. P a -> PD a
    liftP (P a -> PD a)
    -> ((SrcSpan -> MsgEnvelope PsMessage) -> P a)
    -> (SrcSpan -> MsgEnvelope PsMessage)
    -> PD a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (SrcSpan -> MsgEnvelope PsMessage) -> P a
    forall a. (SrcSpan -> MsgEnvelope PsMessage) -> P a
    failMsgP

    returnPD :: a -> PD a
    returnPD :: forall a. a -> PD a
    returnPD = P a -> PD a
    forall a. P a -> PD a
    liftP (P a -> PD a) -> (a -> P a) -> a -> PD a
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> P a
    forall a. a -> P a
    forall (m :: * -> *) a. Monad m => a -> m a
    return

    thenPD :: PD a -> (a -> PD b) -> PD b
    (PD DynFlags -> HomeUnit -> PState -> ParseResult a
    m) thenPD :: forall a b. PD a -> (a -> PD b) -> PD b
    `thenPD` a -> PD b
    k = (DynFlags -> HomeUnit -> PState -> ParseResult b) -> PD b
    forall a. (DynFlags -> HomeUnit -> PState -> ParseResult a) -> PD a
    PD ((DynFlags -> HomeUnit -> PState -> ParseResult b) -> PD b)
    -> (DynFlags -> HomeUnit -> PState -> ParseResult b) -> PD b
    forall a b. (a -> b) -> a -> b
    $ \DynFlags
    d HomeUnit
    hu PState
    s ->
            case DynFlags -> HomeUnit -> PState -> ParseResult a
    m DynFlags
    d HomeUnit
    hu PState
    s of
                    POk PState
    s1 a
    a   -> PD b -> DynFlags -> HomeUnit -> PState -> ParseResult b
    forall a. PD a -> DynFlags -> HomeUnit -> PState -> ParseResult a
    unPD (a -> PD b
    k a
    a) DynFlags
    d HomeUnit
    hu PState
    s1
                    PFailed PState
    s1 -> PState -> ParseResult b
    forall a. PState -> ParseResult a
    PFailed PState
    s1

    instance HasDynFlags PD where
       getDynFlags :: PD DynFlags
    getDynFlags = (DynFlags -> HomeUnit -> PState -> ParseResult DynFlags)
    -> PD DynFlags
    forall a. (DynFlags -> HomeUnit -> PState -> ParseResult a) -> PD a
    PD ((DynFlags -> HomeUnit -> PState -> ParseResult DynFlags)
     -> PD DynFlags)
    -> (DynFlags -> HomeUnit -> PState -> ParseResult DynFlags)
    -> PD DynFlags
    forall a b. (a -> b) -> a -> b
    $ \DynFlags
    d HomeUnit
    _ PState
    s -> PState -> DynFlags -> ParseResult DynFlags
    forall a. PState -> a -> ParseResult a
    POk PState
    s DynFlags
    d

    getProfile :: PD Profile
    getProfile :: PD Profile
    getProfile = DynFlags -> Profile
    targetProfile (DynFlags -> Profile) -> PD DynFlags -> PD Profile
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> PD DynFlags
    forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags

    getPlatform :: PD Platform
    getPlatform :: PD Platform
    getPlatform = Profile -> Platform
    profilePlatform (Profile -> Platform) -> PD Profile -> PD Platform
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> PD Profile
    getProfile

    -- | Return the UnitId of the home-unit. This is used to create labels.
    getHomeUnitId :: PD UnitId
    getHomeUnitId :: PD UnitId
    getHomeUnitId = (DynFlags -> HomeUnit -> PState -> ParseResult UnitId) -> PD UnitId
    forall a. (DynFlags -> HomeUnit -> PState -> ParseResult a) -> PD a
    PD ((DynFlags -> HomeUnit -> PState -> ParseResult UnitId)
     -> PD UnitId)
    -> (DynFlags -> HomeUnit -> PState -> ParseResult UnitId)
    -> PD UnitId
    forall a b. (a -> b) -> a -> b
    $ \DynFlags
    _ HomeUnit
    hu PState
    s -> PState -> UnitId -> ParseResult UnitId
    forall a. PState -> a -> ParseResult a
    POk PState
    s (HomeUnit -> UnitId
    forall u. GenHomeUnit u -> UnitId
    homeUnitId HomeUnit
    hu)