From 407a0c8e7e14b96c2a0487cefe09cdc021f002b0 Mon Sep 17 00:00:00 2001
From: Camil Staps
Date: Wed, 19 Jul 2017 12:57:01 +0000
Subject: Add while and !, fix error in consecutive declarations

---
 Sil/Parse.icl | 40 ++++++++++++++++++++++++++--------------
 1 file changed, 26 insertions(+), 14 deletions(-)

(limited to 'Sil/Parse.icl')

diff --git a/Sil/Parse.icl b/Sil/Parse.icl
index 2ee2bc1..806ac69 100644
--- a/Sil/Parse.icl
+++ b/Sil/Parse.icl
@@ -71,18 +71,19 @@ where
 	tks ['=':'=':r] t = tks r [TDoubleEquals   :t]
 	tks ['|':'|':r] t = tks r [TDoubleBar      :t]
 	tks ['&':'&':r] t = tks r [TDoubleAmpersand:t]
-	tks ['(':r] t = tks r [TParenOpen :t]
-	tks [')':r] t = tks r [TParenClose:t]
-	tks ['{':r] t = tks r [TBraceOpen :t]
-	tks ['}':r] t = tks r [TBraceClose:t]
-	tks [',':r] t = tks r [TComma     :t]
-	tks [';':r] t = tks r [TSemicolon :t]
-	tks ['~':r] t = tks r [TTilde     :t]
-	tks ['+':r] t = tks r [TPlus      :t]
-	tks ['-':r] t = tks r [TMinus     :t]
-	tks ['*':r] t = tks r [TStar      :t]
-	tks ['/':r] t = tks r [TSlash     :t]
-	tks ['%':r] t = tks r [TPercent   :t]
+	tks ['(':r] t = tks r [TParenOpen  :t]
+	tks [')':r] t = tks r [TParenClose :t]
+	tks ['{':r] t = tks r [TBraceOpen  :t]
+	tks ['}':r] t = tks r [TBraceClose :t]
+	tks [',':r] t = tks r [TComma      :t]
+	tks [';':r] t = tks r [TSemicolon  :t]
+	tks ['!':r] t = tks r [TExclamation:t]
+	tks ['~':r] t = tks r [TTilde      :t]
+	tks ['+':r] t = tks r [TPlus       :t]
+	tks ['-':r] t = tks r [TMinus      :t]
+	tks ['*':r] t = tks r [TStar       :t]
+	tks ['/':r] t = tks r [TSlash      :t]
+	tks ['%':r] t = tks r [TPercent    :t]
 	tks ['i':'f'                :s:r] t | isSpace s = tks r [TIf    :t]
 	tks ['e':'l':'s':'e'        :s:r] t | isSpace s = tks r [TElse  :t]
 	tks ['w':'h':'i':'l':'e'    :s:r] t | isSpace s = tks r [TWhile :t]
@@ -142,7 +143,7 @@ statement = declaration
 	<|> liftM Application (expression <* item TSemicolon)
 	<|> return
 	<|> if`
-	//<|> while
+	<|> while
 	<|> machinecode
 where
 	declaration :: Parser Token Statement
@@ -168,6 +169,12 @@ where
 			braced codeblock >>= \block ->
 			pure (cond, block)
 
+	while :: Parser Token Statement
+	while = item TWhile *>
+		parenthised expression >>= \cond ->
+		braced codeblock >>= \do ->
+		pure $ While cond do
+
 expression :: Parser Token Expression
 expression
 	= rightAssoc (op TDoubleBar       LogOr)
@@ -198,9 +205,14 @@ where
 	noInfix :: Parser Token Expression
 	noInfix
 		=   liftM2 App name (item TParenOpen *> seplist TComma expression <* item TParenClose)
-		<|> liftM (BuiltinApp Neg) (item TTilde *> noInfix)
+		<|> op TTilde       Neg
+		<|> op TExclamation Not
 		<|> liftM Literal literal
 		<|> liftM Name name
+		<|> parenthised expression
+	where
+		op :: Token Op1 -> Parser Token Expression
+		op token operator = liftM (BuiltinApp operator) (item token *> noInfix)
 
 name :: Parser Token Name
 name = liftM (\(TName s) -> s) $ satisfy isName <?> Expected "name"
-- 
cgit v1.2.3