Add automated tests

1 files changed, 26 insertions, 9 deletions

diff --git a/snug-clean/src/Snug/Parse.icl b/snug-clean/src/Snug/Parse.icl
index 9d58f23..4347c34 100644
--- a/snug-clean/src/Snug/Parse.icl
+++ b/snug-clean/src/Snug/Parse.icl
@@ -43,6 +43,11 @@ where
 			(simpleList (parenthesized typedArgument))
 			(pToken TColon *> type)
 			(pToken TColon *> expression)
+		<<|> liftM4 TestDef
+			(pToken (TIdent "test") *> string)
+			(pToken TColon *> type)
+			(pToken TColon *> simpleOrParenthesizedExpression)
+			string
 
 	simpleConstructorDef = liftM2 ConstructorDef constructorIdent (pure [])
 	constructorDef = liftM2 ConstructorDef constructorIdent (many simpleOrParenthesizedType)
@@ -101,6 +106,9 @@ basicValue
 	= (\(TInt i) -> BVInt i) <$> pSatisfy (\t -> t=:(TInt _))
 	<<|> (\(TChar c) -> BVChar c) <$> pSatisfy (\t -> t=:(TChar _))
 
+string :: Parser Token String
+string = (\(TString s) -> s) <$> pSatisfy (\t -> t=:(TString _))
+
 typeIdent :: Parser Token TypeIdent
 typeIdent = fromIdent <$> pSatisfy isUpperCaseIdent
 
@@ -152,6 +160,7 @@ nonEmpty p = p >>= \xs -> if (isEmpty xs) pFail (pure xs)
 	| TIdent !String
 	| TInt !Int
 	| TChar !Char
+	| TString !String
 
 	| TComment !String //* (# ... #)
 	| TError !Int !Int !String
@@ -169,6 +178,8 @@ where
 	(==) (TInt _) _ = False
 	(==) (TChar x) (TChar y) = x == y
 	(==) (TChar _) _ = False
+	(==) (TString x) (TString y) = x == y
+	(==) (TString _) _ = False
 	(==) (TComment x) (TComment y) = x == y
 	(==) (TComment _) _ = False
 	(==) (TError _ _ _) _ = False
@@ -238,15 +249,6 @@ lex` line col [c:cs]
 	| isSpace c
 		= lex` line (col+1) cs
 
-/* Identifiers*/
-lex` line col cs=:[c:_]
-	| isAlpha c
-		# (name,cs) = span isIdentChar cs
-		= [TIdent (toString name) : lex` line (col + length name) cs]
-	| isFunnySymbol c
-		# (name,cs) = span isFunnySymbol cs
-		= [TIdent (toString name) : lex` line (col + length name) cs]
-
 /* Basic values */
 lex` line col cs=:[c:_]
 	| isDigit c
@@ -258,6 +260,21 @@ lex` line col [c:cs]
 		= [TInt (0 - toInt (toString i)) : lex` line (col + 1 + length i) cs]
 lex` line col ['\'',c,'\'':cs] // TODO: escape sequences
 	= [TChar c : lex` line (col+3) cs]
+lex` line col ['"':cs] // TODO: escape sequences; correctly compute new line/col in case of newlines
+	= [TString s : lex` line (col + 2 + size s) (tl rest)]
+where
+	(chars,rest) = span ((<>) '"') cs
+	s = {c \\ c <- chars}
+
+/* Identifiers (must come after basic values for correct lexing of negative
+ * integers) */
+lex` line col cs=:[c:_]
+	| isAlpha c
+		# (name,cs) = span isIdentChar cs
+		= [TIdent (toString name) : lex` line (col + length name) cs]
+	| isFunnySymbol c
+		# (name,cs) = span isFunnySymbol cs
+		= [TIdent (toString name) : lex` line (col + length name) cs]
 
 /* Unparseable input */
 lex` line col cs