1module HpcLexer where
2
3import Data.Char
4
5data Token
6        = ID String
7        | SYM Char
8        | INT Int
9        | STR String
10        | CAT String
11        deriving (Eq,Show)
12
13initLexer :: String -> [Token]
14initLexer str = [ t | (_,_,t) <- lexer str 1 1 ]
15
16lexer :: String -> Int -> Int ->  [(Int,Int,Token)]
17lexer (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"
27lexer [] _ _ = []
28
29lexerKW :: String -> String -> Int -> Int -> [(Int,Int,Token)]
30lexerKW  (c:cs) s line column
31  | isAlpha c = lexerKW cs (s ++ [c]) line (succ column)
32lexerKW  other s line column = (line,column,ID s) : lexer other line column
33
34lexerINT :: String -> String -> Int -> Int -> [(Int,Int,Token)]
35lexerINT  (c:cs) s line column
36  | isDigit c = lexerINT cs (s ++ [c]) line (succ column)
37lexerINT  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.
40lexerSTR :: String -> Int -> Int -> [(Int,Int,Token)]
41lexerSTR 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
47lexerCAT :: String -> String -> Int -> Int -> [(Int,Int,Token)]
48lexerCAT (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)
51lexerCAT  [] _ _ _ = error "lexer failure in CAT"
52
53test :: IO ()
54test = do
55          t <- readFile "EXAMPLE.tc"
56          print (initLexer t)
57
58