X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;ds=sidebyside;f=lex.icl;h=9a414cbdcc953575434fb4e1b8985b20e5e788f3;hb=f5231ebadae1ac54e25dbf5819debb3ab625826d;hp=0adb20c879a4b3492df770199df3ef302989af9b;hpb=f4ee031491f6d753513b03f46a602321569e1114;p=cc1516.git diff --git a/lex.icl b/lex.icl deleted file mode 100644 index 0adb20c..0000000 --- a/lex.icl +++ /dev/null @@ -1,72 +0,0 @@ -implementation module lex - -import Control.Monad -import Data.Either -import Data.Maybe -import Data.Map -import Data.Func -import StdString -import StdTuple -import StdBool -import StdList -import StdChar -import qualified Text - -SingleCharTokens :: Map Char Token -SingleCharTokens = fromList [ - ('(', BraceOpenToken), (')', BraceCloseToken), ('{', CBraceOpenToken), - ('}', CBraceCloseToken), ('[', SquareOpenToken), (']', SquareCloseToken), - (',', CommaToken), (':', ColonToken), (';', SColonToken), - ('.', DotToken), ('+', PlusToken), ('*', StarToken), ('/', SlashToken), - ('%', PercentToken), ('=', AssignmentToken), ('<', LesserToken), - ('>', BiggerToken), ('!', ExclamationToken)] - -EscapeMap :: Map Char Char -EscapeMap = fromList [('a', toChar 7), ('b', '\b'), ('f', '\f'), ('n', '\n'), - ('r', '\r'), ('t', '\t'), ('v', '\v')] - -lexer :: [Char] -> LexerOutput -lexer [] = Right [] -lexer x = case lex x of - (Right t, rest) = lexer rest >>= \ts.Right [t:ts] - (Left e, _) = Left e - -lex :: [Char] -> (Either String Token, [Char]) -lex [] = (Right EndOfFileToken, []) -lex ['/':'/':xs] = lex $ dropWhile ((<>) '\n') xs -lex ['/':'*':xs] = - lex $ tl $ map snd $ dropWhile ((<>) ('*', '/')) $ zip2 [zero:xs] xs -lex ['v':'a':'r':xs] = (Right VarToken, xs) -lex ['V':'o':'i':'d':xs] = (Right VoidToken, xs) -lex ['r':'e':'t':'u':'r':'n':xs] = (Right ReturnToken, xs) -lex ['i':'f':xs] = (Right IfToken, xs) -lex ['e':'l':'s':'e':xs] = (Right ElseToken, xs) -lex ['w':'h':'i':'l':'e':xs] = (Right WhileToken, xs) -lex ['T':'r':'u':'e':xs] = (Right TrueToken, xs) -lex ['F':'a':'l':'s':'e':xs] = (Right FalseToken, xs) -lex ['I':'n':'t':xs] = (Right IntTypeToken, xs) -lex ['C':'h':'a':'r':xs] = (Right CharTypeToken, xs) -lex ['B':'o':'o':'l':xs] = (Right BoolTypeToken, xs) -lex [':':':':xs] = (Right DoubleColonToken, xs) -lex ['!':'=':xs] = (Right NotEqualToken, xs) -lex ['<':'=':xs] = (Right LesserEqToken, xs) -lex ['>':'=':xs] = (Right GreaterEqToken, xs) -lex ['=':'=':xs] = (Right EqualsToken, xs) -lex ['&':'&':xs] = (Right AmpersandsToken, xs) -lex ['|':'|':xs] = (Right PipesToken, xs) -lex ['-':'>':xs] = (Right ArrowToken, xs) -lex ['\'':x:'\'':xs] = (Right (CharToken x), xs) -lex ['\'':'\\':x:'\'':xs] = case get x EscapeMap of - Just t = (Right (CharToken t), xs) - _ = (Left ("Unknown escape: \\" +++ toString x), []) -lex ['-':t=:[x:xs]] -| isDigit x = let (i, r) = span isDigit t in (Right (NumberToken ['-':i]), r) -| otherwise = (Right DashToken, xs) -lex t=:[x:xs] = case get x SingleCharTokens of - (Just tok) = (Right tok, xs) - Nothing - | isSpace x = lex xs - | isDigit x = let (i, r) = span isDigit t in (Right (NumberToken i), r) - | isAlpha x = let (i, r) = span isIdent t in (Right (IdentToken i), r) - with isIdent c = isAlphanum c || c == '_' - | otherwise = (Left ("Unexpected character: " +++ toString x), [])