Add +, -, *, /, %, ~

1 files changed, 39 insertions, 6 deletions

diff --git a/Sil/Parse.icl b/Sil/Parse.icl
index 925423c..ec25c1f 100644
--- a/Sil/Parse.icl
+++ b/Sil/Parse.icl
@@ -36,6 +36,12 @@ where
 	toString TComma           = ","
 	toString TSemicolon       = ";"
 	toString TAssign          = ":="
+	toString TTilde           = "~"
+	toString TPlus            = "+"
+	toString TMinus           = "-"
+	toString TStar            = "*"
+	toString TSlash           = "/"
+	toString TPercent         = "%"
 	toString (TLit l)         = toString l
 	toString TIf              = "if"
 	toString TWhile           = "while"
@@ -67,6 +73,12 @@ where
 	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 [TAssign    :t]
 	tks ['i':'f'                :s:r] t | isSpace s = tks r [TIf    :t]
 	tks ['w':'h':'i':'l':'e'    :s:r] t | isSpace s = tks r [TWhile :t]
@@ -131,12 +143,6 @@ where
 	declaration :: Parser Token Statement
 	declaration = liftM2 Declaration name (item TAssign *> application)
 
-	application :: Parser Token Application
-	application
-		=   liftM2 App name (item TParenOpen *> seplist TComma application <* item TParenClose)
-		<|> liftM Literal literal
-		<|> liftM Name name
-
 	return :: Parser Token Statement
 	return = liftM Return (item TReturn *> optional application)
 
@@ -144,6 +150,33 @@ where
 	machinecode = (\(TMachineCode s) -> MachineStm s) <$> satisfy isMachineCode
 	where isMachineCode (TMachineCode _) = True; isMachineCode _ = False
 
+application :: Parser Token Application
+application
+	= leftAssoc
+		(   op TPlus    Add
+		<|> op TMinus   Sub
+		)
+	$ leftAssoc
+		(   op TStar    Mul
+		<|> op TSlash   Div
+		<|> op TPercent Rem
+		)
+	$ noInfix
+where
+	op :: Token Op2 -> Parser Token Op2
+	op token operator = item token *> pure operator
+
+	leftAssoc :: (Parser Token Op2) (Parser Token Application) -> Parser Token Application
+	leftAssoc opp appp = appp >>= \e1 -> many (opp >>= \op -> appp >>= \e -> pure (op,e))
+		>>= foldM (\e (op,e2) -> pure $ BuiltinApp2 e op e2) e1
+
+	noInfix :: Parser Token Application
+	noInfix
+		=   liftM2 App name (item TParenOpen *> seplist TComma application <* item TParenClose)
+		<|> liftM (BuiltinApp Neg) (item TTilde *> noInfix)
+		<|> liftM Literal literal
+		<|> liftM Name name
+
 name :: Parser Token Name
 name = liftM (\(TName s) -> s) $ satisfy isName <?> Expected "name"
 where