From: Mart Lubbers Date: Thu, 3 Mar 2016 09:24:37 +0000 (+0100) Subject: clean up some more' X-Git-Url: https://git.martlubbers.net/?a=commitdiff_plain;h=39628afef1b12a7481a720d4de46d9aab76fd0f9;p=cc1516.git clean up some more' --- diff --git a/lex.icl b/lex.icl index 29d3c17..21a29e9 100644 --- a/lex.icl +++ b/lex.icl @@ -1,17 +1,22 @@ implementation module lex import Control.Monad, Control.Applicative -import Data.Either, Data.Func, Data.Maybe, Data.Functor -from StdFunc import o, const +import Data.Either, Data.Func +from StdFunc import o import StdBool import StdList import StdChar import StdString -from Text import class Text(textSize,concat), instance Text String - import yard +:: LexItem + = LexToken Int TokenValue + | LexSpace Int Int + | LexNL + | LexEOF + | LexItemError String + lexer :: [Char] -> LexerOutput lexer r = case runParser (lexProgram 1 1) r of (Right p, _) = Right p @@ -19,23 +24,16 @@ lexer r = case runParser (lexProgram 1 1) r of lexProgram :: Int Int -> Parser Char [Token] lexProgram line column = lexToken >>= \t->case t of - LexEOF = pure [] - (LexItemError e) = fail - PositionalError line column ("LexerError: " +++ e) - (LexToken c t) = lexProgram line (column+c) - >>= \rest->pure [{line=line, column=column, token=t}:rest] - LexNL = lexProgram (line+1) 1 - (LexSpace l c) = lexProgram (line+l) (column+c) - -:: LexItem - = LexToken Int TokenValue - | LexSpace Int Int - | LexNL - | LexEOF - | LexItemError String + LexEOF = pure [] + LexNL = lexProgram (line+1) 1 + (LexSpace l c) = lexProgram (line+l) (column+c) + (LexItemError e) = fail + PositionalError line column ("LexerError: " +++ e) + (LexToken c t) = lexProgram line (column+c) + >>= \rest->pure [{line=line, column=column, token=t}:rest] lexToken :: Parser Char LexItem -lexToken = +lexToken = //Comments lexBlockComment <|> lexComment <|> //Keyword tokens @@ -52,38 +50,38 @@ lexToken = lexWord "<=" LesserEqToken <|> lexWord ">=" GreaterEqToken <|> lexWord "==" EqualsToken <|> lexWord "&&" AmpersandsToken <|> lexWord "||" PipesToken <|> lexWord "[]" EmptyListToken <|> - lexWord "->" ArrowToken <|> + lexWord "->" ArrowToken <|> //One char ops tokens - lexWord "(" BraceOpenToken <|> - lexWord ")" BraceCloseToken <|> lexWord "{" CBraceOpenToken <|> - lexWord "}" CBraceCloseToken <|> lexWord "[" SquareOpenToken <|> - lexWord "]" SquareCloseToken <|> lexWord "," CommaToken <|> - lexWord ":" ColonToken <|> lexWord ";" SColonToken <|> - lexWord "." DotToken <|> lexWord "+" PlusToken <|> - lexWord "*" StarToken <|> lexWord "/" SlashToken <|> - lexWord "%" PercentToken <|> lexWord "=" AssignmentToken <|> - lexWord "<" LesserToken <|> lexWord ">" BiggerToken <|> - lexWord "!" ExclamationToken <|> lexWord "-" DashToken <|> + lexWord "(" BraceOpenToken <|> lexWord ")" BraceCloseToken <|> + lexWord "{" CBraceOpenToken <|> lexWord "}" CBraceCloseToken <|> + lexWord "[" SquareOpenToken <|> lexWord "]" SquareCloseToken <|> + lexWord "," CommaToken <|> lexWord ":" ColonToken <|> + lexWord ";" SColonToken <|> lexWord "." DotToken <|> + lexWord "+" PlusToken <|> lexWord "*" StarToken <|> + lexWord "/" SlashToken <|> lexWord "%" PercentToken <|> + lexWord "=" AssignmentToken <|> lexWord "<" LesserToken <|> + lexWord ">" BiggerToken <|> lexWord "!" ExclamationToken <|> + lexWord "-" DashToken <|> //Number and identifier tokens lexNumber <|> lexIdentifier <|> (item '\n' >>| pure LexNL) <|> + //Whitespace (satisfy isSpace >>| (pure $ LexSpace 0 1)) <|> (eof >>| pure LexEOF) where lexWord :: String TokenValue -> Parser Char LexItem - lexWord s tv = list (fromString s) >>| pure (LexToken (textSize s) tv) + lexWord s tv = list ls >>| pure (LexToken (length ls) tv) + where ls = fromString s lexKw :: String TokenValue -> Parser Char LexItem lexKw kw tv = lexWord kw tv <* check (not o isIdentChar) - lexUntilNL = top until (eof <|> (item '\n' >>| pure Void)) - lexComment :: Parser Char LexItem - lexComment = list (fromString "//") >>| lexUntilNL - >>| pure LexNL + lexComment = list (fromString "//") + >>| top until (eof <|> (item '\n' >>| pure Void)) >>| pure LexNL lexBlockComment :: Parser Char LexItem - lexBlockComment = list (fromString "/*") + lexBlockComment = list (fromString "/*") >>| (top until (list (fromString "*/"))) >>= \chars->pure $ widthHeight chars 0 0 where @@ -93,12 +91,12 @@ lexToken = widthHeight [x:xs] l c = widthHeight xs l (c+1) lexNumber :: Parser Char LexItem - lexNumber = toString <$> some (satisfy isDigit) - >>= \si->pure $ LexToken (textSize si) (NumberToken $ toInt si) + lexNumber = some (satisfy isDigit) >>= \si->pure $ + LexToken (length si) (NumberToken $ toInt $ toString si) lexIdentifier :: Parser Char LexItem - lexIdentifier = toString <$> some (satisfy isIdentChar) - >>= \si->pure $ LexToken (textSize si) (IdentToken si) + lexIdentifier = some (satisfy isIdentChar) + >>= \si->pure $ LexToken (length si) (IdentToken $ toString si) isIdentChar c = isAlphanum c || c == '_'