+processFile flags name
+ = do let file_name = dosifyPath name
+ s <- readFile file_name
+ case parser of
+ Parser p -> case p (SourcePos file_name 1) s of
+ Success _ _ _ toks -> output flags file_name toks
+ Failure (SourcePos name' line) msg ->
+ die (name'++":"++show line++": "++msg++"\n")
+
+------------------------------------------------------------------------
+-- A deterministic parser which remembers the text which has been parsed.
+
+newtype Parser a = Parser (SourcePos -> String -> ParseResult a)
+
+data ParseResult a = Success !SourcePos String String a
+ | Failure !SourcePos String
+
+data SourcePos = SourcePos String !Int
+
+updatePos :: SourcePos -> Char -> SourcePos
+updatePos pos@(SourcePos name line) ch = case ch of
+ '\n' -> SourcePos name (line + 1)
+ _ -> pos
+
+instance Monad Parser where
+ return a = Parser $ \pos s -> Success pos [] s a
+ Parser m >>= k =
+ Parser $ \pos s -> case m pos s of
+ Success pos' out1 s' a -> case k a of
+ Parser k' -> case k' pos' s' of
+ Success pos'' out2 imp'' b ->
+ Success pos'' (out1++out2) imp'' b
+ Failure pos'' msg -> Failure pos'' msg
+ Failure pos' msg -> Failure pos' msg
+ fail msg = Parser $ \pos _ -> Failure pos msg
+
+instance MonadPlus Parser where
+ mzero = fail "mzero"
+ Parser m `mplus` Parser n =
+ Parser $ \pos s -> case m pos s of
+ success@(Success _ _ _ _) -> success
+ Failure _ _ -> n pos s
+
+getPos :: Parser SourcePos
+getPos = Parser $ \pos s -> Success pos [] s pos
+
+setPos :: SourcePos -> Parser ()
+setPos pos = Parser $ \_ s -> Success pos [] s ()
+
+message :: Parser a -> String -> Parser a
+Parser m `message` msg =
+ Parser $ \pos s -> case m pos s of
+ success@(Success _ _ _ _) -> success
+ Failure pos' _ -> Failure pos' msg
+
+catchOutput_ :: Parser a -> Parser String
+catchOutput_ (Parser m) =
+ Parser $ \pos s -> case m pos s of
+ Success pos' out s' _ -> Success pos' [] s' out
+ Failure pos' msg -> Failure pos' msg
+
+fakeOutput :: Parser a -> String -> Parser a
+Parser m `fakeOutput` out =
+ Parser $ \pos s -> case m pos s of
+ Success pos' _ s' a -> Success pos' out s' a
+ Failure pos' msg -> Failure pos' msg
+
+lookAhead :: Parser String
+lookAhead = Parser $ \pos s -> Success pos [] s s
+
+satisfy :: (Char -> Bool) -> Parser Char
+satisfy p =
+ Parser $ \pos s -> case s of
+ c:cs | p c -> Success (updatePos pos c) [c] cs c
+ _ -> Failure pos "Bad character"
+
+char_ :: Char -> Parser ()
+char_ c = do
+ satisfy (== c) `message` (show c++" expected")
+ return ()
+
+anyChar_ :: Parser ()
+anyChar_ = do
+ satisfy (const True) `message` "Unexpected end of file"
+ return ()
+
+any2Chars_ :: Parser ()
+any2Chars_ = anyChar_ >> anyChar_
+
+many :: Parser a -> Parser [a]
+many p = many1 p `mplus` return []
+
+many1 :: Parser a -> Parser [a]
+many1 p = liftM2 (:) p (many p)
+
+many_ :: Parser a -> Parser ()
+many_ p = many1_ p `mplus` return ()
+
+many1_ :: Parser a -> Parser ()
+many1_ p = p >> many_ p
+
+manySatisfy, manySatisfy1 :: (Char -> Bool) -> Parser String
+manySatisfy = many . satisfy
+manySatisfy1 = many1 . satisfy
+
+manySatisfy_, manySatisfy1_ :: (Char -> Bool) -> Parser ()
+manySatisfy_ = many_ . satisfy
+manySatisfy1_ = many1_ . satisfy
+
+------------------------------------------------------------------------
+-- Parser of hsc syntax.