blob: af29dd80b6eb6a196ac62bb370da03975d978712 (
plain) (
blame)
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
59
60
61
62
63
64
65
66
67
68
69
70
|
-----------------------------------------------------------------------------
-- $Id: HsParseMonad.lhs,v 1.1 2002/04/04 16:23:43 simonmar Exp $
--
-- (c) The GHC Team 1997-2000
--
-- Monad for the Haskell parser.
--
-----------------------------------------------------------------------------
\begin{code}
module HsParseMonad where
import HsSyn
\end{code}
\begin{code}
data ParseResult a = Ok ParseState a | Failed String
deriving Show
data LexContext = NoLayout | Layout Int
deriving (Eq,Ord,Show)
type ParseState = [LexContext]
type P a
= String -- input string
-> SrcLoc -- location of last token read
-> Int -- current line
-> Int -- current column
-> ParseState -- layout info.
-> ParseResult a
thenP :: P a -> (a -> P b) -> P b
m `thenP` k = \i l n c s ->
case m i l n c s of
Failed s -> Failed s
Ok s' a -> case k a of k' -> k' i l n c s'
m `thenP_` k = m `thenP` \_ -> k
mapP :: (a -> P b) -> [a] -> P [b]
mapP f [] = returnP []
mapP f (a:as) =
f a `thenP` \b ->
mapP f as `thenP` \bs ->
returnP (b:bs)
returnP a = \i l n c s -> Ok s a
failP :: String -> P a
failP err = \i l n c s -> Failed err
getSrcLoc :: P SrcLoc
getSrcLoc = \i l n c s -> Ok s l
getContext :: P [LexContext]
getContext = \i l n c s -> Ok s s
pushContext :: LexContext -> P ()
pushContext ctxt =
--trace ("pushing lexical scope: " ++ show ctxt ++"\n") $
\i l n c s -> Ok (ctxt:s) ()
popContext :: P ()
popContext = \i l n c stk ->
case stk of
(_:s) -> --trace ("popping lexical scope, context now "++show s ++ "\n") $
Ok s ()
[] -> error "Internal error: empty context in popContext"
\end{code}
|
