Remove trailing whitespace
[ghc.git] / compiler / cmm / CmmMonad.hs
1 {-# LANGUAGE CPP #-}
2
3 -----------------------------------------------------------------------------
4 -- A Parser monad with access to the 'DynFlags'.
5 --
6 -- The 'P' monad only has access to the subset of of 'DynFlags'
7 -- required for parsing Haskell.
8
9 -- The parser for C-- requires access to a lot more of the 'DynFlags',
10 -- so 'PD' provides access to 'DynFlags' via a 'HasDynFlags' instance.
11 -----------------------------------------------------------------------------
12 module CmmMonad (
13 PD(..)
14 , liftP
15 ) where
16
17 import GhcPrelude
18
19 import Control.Monad
20 import qualified Control.Monad.Fail as MonadFail
21
22 import DynFlags
23 import Lexer
24
25 newtype PD a = PD { unPD :: DynFlags -> PState -> ParseResult a }
26
27 instance Functor PD where
28 fmap = liftM
29
30 instance Applicative PD where
31 pure = returnPD
32 (<*>) = ap
33
34 instance Monad PD where
35 (>>=) = thenPD
36 #if !MIN_VERSION_base(4,13,0)
37 fail = MonadFail.fail
38 #endif
39
40 instance MonadFail.MonadFail PD where
41 fail = failPD
42
43 liftP :: P a -> PD a
44 liftP (P f) = PD $ \_ s -> f s
45
46 returnPD :: a -> PD a
47 returnPD = liftP . return
48
49 thenPD :: PD a -> (a -> PD b) -> PD b
50 (PD m) `thenPD` k = PD $ \d s ->
51 case m d s of
52 POk s1 a -> unPD (k a) d s1
53 PFailed s1 -> PFailed s1
54
55 failPD :: String -> PD a
56 failPD = liftP . fail
57
58 instance HasDynFlags PD where
59 getDynFlags = PD $ \d s -> POk s d