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,
24 newtype ParserM a = ParserM (AlexInput -> St -> Either String (AlexInput, St, a))
26 instance Monad ParserM where
27 ParserM m >>= k = ParserM $ \i s -> case m i s of
33 return a = ParserM $ \i s -> Right (i, s, a)
34 fail err = ParserM $ \_ _ -> Left err
36 run_parser :: ParserM a -> (String -> Either String a)
37 run_parser (ParserM f)
38 = \s -> case f (AlexInput init_pos s) init_state of
40 Right (_, _, x) -> Right x
45 start_code :: !StartCode,
90 type Action = String -> ParserM Token
92 set_start_code :: StartCode -> ParserM ()
93 set_start_code sc = ParserM $ \i st -> Right (i, st { start_code = sc }, ())
95 inc_brace_depth :: ParserM ()
96 inc_brace_depth = ParserM $ \i st ->
97 Right (i, st { brace_depth = brace_depth st + 1 }, ())
99 dec_brace_depth :: ParserM ()
100 dec_brace_depth = ParserM $ \i st ->
101 let bd = brace_depth st - 1
102 sc = if bd == 0 then 0 else 1
103 in Right (i, st { brace_depth = bd, start_code = sc }, ())
105 andBegin :: Action -> StartCode -> Action
106 (act `andBegin` sc) x = do set_start_code sc
109 mkT :: Token -> Action
110 mkT t = mkTv (const t)
112 mkTv :: (String -> Token) -> Action
113 mkTv f str = ParserM (\i st -> Right (i, st, f str))
117 data Pos = Pos !Int{- Line -} !Int{- Column -}
119 get_pos :: ParserM Pos
120 get_pos = ParserM $ \i@(AlexInput p _) st -> Right (i, st, p)
122 alexMove :: Pos -> Char -> Pos
123 alexMove (Pos l _) '\n' = Pos (l+1) 1
124 alexMove (Pos l c) '\t' = Pos l ((c+8) `div` 8 * 8)
125 alexMove (Pos l c) _ = Pos l (c+1)
130 show_pos :: Pos -> String
131 show_pos (Pos l c) = "line " ++ show l ++ ", column " ++ show c
135 data AlexInput = AlexInput {position :: !Pos, input :: String}
137 alexGetChar :: AlexInput -> Maybe (Char,AlexInput)
138 alexGetChar (AlexInput p (x:xs)) = Just (x, AlexInput (alexMove p x) xs)
139 alexGetChar (AlexInput _ []) = Nothing
141 alexInputPrevChar :: AlexInput -> Char
142 alexInputPrevChar _ = error "Lexer doesn't implement alexInputPrevChar"
144 happyError :: ParserM a
145 happyError = do p <- get_pos
146 fail $ "Parse error at " ++ show_pos p