Fixing hpc to allow use of hash function to seperate source files on source path
[ghc.git] / utils / hpc / HpcLexer.hs
1 module HpcLexer where
2
3 import Data.Char
4
5 data Token
6 = ID String
7 | SYM Char
8 | INT Int
9 | STR String
10 deriving (Eq,Show)
11
12 initLexer :: String -> [Token]
13 initLexer str = [ t | (_,_,t) <- lexer str 1 0 ]
14
15 lexer :: String -> Int -> Int -> [(Int,Int,Token)]
16 lexer (c:cs) line column
17 | c == '\n' = lexer cs (succ line) 0
18 | c == '\"' = lexerSTR cs line (succ column)
19 | c `elem` "{};-:"
20 = (line,column,SYM c) : lexer cs line (succ column)
21 | isSpace c = lexer cs line (succ column)
22 | isAlpha c = lexerKW cs [c] line (succ column)
23 | isDigit c = lexerINT cs [c] line (succ column)
24 | otherwise = error "lexer failure"
25 lexer [] line colunm = []
26
27 lexerKW (c:cs) s line column
28 | isAlpha c = lexerKW cs (s ++ [c]) line (succ column)
29 lexerKW other s line column = (line,column,ID s) : lexer other line column
30
31 lexerINT (c:cs) s line column
32 | isDigit c = lexerINT cs (s ++ [c]) line (succ column)
33 lexerINT other s line column = (line,column,INT (read s)) : lexer other line column
34
35 -- not technically correct for the new column count, but a good approximation.
36 lexerSTR cs line column
37 = case lex ('"' : cs) of
38 [(str,rest)] -> (line,succ column,STR str)
39 : lexer rest line (length (show str) + column + 1)
40 _ -> error "bad string"
41
42 test = do
43 t <- readFile "EXAMPLE.tc"
44 print (initLexer t)
45