    -----------------------------------------------------------------------------
    -- 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
      , getPtrOpts
      , getHomeUnitId
      ) where

    import GHC.Prelude

    import GHC.Platform
    import GHC.Platform.Profile
    import GHC.Cmm.Info

    import Control.Monad

    import GHC.Driver.Session
    import GHC.Parser.Lexer
    import GHC.Parser.Errors
    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 = forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
    liftM

    instance Applicative PD where
      pure :: forall a. a -> PD a
    pure = forall a. a -> PD a
    returnPD
      <*> :: forall a 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
    (>>=) = 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) = forall a. (DynFlags -> HomeUnit -> PState -> ParseResult a) -> PD a
    PD forall a b. (a -> b) -> a -> b
    $ \DynFlags
    _ HomeUnit
    _ PState
    s -> PState -> ParseResult a
    f PState
    s

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

    returnPD :: a -> PD a
    returnPD :: forall a. a -> PD a
    returnPD = forall a. P a -> PD a
    liftP forall b c a. (b -> c) -> (a -> b) -> a -> c
    . 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 = forall a. (DynFlags -> HomeUnit -> PState -> ParseResult a) -> PD a
    PD 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   -> 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 -> forall a. PState -> ParseResult a
    PFailed PState
    s1

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

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

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

    getPtrOpts :: PD PtrOpts
    getPtrOpts :: PD PtrOpts
    getPtrOpts = do
       DynFlags
    dflags <- forall (m :: * -> *). HasDynFlags m => m DynFlags
    getDynFlags
       Profile
    profile <- PD Profile
    getProfile
       forall (f :: * -> *) a. Applicative f => a -> f a
    pure forall a b. (a -> b) -> a -> b
    $ PtrOpts
          { po_profile :: Profile
    po_profile     = Profile
    profile
          , po_align_check :: Bool
    po_align_check = GeneralFlag -> DynFlags -> Bool
    gopt GeneralFlag
    Opt_AlignmentSanitisation DynFlags
    dflags
          }

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