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