blob: af018fcd5acd8b8926d0b992ddc85a4e344b89bb (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
|
-----------------------------------------------------------------------------
-- A Parser monad with access to the 'DynFlags'.
--
-- The 'P' monad only has access to the subset of 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.
-----------------------------------------------------------------------------
{-# LANGUAGE CPP #-}
module CmmMonad (
PD(..)
, liftP
) where
import Control.Monad
#if __GLASGOW_HASKELL__ > 710
import qualified Control.Monad.Fail as MonadFail
#endif
import DynFlags
import Lexer
newtype PD a = PD { unPD :: DynFlags -> PState -> ParseResult a }
instance Functor PD where
fmap = liftM
instance Applicative PD where
pure = returnPD
(<*>) = ap
instance Monad PD where
(>>=) = thenPD
fail = failPD
#if __GLASGOW_HASKELL__ > 710
instance MonadFail.MonadFail PD where
fail = failPD
#endif
liftP :: P a -> PD a
liftP (P f) = PD $ \_ s -> f s
returnPD :: a -> PD a
returnPD = liftP . return
thenPD :: PD a -> (a -> PD b) -> PD b
(PD m) `thenPD` k = PD $ \d s ->
case m d s of
POk s1 a -> unPD (k a) d s1
PFailed span err -> PFailed span err
failPD :: String -> PD a
failPD = liftP . fail
instance HasDynFlags PD where
getDynFlags = PD $ \d s -> POk s d
|
