diff options
Diffstat (limited to 'paper/While/WhileLexer.icl')
-rw-r--r-- | paper/While/WhileLexer.icl | 62 |
1 files changed, 62 insertions, 0 deletions
diff --git a/paper/While/WhileLexer.icl b/paper/While/WhileLexer.icl new file mode 100644 index 0000000..458f260 --- /dev/null +++ b/paper/While/WhileLexer.icl @@ -0,0 +1,62 @@ +implementation module WhileLexer + +from StdOverloaded import class == +import _SystemArray, StdBool, StdChar, StdList, StdString +import GenEq +import Common +import WhileCommon + +derive gEq Token +instance == Token where == a b = a === b + +lex :: [Char] -> Either Error [Token] +lex [] = pure [] +lex ['s':'k':'i':'p':cs] + | noident cs = lexyield SkipToken cs +lex ['i':'f':cs] + | noident cs = lexyield IfToken cs +lex ['t':'h':'e':'n':cs] + | noident cs = lexyield ThenToken cs +lex ['e':'l':'s':'e':cs] + | noident cs = lexyield ElseToken cs +lex ['w':'h':'i':'l':'e':cs] + | noident cs = lexyield WhileToken cs +lex ['d':'o':cs] + | noident cs = lexyield DoToken cs +lex ['t':'r':'u':'e':cs] + | noident cs = lexyield (BoolToken True) cs +lex ['f':'a':'l':'s':'e':cs] + | noident cs = lexyield (BoolToken False) cs +lex [';':cs] = lexyield CompToken cs +lex [':':'=':cs] = lexyield AssToken cs +lex ['<':'=':cs] = lexyield LeToken cs +lex ['<':'>':cs] = lexyield NeToken cs +lex ['<':cs] = lexyield LtToken cs +lex ['>':'=':cs] = lexyield GeToken cs +lex ['>':cs] = lexyield GtToken cs +lex ['=':cs] = lexyield EqToken cs +lex ['|':cs] = lexyield OrToken cs +lex ['&':cs] = lexyield AndToken cs +lex ['~':cs] = lexyield NotToken cs +lex ['+':cs] = lexyield AddToken cs +lex ['-':cs] = lexyield SubToken cs +lex ['*':cs] = lexyield MulToken cs +lex ['/':cs] = lexyield DivToken cs +lex ['(':cs] = lexyield ParenOpen cs +lex [')':cs] = lexyield ParenClose cs +lex cs=:[c:rest] + | isAlpha c = let (id, cs`) = span isAlpha cs in + lexyield (VarToken (toString id)) cs` + | isDigit c = let (lit, cs`) = span isDigit cs in + lexyield (LiteralToken (toInt lit)) cs` + | isSpace c = lex rest +lex [c:_] = Left (Lextime ("Unexpected character in input: " +++ {c})) + +instance toInt [Char] where toInt cs = toInt (toString cs) + +lexyield :: Token [Char] -> Either Error [Token] +lexyield tk cs = lex cs >>= \cs` -> pure [tk:cs`] + +noident :: [Char] -> Bool +noident [] = True +noident [c:_] = not (isAlpha c) |