module Lex where

data Token =
	  TokenZero
	| TokenNum Int
	| TokenVar String
	| TokenLam
	| TokenCol
	| TokenSemicol
	| TokenDot
	| TokenCBOpen
	| TokenCBClose
	| TokenPAROpen
	| TokenPARClose
	| TokenFix
	| TokenCom
	| TokenPrime
	| TokenPlus
	| TokenProj
	| TokenInj
	| TokenCase
	| TokenOf
	| TokenIf
	| TokenEqual
	| TokenLess
	| TokenElse
	| TokenInx
	| TokenCasx
	| TokenNat
	| TokenArrow
	| TokenAnd
	| TokenOr
	| TokenUnivQ
	| TokenExistQ
     deriving Show

lex1 :: String -> [Token]

lex1 "" = []
lex1 (' ':s) = lex1 s
lex1 ('\n':s) = lex1 s
lex1 ('\t':s) = lex1 s
lex1 ('\\':s) = TokenLam : lex1 s
lex1 (':':s) = TokenCol : lex1 s
lex1 (';':s) = TokenSemicol : lex1 s
lex1 ('.':s) = TokenDot : lex1 s
lex1 (',':s) = TokenCom : lex1 s
lex1 ('\'':s) = TokenPrime : lex1 s
lex1 ('+':s) = TokenPlus : lex1 s
lex1 ('{':s) = TokenCBOpen : lex1 s
lex1 ('}':s) = TokenCBClose : lex1 s
lex1 ('(':s) = TokenPAROpen : lex1 s
lex1 (')':s) = TokenPARClose : lex1 s
lex1 ('=':s) = TokenEqual : lex1 s
lex1 ('<':s) = TokenLess : lex1 s
lex1 ('&':s) = TokenAnd : lex1 s
lex1 ('|':s) = TokenOr : lex1 s

lex1 ('#':s) = if (head s == '0') then TokenZero : lex1 (tail s)
		else TokenNat : lex1 s
lex1 ('!':s) = TokenUnivQ : lex1 s
lex1 ('?':s) = TokenExistQ : lex1 s

lex1 ('-':s) = if (head s)=='>' then (TokenArrow : lex1 (tail s))
               else error "- alone!"

lex1 (c:s) = if (isAlpha c) then (lexWord (c:s)) else
             if (isDigit c) then lexNum (c:s)
             else error ('`':c:"` illegal symbol in input!")

lexNum :: String -> [Token]
lexNum s = TokenNum (read num) : lex1 rest
           where (num, rest) = span isDigit s

lexWord :: String -> [Token]
lexWord s = case (span (\c -> (isDigit c) || (isAlpha c)) s) of
		("fix", rest) -> TokenFix : lex1 rest
		("if",  rest) -> TokenIf : lex1 rest
		("else",rest) -> TokenElse : lex1 rest
		("proj",rest) -> TokenProj : lex1 rest
		("inj", rest) -> TokenInj : lex1 rest
		("case",rest) -> TokenCase : lex1 rest
		("inx", rest) -> TokenInx : lex1 rest
		("casx",rest) -> TokenCasx : lex1 rest
		("of",  rest) -> TokenOf : lex1 rest
		( name, rest) -> TokenVar (name) : lex1 rest