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