From 324b813db8f53b1291b29d0f42495bcf1aa4022f Mon Sep 17 00:00:00 2001
From: Camil Staps
Date: Wed, 19 Jul 2017 09:22:59 +0000
Subject: Working fibonacci

---
 Sil/Parse.icl | 42 +++++++++++++++++++++++++++++++++---------
 1 file changed, 33 insertions(+), 9 deletions(-)

(limited to 'Sil/Parse.icl')

diff --git a/Sil/Parse.icl b/Sil/Parse.icl
index ec25c1f..092d3da 100644
--- a/Sil/Parse.icl
+++ b/Sil/Parse.icl
@@ -67,6 +67,10 @@ tokenise cs = reverse <$> tks cs []
 where
 	tks :: [Char] [Token] -> MaybeError ParseError [Token]
 	tks [] t = pure t
+	tks [':':'=':r] t = tks r [TAssign         :t]
+	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]
@@ -79,8 +83,8 @@ where
 	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 ['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]
 	tks ['r':'e':'t':'u':'r':'n':s:r] t | isSpace s = tks r [TReturn:t]
 	tks ['T':'r':'u':'e'        :s:r] t | isSpace s = tks r [TLit $ BLit True :t]
@@ -137,8 +141,8 @@ statement :: Parser Token Statement
 statement = ((declaration
 	<|> liftM Application application
 	<|> return
-/*	<|> if`
-	<|> while*/) <* item TSemicolon) <|> machinecode
+	<|> if`
+	/*<|> while*/) <* item TSemicolon) <|> machinecode
 where
 	declaration :: Parser Token Statement
 	declaration = liftM2 Declaration name (item TAssign *> application)
@@ -150,22 +154,36 @@ where
 	machinecode = (\(TMachineCode s) -> MachineStm s) <$> satisfy isMachineCode
 	where isMachineCode (TMachineCode _) = True; isMachineCode _ = False
 
+	if` :: Parser Token Statement
+	if` = item TIf *>
+		parenthised application >>= \cond ->
+		braced codeblock >>= \iftrue ->
+		optional (item TElse *> braced codeblock) >>= \iffalse ->
+		pure $ If cond iftrue iffalse
+
 application :: Parser Token Application
 application
-	= leftAssoc
-		(   op TPlus    Add
-		<|> op TMinus   Sub
+	= rightAssoc (op TDoubleBar       LogOr)
+	$ rightAssoc (op TDoubleAmpersand LogAnd)
+	$ rightAssoc (op TDoubleEquals    Equals)
+	$ leftAssoc
+		(         op TPlus            Add
+		<|>       op TMinus           Sub
 		)
 	$ leftAssoc
-		(   op TStar    Mul
-		<|> op TSlash   Div
-		<|> op TPercent Rem
+		(         op TStar            Mul
+		<|>       op TSlash           Div
+		<|>       op TPercent         Rem
 		)
 	$ noInfix
 where
 	op :: Token Op2 -> Parser Token Op2
 	op token operator = item token *> pure operator
 
+	rightAssoc :: (Parser Token Op2) (Parser Token Application) -> Parser Token Application
+	rightAssoc opp appp = appp >>= \e1 -> optional (opp >>= \op -> rightAssoc opp appp >>= \e -> pure (op,e))
+		>>= pure o maybe e1 (\(op,e2) -> BuiltinApp2 e1 op e2)
+
 	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
@@ -202,3 +220,9 @@ where
 	isLit :: Token -> Bool
 	isLit (TLit _) = True
 	isLit _        = False
+
+parenthised :: (Parser Token a) -> Parser Token a
+parenthised p = item TParenOpen *> p <* item TParenClose
+
+braced :: (Parser Token a) -> Parser Token a
+braced p = item TBraceOpen *> p <* item TBraceClose
-- 
cgit v1.2.3