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 = (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 -> PsError) -> PD a
failMsgPD :: forall a. (SrcSpan -> PsError) -> PD a
failMsgPD = P a -> PD a
forall a. P a -> PD a
liftP (P a -> PD a)
-> ((SrcSpan -> PsError) -> P a) -> (SrcSpan -> PsError) -> PD a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SrcSpan -> PsError) -> P a
forall a. (SrcSpan -> PsError) -> 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 (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
getPtrOpts :: PD PtrOpts
getPtrOpts :: PD PtrOpts
getPtrOpts = do
DynFlags
dflags <- PD DynFlags
forall (m :: * -> *). HasDynFlags m => m DynFlags
getDynFlags
Profile
profile <- PD Profile
getProfile
PtrOpts -> PD PtrOpts
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PtrOpts -> PD PtrOpts) -> PtrOpts -> PD PtrOpts
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
}
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)