Add comparisons; tak example

1 files changed, 17 insertions, 5 deletions

diff --git a/Sjit/Syntax.icl b/Sjit/Syntax.icl
index 90aeb39..e382696 100644
--- a/Sjit/Syntax.icl
+++ b/Sjit/Syntax.icl
@@ -5,9 +5,12 @@ import StdEnv
 import Control.Applicative
 import Control.Monad
 import Data.Either
+from Data.Foldable import class Foldable(foldr1)
 from Data.Func import $
 import Data.Functor
 import Data.GenEq
+from Data.List import instance Foldable []
+import Data.Maybe
 import Text.Parsers.Simple.Core
 
 :: Token
@@ -60,13 +63,15 @@ where
 
 		n | isFunnyIdent n
 			# (i,n) = readIdent isFunnyIdent [] i e s
-			-> lex [TIdent n:tks] i e s
+			# tk = case n of
+				"=" -> TEq
+				n   -> TIdent n
+			-> lex [tk:tks] i e s
 
 		n | isDigit n
 			# (i,n) = readInt [] i e s
 			-> lex [TInt n:tks] i e s
 
-		'=' -> lex [TEq:        tks] (i+1) e s
 		',' -> lex [TComma:     tks] (i+1) e s
 		'(' -> lex [TParenOpen: tks] (i+1) e s
 		')' -> lex [TParenClose:tks] (i+1) e s
@@ -77,7 +82,7 @@ where
 	isIdent c = isAlpha c || c == '_'
 
 	isFunnyIdent :: !Char -> Bool
-	isFunnyIdent c = isMember c ['+-*/']
+	isFunnyIdent c = isMember c ['+-*/<>=']
 
 	readIdent :: !(Char -> Bool) ![Char] !Int !Int !String -> (!Int, !String)
 	readIdent ok cs i e s
@@ -102,12 +107,19 @@ where
 
 expr :: Parser Token Expr
 expr
-	= leftAssoc (tok "+" <|> tok "-")
-	$ leftAssoc (tok "*" <|> tok "/")
+	= rightAssoc (toks ["==","<>","<","<=",">",">="])
+	$ leftAssoc (toks ["+","-"])
+	$ leftAssoc (toks ["*","/"])
 	$ noInfix
 where
 	tok :: !String -> Parser Token String
 	tok s = pToken (TIdent s) $> s
+	toks = foldr1 (<|>) o map tok
+
+	rightAssoc :: !(Parser Token String) !(Parser Token Expr) -> Parser Token Expr
+	rightAssoc opp exprp = exprp >>= \e1 ->
+		optional (opp >>= \op -> rightAssoc opp exprp >>= \e -> pure (op,e)) >>=
+		pure o maybe e1 (\(op,e2) -> App op [e1,e2])
 
 	leftAssoc :: !(Parser Token String) !(Parser Token Expr) -> Parser Token Expr
 	leftAssoc opp exprp = exprp >>= \e1 ->