Only trace cap/capset events if we're tracing anything else
[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 | CAT String
11 deriving (Eq,Show)
12
13 initLexer :: String -> [Token]
14 initLexer str = [ t | (_,_,t) <- lexer str 1 1 ]
15
16 lexer :: String -> Int -> Int -> [(Int,Int,Token)]
17 lexer (c:cs) line column
18 | c == '\n' = lexer cs (succ line) 1
19 | c == '\"' = lexerSTR cs line (succ column)
20 | c == '[' = lexerCAT cs "" line (succ column)
21 | c `elem` "{};-:"
22 = (line,column,SYM c) : lexer cs line (succ column)
23 | isSpace c = lexer cs line (succ column)
24 | isAlpha c = lexerKW cs [c] line (succ column)
25 | isDigit c = lexerINT cs [c] line (succ column)
26 | otherwise = error "lexer failure"
27 lexer [] _ _ = []
28
29 lexerKW :: String -> String -> Int -> Int -> [(Int,Int,Token)]
30 lexerKW (c:cs) s line column
31 | isAlpha c = lexerKW cs (s ++ [c]) line (succ column)
32 lexerKW other s line column = (line,column,ID s) : lexer other line column
33
34 lexerINT :: String -> String -> Int -> Int -> [(Int,Int,Token)]
35 lexerINT (c:cs) s line column
36 | isDigit c = lexerINT cs (s ++ [c]) line (succ column)
37 lexerINT other s line column = (line,column,INT (read s)) : lexer other line column
38
39 -- not technically correct for the new column count, but a good approximation.
40 lexerSTR :: String -> Int -> Int -> [(Int,Int,Token)]
41 lexerSTR cs line column
42 = case lex ('"' : cs) of
43 [(str,rest)] -> (line,succ column,STR (read str))
44 : lexer rest line (length (show str) + column + 1)
45 _ -> error "bad string"
46
47 lexerCAT :: String -> String -> Int -> Int -> [(Int,Int,Token)]
48 lexerCAT (c:cs) s line column
49 | c == ']' = (line,column,CAT s) : lexer cs line (succ column)
50 | otherwise = lexerCAT cs (s ++ [c]) line (succ column)
51 lexerCAT [] _ _ _ = error "lexer failure in CAT"
52
53 test :: IO ()
54 test = do
55 t <- readFile "EXAMPLE.tc"
56 print (initLexer t)
57