never executed always true always false

    1 -----------------------------------------------------------------------------
    2 -- A Parser monad with access to the 'DynFlags'.
    3 --
    4 -- The 'P' monad only has access to the subset of 'DynFlags'
    5 -- required for parsing Haskell.
    6 
    7 -- The parser for C-- requires access to a lot more of the 'DynFlags',
    8 -- so 'PD' provides access to 'DynFlags' via a 'HasDynFlags' instance.
    9 -----------------------------------------------------------------------------
   10 module GHC.Cmm.Parser.Monad (
   11     PD(..)
   12   , liftP
   13   , failMsgPD
   14   , getProfile
   15   , getPlatform
   16   , getPtrOpts
   17   , getHomeUnitId
   18   ) where
   19 
   20 import GHC.Prelude
   21 
   22 import GHC.Platform
   23 import GHC.Platform.Profile
   24 import GHC.Cmm.Info
   25 
   26 import Control.Monad
   27 
   28 import GHC.Driver.Session
   29 import GHC.Parser.Lexer
   30 import GHC.Parser.Errors.Types
   31 import GHC.Types.Error ( MsgEnvelope )
   32 import GHC.Types.SrcLoc
   33 import GHC.Unit.Types
   34 import GHC.Unit.Home
   35 
   36 newtype PD a = PD { unPD :: DynFlags -> HomeUnit -> PState -> ParseResult a }
   37 
   38 instance Functor PD where
   39   fmap = liftM
   40 
   41 instance Applicative PD where
   42   pure = returnPD
   43   (<*>) = ap
   44 
   45 instance Monad PD where
   46   (>>=) = thenPD
   47 
   48 liftP :: P a -> PD a
   49 liftP (P f) = PD $ \_ _ s -> f s
   50 
   51 failMsgPD :: (SrcSpan -> MsgEnvelope PsMessage) -> PD a
   52 failMsgPD = liftP . failMsgP
   53 
   54 returnPD :: a -> PD a
   55 returnPD = liftP . return
   56 
   57 thenPD :: PD a -> (a -> PD b) -> PD b
   58 (PD m) `thenPD` k = PD $ \d hu s ->
   59         case m d hu s of
   60                 POk s1 a   -> unPD (k a) d hu s1
   61                 PFailed s1 -> PFailed s1
   62 
   63 instance HasDynFlags PD where
   64    getDynFlags = PD $ \d _ s -> POk s d
   65 
   66 getProfile :: PD Profile
   67 getProfile = targetProfile <$> getDynFlags
   68 
   69 getPlatform :: PD Platform
   70 getPlatform = profilePlatform <$> getProfile
   71 
   72 getPtrOpts :: PD PtrOpts
   73 getPtrOpts = do
   74    dflags <- getDynFlags
   75    profile <- getProfile
   76    pure $ PtrOpts
   77       { po_profile     = profile
   78       , po_align_check = gopt Opt_AlignmentSanitisation dflags
   79       }
   80 
   81 -- | Return the UnitId of the home-unit. This is used to create labels.
   82 getHomeUnitId :: PD UnitId
   83 getHomeUnitId = PD $ \_ hu s -> POk s (homeUnitId hu)