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)