4 ParserM(..), AlexInput, run_parser,
7 StartCode, start_code, set_start_code,
8 inc_brace_depth, dec_brace_depth,
12 Action, andBegin, mkT, mkTv,
16 alexGetChar, alexInputPrevChar, input, position,
22 newtype ParserM a = ParserM (AlexInput -> St -> Either String (AlexInput, St, a))
24 instance Monad ParserM where
25 ParserM m >>= k = ParserM $ \i s -> case m i s of
31 return a = ParserM $ \i s -> Right (i, s, a)
32 fail err = ParserM $ \_ _ -> Left err
34 run_parser :: ParserM a -> (String -> Either String a)
35 run_parser (ParserM f)
36 = \s -> case f (AlexInput init_pos s) init_state of
38 Right (_, _, x) -> Right x
43 start_code :: !StartCode,
89 type Action = String -> ParserM Token
91 set_start_code :: StartCode -> ParserM ()
92 set_start_code sc = ParserM $ \i st -> Right (i, st { start_code = sc }, ())
94 inc_brace_depth :: ParserM ()
95 inc_brace_depth = ParserM $ \i st ->
96 Right (i, st { brace_depth = brace_depth st + 1 }, ())
98 dec_brace_depth :: ParserM ()
99 dec_brace_depth = ParserM $ \i st ->
100 let bd = brace_depth st - 1
101 sc = if bd == 0 then 0 else 1
102 in Right (i, st { brace_depth = bd, start_code = sc }, ())
104 andBegin :: Action -> StartCode -> Action
105 (act `andBegin` sc) x = do set_start_code sc
108 mkT :: Token -> Action
109 mkT t = mkTv (const t)
111 mkTv :: (String -> Token) -> Action
112 mkTv f str = ParserM (\i st -> Right (i, st, f str))
116 data Pos = Pos !Int{- Line -} !Int{- Column -}
118 get_pos :: ParserM Pos
119 get_pos = ParserM $ \i@(AlexInput p _) st -> Right (i, st, p)
121 alexMove :: Pos -> Char -> Pos
122 alexMove (Pos l _) '\n' = Pos (l+1) 1
123 alexMove (Pos l c) '\t' = Pos l ((c+8) `div` 8 * 8)
124 alexMove (Pos l c) _ = Pos l (c+1)
129 show_pos :: Pos -> String
130 show_pos (Pos l c) = "line " ++ show l ++ ", column " ++ show c
134 data AlexInput = AlexInput {position :: !Pos, input :: String}
136 alexGetChar :: AlexInput -> Maybe (Char,AlexInput)
137 alexGetChar (AlexInput p (x:xs)) = Just (x, AlexInput (alexMove p x) xs)
138 alexGetChar (AlexInput _ []) = Nothing
140 alexInputPrevChar :: AlexInput -> Char
141 alexInputPrevChar _ = error "Lexer doesn't implement alexInputPrevChar"
143 happyError :: ParserM a
144 happyError = do p <- get_pos
145 fail $ "Parse error at " ++ show_pos p