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)