From c5c4788b282a371fdc989e2d13430701f3457441 Mon Sep 17 00:00:00 2001
From: Camil Staps
Date: Sun, 30 Jul 2017 11:35:16 +0200
Subject: Better errors

---
 Sil/Parse.icl | 47 ++++++++++++++++++++++-------------------------
 1 file changed, 22 insertions(+), 25 deletions(-)

(limited to 'Sil/Parse.icl')

diff --git a/Sil/Parse.icl b/Sil/Parse.icl
index 6a3999d..2c8272d 100644
--- a/Sil/Parse.icl
+++ b/Sil/Parse.icl
@@ -141,17 +141,17 @@ parse = fst o runParser program o makeParseState
 program :: Parser Token Program
 program =
 	many initialisation >>= \globss ->
-	some function >>= \fs ->
-	eof $>
-	{p_globals=flatten globss, p_funs=fs}
+	function until eof >>= \fs ->
+	pure {p_globals=flatten globss, p_funs=reverse fs}
 
 function :: Parser Token Function
 function =
 	type >>= \t ->
 	getPosition >>= \pos ->
 	name >>= \n ->
-	parenthised (seplist TComma arg) >>= \args ->
-	braced codeblock >>= \cb -> pure
+	item TParenOpen *>
+	seplistUntil TParenClose TComma arg >>= \args ->
+	codeblock >>= \cb -> pure
 		{ f_type = t
 		, f_name = n
 		, f_args = args
@@ -160,8 +160,10 @@ function =
 		}
 
 codeblock :: Parser Token CodeBlock
-codeblock = many initialisation >>= \is ->
-	many statement >>= \s ->
+codeblock =
+	item TBraceOpen *>
+	many initialisation >>= \is ->
+	statement until (item TBraceClose) >>= \s ->
 	pure {cb_init=flatten is, cb_content=s}
 
 initialisation :: Parser Token [Initialisation]
@@ -182,7 +184,7 @@ statement =
 	<|> if` pos
 	<|> while pos
 	<|> machinecode pos
-	)
+	) <#> "statement"
 where
 	declaration :: ParsePosition -> Parser Token Statement
 	declaration p = liftM2 (Declaration p) name (item TAssign *> expression <* item TSemicolon)
@@ -197,20 +199,20 @@ where
 	if` :: ParsePosition -> Parser Token Statement
 	if` p = item TIf *>
 		parenthised expression >>= \cond ->
-		braced codeblock >>= \iftrue ->
+		codeblock >>= \iftrue ->
 		many elseif >>= \elseifs ->
-		optional (item TElse *> braced codeblock) >>= \iffalse ->
+		optional (item TElse *> codeblock) >>= \iffalse ->
 		pure $ If p [(cond,iftrue):elseifs] iffalse
 	where
 		elseif = list [TElse, TIf] *>
 			parenthised expression >>= \cond ->
-			braced codeblock >>= \block ->
+			codeblock >>= \block ->
 			pure (cond, block)
 
 	while :: ParsePosition -> Parser Token Statement
 	while p = item TWhile *>
 		parenthised expression >>= \cond ->
-		braced codeblock >>= \do ->
+		codeblock >>= \do ->
 		pure $ While p cond do
 
 expression :: Parser Token Expression
@@ -244,7 +246,7 @@ where
 
 	noInfix :: Parser Token Expression
 	noInfix
-		=   liftM2 App name (item TParenOpen *> seplist TComma expression <* item TParenClose)
+		=   liftM2 App name (item TParenOpen *> seplistUntil TParenClose TComma expression)
 		<|> op TTilde       Neg
 		<|> op TExclamation Not
 		<|> (simpleExpr >>= \e -> foldl (flip Field) e <$> many field)
@@ -258,29 +260,27 @@ where
 	simpleExpr :: Parser Token Expression
 	simpleExpr = liftM Literal literal
 		<|> liftM Name name
-		<|> (parenthised (min2seplist TComma expression) >>= \es -> pure $ Tuple (length es) es)
 		<|> flip List [] o pure <$> bracked type
 		<|> List Nothing <$> bracked (seplist TComma expression)
-		<|> parenthised expression
+		<|> (item TParenOpen *> seplistUntil TParenClose TComma expression >>= \es -> pure $ case es of [x] -> x; _ -> Tuple (length es) es)
 
 name :: Parser Token Name
-name = liftM (\(TName s) -> s) $ satisfy isName <?> P_Expected "name"
+name = (\(TName n) -> n) <$> satisfy isName <#> "name"
 where
 	isName (TName _) = True
 	isName _         = False
 
 arg :: Parser Token Arg
-arg = (type >>= \type -> name >>= \name -> pure {arg_type=type, arg_name=name})
-	<?> P_Expected "argument"
+arg = (type >>= \type -> name >>= \name -> pure {arg_type=type, arg_name=name}) <#> "argument"
 
 type :: Parser Token Type
 type
 	=   simpletype "Bool" TBool
 	<|> simpletype "Int"  TInt
 	<|> simpletype "Void" TVoid
-	<|> (parenthised (min2seplist TComma type) >>= \ts -> pure $ TTuple (length ts) ts)
+	<|> (parenthised (min1seplist TComma type) >>= \ts -> pure $ TTuple (length ts) ts)
 	<|> TList <$> bracked type
-	<?> P_Expected "type"
+	<#> "type"
 where
 	simpletype s t = item (TName s) $> t
 
@@ -297,11 +297,8 @@ parenthised p = item TParenOpen *> p <* item TParenClose
 bracked :: (Parser Token a) -> Parser Token a
 bracked p = item TBrackOpen *> p <* item TBrackClose
 
-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 =
+min1seplist :: a (Parser a b) -> Parser a [b] | ==, name, toString a
+min1seplist sep val =
 	val >>= \v1 ->
 	item sep *>
 	seplist sep val >>= \vs ->
-- 
cgit v1.2.3