Add tuples (see #1)

1 files changed, 26 insertions, 8 deletions

diff --git a/Sil/Parse.icl b/Sil/Parse.icl
index b5e0114..4fdc479 100644
--- a/Sil/Parse.icl
+++ b/Sil/Parse.icl
@@ -36,6 +36,7 @@ where
 	toString TBraceClose      = "}"
 	toString TComma           = ","
 	toString TSemicolon       = ";"
+	toString (TField f)       = "." +++ f
 	toString TAssign          = ":="
 	toString TTilde           = "~"
 	toString TPlus            = "+"
@@ -74,6 +75,8 @@ where
 		skipUntilEndOfComment []          = []
 		skipUntilEndOfComment ['*':'/':r] = r
 		skipUntilEndOfComment [_:r]       = skipUntilEndOfComment r
+	tks ['.':r=:[c:_]] t | isNameChar c = tks r` [TField $ toString f:t]
+	where (f,r`) = span isNameChar r
 	tks [':':'=':r] t = tks r [TAssign         :t]
 	tks ['=':'=':r] t = tks r [TDoubleEquals   :t]
 	tks ['|':'|':r] t = tks r [TDoubleBar      :t]
@@ -109,7 +112,7 @@ where
 		(num,numrest)   = span isDigit cs
 
 	isNameChar :: Char -> Bool
-	isNameChar c = isAlpha c || isMember c ['_\'']
+	isNameChar c = isAlphanum c || isMember c ['_\'']
 
 	isNotNameChar = not o isNameChar
 
@@ -221,13 +224,20 @@ where
 		=   liftM2 App name (item TParenOpen *> seplist TComma expression <* item TParenClose)
 		<|> op TTilde       Neg
 		<|> op TExclamation Not
-		<|> liftM Literal literal
-		<|> liftM Name name
-		<|> parenthised expression
+		<|> (simpleExpr >>= \e -> many field >>= \fs -> pure $ foldr Field e fs)
 	where
 		op :: Token Op1 -> Parser Token Expression
 		op token operator = liftM (BuiltinApp operator) (item token *> noInfix)
 
+		field :: Parser Token Name
+		field = satisfy (\t -> t =: TField _) >>= \(TField f) -> pure f
+
+	simpleExpr :: Parser Token Expression
+	simpleExpr = liftM Literal literal
+		<|> liftM Name name
+		<|> (parenthised (min2seplist TComma expression) >>= \es -> pure $ Tuple (length es) es)
+		<|> parenthised expression
+
 name :: Parser Token Name
 name = liftM (\(TName s) -> s) $ satisfy isName <?> Expected "name"
 where
@@ -240,12 +250,13 @@ arg = (type >>= \type -> name >>= \name -> pure {arg_type=type, arg_name=name})
 
 type :: Parser Token Type
 type
-	=   type "Bool" TBool
-	<|> type "Int"  TInt
-	<|> type "Void" TVoid
+	=   simpletype "Bool" TBool
+	<|> simpletype "Int"  TInt
+	<|> simpletype "Void" TVoid
+	<|> (parenthised (min2seplist TComma type) >>= \ts -> pure $ TTuple (length ts) ts)
 	<?> Expected "type"
 where
-	type s t = item (TName s) $> t
+	simpletype s t = item (TName s) $> t
 
 literal :: Parser Token Literal
 literal = satisfy isLit >>= \(TLit lit) -> pure lit
@@ -259,3 +270,10 @@ parenthised p = item TParenOpen *> p <* item TParenClose
 
 braced :: (Parser Token a) -> Parser Token a
 braced p = item TBraceOpen *> p <* item TBraceClose
+
+min2seplist :: a (Parser a b) -> Parser a [b] | ==, name a
+min2seplist sep val =
+	val >>= \v1 ->
+	item sep *>
+	seplist sep val >>= \vs ->
+	pure [v1:vs]