X-Git-Url: https://git.martlubbers.net/?a=blobdiff_plain;f=lex.icl;h=aa34987969b5afcdc71c83451f91fe448ee9902f;hb=d0e8cca079e8b36453b3eeee66b25681e5423f18;hp=29d3c17809e37d0a196b213e7a24e3e6dbb1307e;hpb=375d52815b5818c2eb7558b3df56759577fe695e;p=cc1516.git

diff --git a/lex.icl b/lex.icl
index 29d3c17..aa34987 100644
--- a/lex.icl
+++ b/lex.icl
@@ -1,41 +1,39 @@
 implementation module lex
 
 import Control.Monad, Control.Applicative
-import Data.Either, Data.Func, Data.Maybe, Data.Functor
-from StdFunc import o, const
+import Data.Either, Data.Func, Data.Void
+from StdFunc import o
 import StdBool
 import StdList
 import StdChar
 import StdString
-
-from Text import class Text(textSize,concat), instance Text String
+import StdTuple
 
 import yard
+import AST
+
+:: LexItem
+	= LexToken Int TokenValue
+	| LexSpace Int Int
+	| LexNL
+	| LexEOF
+	| LexItemError String
 
 lexer :: [Char] -> LexerOutput
-lexer r = case runParser (lexProgram 1 1) r of
-	(Right p, _) = Right p
-	(Left e, _) = Left e
+lexer r = fst $ runParser (lexProgram 1 1) r
 
 lexProgram :: Int Int -> Parser Char [Token]
 lexProgram line column = lexToken >>= \t->case t of
-		LexEOF = pure []
-		(LexItemError e) = fail <?> 
-			PositionalError line column ("LexerError: " +++ e)
-		(LexToken c t) = lexProgram line (column+c)
-			>>= \rest->pure [{line=line, column=column, token=t}:rest]
-		LexNL = lexProgram (line+1) 1
-		(LexSpace l c) = lexProgram (line+l) (column+c)
-
-:: LexItem 
-	= LexToken Int TokenValue
-	| LexSpace Int Int
-	| LexNL 
-	| LexEOF 
-	| LexItemError String
+	LexEOF = pure []
+	LexNL = lexProgram (line+1) 1
+	(LexSpace l c) = lexProgram (line+l) (column+c)
+	(LexItemError e) = fail <?>
+		PositionalError line column ("LexerError: " +++ e)
+	(LexToken c t) = lexProgram line (column+c)
+		>>= \rest->pure [({line=line,col=column}, t):rest]
 
 lexToken :: Parser Char LexItem
-lexToken = 
+lexToken =
 	//Comments
 	lexBlockComment <|> lexComment <|>
 	//Keyword tokens
@@ -52,38 +50,38 @@ lexToken =
 	lexWord "<=" LesserEqToken <|> lexWord ">=" GreaterEqToken <|>
 	lexWord "==" EqualsToken <|> lexWord "&&" AmpersandsToken <|>
 	lexWord "||" PipesToken <|> lexWord "[]" EmptyListToken <|>
-	lexWord "->" ArrowToken <|> 
+	lexWord "->" ArrowToken <|>
 	//One char ops tokens
-    lexWord "(" BraceOpenToken <|>
-	lexWord ")" BraceCloseToken <|> lexWord "{" CBraceOpenToken <|>
-	lexWord "}" CBraceCloseToken <|> lexWord "[" SquareOpenToken <|>
-	lexWord "]" SquareCloseToken <|> lexWord "," CommaToken <|>
-	lexWord ":" ColonToken <|> lexWord ";" SColonToken <|>
-	lexWord "." DotToken <|> lexWord "+" PlusToken <|>
-	lexWord "*" StarToken <|> lexWord "/" SlashToken <|>
-	lexWord "%" PercentToken <|> lexWord "=" AssignmentToken <|>
-	lexWord "<" LesserToken <|> lexWord ">" BiggerToken <|>
-	lexWord "!" ExclamationToken <|> lexWord "-" DashToken <|>
+    lexWord "(" BraceOpenToken <|> lexWord ")" BraceCloseToken <|>
+	lexWord "{" CBraceOpenToken <|> lexWord "}" CBraceCloseToken <|>
+	lexWord "[" SquareOpenToken <|> lexWord "]" SquareCloseToken <|>
+	lexWord "," CommaToken <|> lexWord ":" ColonToken <|>
+	lexWord ";" SColonToken <|> lexWord "." DotToken <|>
+	lexWord "+" PlusToken <|> lexWord "*" StarToken <|>
+	lexWord "/" SlashToken <|> lexWord "%" PercentToken <|>
+	lexWord "=" AssignmentToken <|> lexWord "<" LesserToken <|>
+	lexWord ">" BiggerToken <|> lexWord "!" ExclamationToken <|>
+	lexWord "-" DashToken <|>
 	//Number and identifier tokens
 	lexNumber <|> lexIdentifier <|>
 	(item '\n' >>| pure LexNL) <|>
+	//Whitespace
 	(satisfy isSpace >>| (pure $ LexSpace 0 1)) <|>
 	(eof >>| pure LexEOF)
 	where
 		lexWord :: String TokenValue -> Parser Char LexItem
-		lexWord s tv = list (fromString s) >>| pure (LexToken (textSize s) tv)
+		lexWord s tv = list ls >>| pure (LexToken (length ls) tv)
+			where ls = fromString s
 
 		lexKw :: String TokenValue -> Parser Char LexItem
 		lexKw kw tv = lexWord kw tv <* check (not o isIdentChar)
 
-		lexUntilNL = top until (eof <|> (item '\n' >>| pure Void))
-
 		lexComment :: Parser Char LexItem
-		lexComment = list (fromString "//") >>| lexUntilNL 
-			>>| pure LexNL
+		lexComment = list (fromString "//") 
+			>>| top until (eof <|> (item '\n' >>| pure Void)) >>| pure LexNL
 
 		lexBlockComment :: Parser Char LexItem
-		lexBlockComment = list (fromString "/*") 
+		lexBlockComment = list (fromString "/*")
 			>>| (top until (list (fromString "*/")))
 			>>= \chars->pure $ widthHeight chars 0 0
 			where
@@ -93,12 +91,12 @@ lexToken =
 				widthHeight [x:xs] l c = widthHeight xs l (c+1)
 
 		lexNumber :: Parser Char LexItem
-		lexNumber = toString <$> some (satisfy isDigit) 
-			>>= \si->pure $ LexToken (textSize si) (NumberToken $ toInt si)
+		lexNumber = some (satisfy isDigit) >>= \si->pure $
+			LexToken (length si) (NumberToken $ toInt $ toString si)
 
 		lexIdentifier :: Parser Char LexItem
-		lexIdentifier = toString <$> some (satisfy isIdentChar)
-			>>= \si->pure $ LexToken (textSize si) (IdentToken si)
+		lexIdentifier = some (satisfy isIdentChar)
+			>>= \si->pure $ LexToken (length si) (IdentToken $ toString si)
 
 		isIdentChar c = isAlphanum c || c == '_'