implementation module lex

import Data.Either
import Data.List
import StdString
import System.CommandLine
import StdFile
import StdMisc
import StdBool
from StdFunc import id, const
import Data.Maybe
import Control.Applicative
import Control.Monad
import Control.Monad.State
import Data.Functor
from Data.Func import $
from Text import class Text, instance Text String
import qualified Text

Start :: *World -> *World
Start w
# (args, w) = getCommandLine w // We lezen nu nog standaard van stdin
# (out, w) = stdio w
# (toparse, out) = readEntireFile out
# out = out <<< print (lexer toparse)
# (b, w) = fclose out w
| not b = setReturnCode 1 w
= w
	where
		readEntireFile :: *File -> *([Char], *File)
		readEntireFile f
		# (b, c, f) = freadc f
		| not b = ([], f)
		# (cs, f) = readEntireFile f
		= ([c:cs], f)

lexer :: [Char] -> LexerOutput
lexer [] = Right []
lexer x = case lex x of
	(Right t, rest) = lexer rest >>= \ts.Right [t:ts]
	(Left e, _) = Left e

print :: LexerOutput -> String
print (Left l) = "Error: " +++ l
print (Right x) = 'Text'.concat (print` 0 x)
	where
		print` :: Int [Token] -> [String]
		print` _ [] = []
		print` i [(IdentToken l):rest] = [toString l:print` i rest]
		print` i [(NumberToken j):rest] = [toString j:print` i rest]
		print` i [(CharToken c):rest] = ["'":toString c:"'":print` i rest]
		print` i [VarToken:rest] = ["var ":print` i rest]
		print` i [VoidToken:rest] = ["Void":print` i rest]
		print` i [ReturnToken:rest] = ["return":print` i rest]
		print` i [IfToken:rest] = ["if":print` i rest]
		print` i [ElseToken:rest] = ["else":print` i rest]
		print` i [WhileToken:rest] = ["while":print` i rest]
		print` i [TrueToken:rest] = ["True":print` i rest]
		print` i [FalseToken:rest] = ["False":print` i rest]
		print` i [BraceOpenToken:rest] = ["(":print` i rest]
		print` i [BraceCloseToken:rest] = [")":print` i rest]
		print` i [CBraceOpenToken:rest] = ["{\n":tab (i+1):print` (i+1) rest]
		print` i [CBraceCloseToken:rest] = ["}\n":tab i:print` i rest]
		print` i [SquareOpenToken:rest] = ["[":print` i rest]
		print` i [SquareCloseToken:rest] = ["]":print` i rest]
		print` i [CommaToken:rest] = [", ":print` i rest]
		print` i [ColonToken:rest] = [":":print` i rest]
		print` i [SColonToken:CBraceCloseToken:rest] =
			[";\n":tab (i-1):"}\n":print` (i-1) rest]
		print` i [SColonToken:rest] = [";\n":tab i:print` i rest]
		print` i [DotToken:rest] = [".":print` i rest]
		print` i [PlusToken:rest] = [" + ":print` i rest]
		print` i [DashToken:rest] = [" - ":print` i rest]
		print` i [StarToken:rest] = [" * ":print` i rest]
		print` i [SlashToken:rest] = [" / ":print` i rest]
		print` i [PercentToken:rest] = [" % ":print` i rest]
		print` i [AssignmentToken:rest] = [" = ":print` i rest]
		print` i [LesserToken:rest] = [" < ":print` i rest]
		print` i [BiggerToken:rest] = [" > ":print` i rest]
		print` i [ExclamationToken:rest] = ["!":print` i rest]
		print` i [DoubleColonToken:rest] = [" :: ":print` i rest]
		print` i [LesserEqToken:rest] = [" <= ":print` i rest]
		print` i [GreaterEqToken:rest] = [" >= ":print` i rest]
		print` i [EqualsToken:rest] = [" == ":print` i rest]
		print` i [AmpersandsToken:rest] = [" && ":print` i rest]
		print` i [PipesToken:rest] = [" || ":print` i rest]
		print` i [ArrowToken:rest] = [" -> ":print` i rest]
		print` i [EndOfFileToken:rest] = ["\n":print` i rest]

tab :: Int -> String
tab 0 = ""
tab i = "\t" +++ tab (i-1)


lex :: [Char] -> (Either String Token, [Char])
lex [] = (Right EndOfFileToken, [])
lex ['v':'a':'r':rest] = (Right VarToken, rest)
lex ['V':'o':'i':'d':rest] = (Right VoidToken, rest)
lex ['r':'e':'t':'u':'r':'n':rest] = (Right ReturnToken, rest)
lex ['i':'f':rest] = (Right IfToken, rest)
lex ['e':'l':'s':'e':rest] = (Right ElseToken, rest)
lex ['w':'h':'i':'l':'e':rest] = (Right WhileToken, rest)
lex ['T':'r':'u':'e':rest] = (Right TrueToken, rest)
lex ['F':'a':'l':'s':'e':rest] = (Right FalseToken, rest)
lex ['\'':'\\':x:'\'':rest] = case x of
	'a' = (Right (CharToken (toChar 7)), rest) //Alarm
	'b' = (Right (CharToken '\b'), rest) //Backspace
	'f' = (Right (CharToken '\f'), rest) //Formfeed
	'n' = (Right (CharToken '\n'), rest) //Newline
	'r' = (Right (CharToken '\r'), rest) //Carriage Return
	't' = (Right (CharToken '\t'), rest) //Horizontal tab
	'v' = (Right (CharToken '\v'), rest) //Vertical tab
	_ = (Left ("Unknown escape: \\" +++ toString x), rest)
lex ['\'':x:'\'':rest] = (Right (CharToken x), rest)
lex [':':':':rest] = (Right DoubleColonToken, rest)
lex ['<':'=':rest] = (Right LesserEqToken, rest)
lex ['>':'=':rest] = (Right GreaterEqToken, rest)
lex ['=':'=':rest] = (Right EqualsToken, rest)
lex ['&':'&':rest] = (Right AmpersandsToken, rest)
lex ['|':'|':rest] = (Right PipesToken, rest)
lex ['-':'>':rest] = (Right ArrowToken, rest)
lex ['(':rest] = (Right BraceOpenToken, rest)
lex [')':rest] = (Right BraceCloseToken, rest)
lex ['{':rest] = (Right CBraceOpenToken, rest)
lex ['}':rest] = (Right CBraceCloseToken, rest)
lex ['[':rest] = (Right SquareOpenToken, rest)
lex [']':rest] = (Right SquareCloseToken, rest)
lex [',':rest] = (Right CommaToken, rest)
lex [':':rest] = (Right ColonToken, rest)
lex [';':rest] = (Right SColonToken, rest)
lex ['.':rest] = (Right DotToken, rest)
lex ['+':rest] = (Right PlusToken, rest)
lex ['-':rest] = (Right DashToken, rest)
lex ['*':rest] = (Right StarToken, rest)
lex ['/':rest] = (Right SlashToken, rest)
lex ['%':rest] = (Right PercentToken, rest)
lex ['=':rest] = (Right AssignmentToken, rest)
lex ['<':rest] = (Right LesserToken, rest)
lex ['>':rest] = (Right BiggerToken, rest)
lex ['!':rest] = (Right ExclamationToken, rest)
lex [x:xs]
| isSpace x = lex xs
| isDigit x
	# (is, rest) = span isDigit xs
	= (Right (NumberToken [x:is]), rest)
| isAlpha x
	# (is, rest) = span (\c.isAlphanum c || c == '_') xs
	= (Right (IdentToken [x:is]), rest)
| otherwise = (Left ("Unexpected character: " +++ toString x), [])