From 08006084797e212a453d12a05ee99f0ffeafb183 Mon Sep 17 00:00:00 2001
From: darkf <lw9k123@gmail.com>
Date: Wed, 23 Oct 2013 15:05:47 -0700
Subject: [PATCH] add boolean comparison and equality operators

---
 ast.hs    |  4 ++++
 interp.hs | 14 ++++++++++++++
 parser.hs |  7 ++++++-
 3 files changed, 24 insertions(+), 1 deletion(-)

diff --git a/ast.hs b/ast.hs
index 573cfb6..cfcd146 100644
--- a/ast.hs
+++ b/ast.hs
@@ -8,6 +8,10 @@ data AST = Add AST AST
 		 | Sub AST AST
 		 | Mul AST AST
 		 | Div AST AST
+		 | Equals AST AST
+		 | NotEquals AST AST
+		 | LessThan AST AST
+		 | GreaterThan AST AST
 		 | Block [AST]
 		 | FunDef String (Pattern, AST)
 		 | Defun String AST
diff --git a/interp.hs b/interp.hs
index 988c8f6..562f5a1 100644
--- a/interp.hs
+++ b/interp.hs
@@ -70,6 +70,15 @@ l *$ r = error $ "cannot * " ++ show l ++ " and " ++ show r
 (IntV l) /$ (IntV r) = IntV (l `div` r)
 l /$ r = error $ "cannot / " ++ show l ++ " and " ++ show r
 
+(IntV l) <$ (IntV r) = BoolV (l < r)
+l <$ r = error $ "cannot < " ++ show l ++ " and " ++ show r
+
+(IntV l) >$ (IntV r) = BoolV (l > r)
+l >$ r = error $ "cannot > " ++ show l ++ " and " ++ show r
+
+l ==$ r = BoolV (l == r)
+l !=$ r = BoolV (l /= r)
+
 _putstr (StrV str) = do
 	(handles,_) <- get
 	let stdout_s = head handles
@@ -159,6 +168,11 @@ eval (Sub l r) = do { l <- eval l; r <- eval r; return $ l -$ r }
 eval (Mul l r) = do { l <- eval l; r <- eval r; return $ l *$ r }
 eval (Div l r) = do { l <- eval l; r <- eval r; return $ l /$ r }
 
+eval (Equals l r) = do { l <- eval l; r <- eval r; return $ l ==$ r }
+eval (NotEquals l r) = do { l <- eval l; r <- eval r; return $ l !=$ r }
+eval (LessThan l r) = do { l <- eval l; r <- eval r; return $ l <$ r }
+eval (GreaterThan l r) = do { l <- eval l; r <- eval r; return $ l >$ r }
+
 eval (Call name arg) = get >>= \(h,env) ->
 	case lookup env name of
 	  Just fn@(FnV cls _) -> do
diff --git a/parser.hs b/parser.hs
index 6a9345b..f19b0e4 100644
--- a/parser.hs
+++ b/parser.hs
@@ -18,7 +18,7 @@ languageDef = emptyDef {T.commentStart="{-",
 						  T.identStart = letter <|> char '_',
 						  T.identLetter = alphaNum <|> char '_',
 						  T.reservedNames = ["do", "end"],
-						  T.reservedOpNames = ["+", "-", "*", "/"]}
+						  T.reservedOpNames = ["+", "-", "*", "/", "==", "!=", "<", ">"]}
 
 lexer = T.makeTokenParser languageDef
 exprparser = buildExpressionParser ops term <?> "expression"
@@ -26,6 +26,11 @@ ops = [ [Infix (reservedOp "*" >> return Mul) AssocLeft]
 	  , [Infix (reservedOp "/" >> return Div) AssocLeft]
 	  , [Infix (reservedOp "+" >> return Add) AssocLeft]
 	  , [Infix (reservedOp "-" >> return Sub) AssocLeft]
+
+	  , [Infix (reservedOp "==" >> return Equals) AssocLeft]
+	  , [Infix (reservedOp "!=" >> return NotEquals) AssocLeft]
+	  , [Infix (reservedOp "<" >> return LessThan) AssocLeft]
+	  , [Infix (reservedOp ">" >> return GreaterThan) AssocLeft]
 	  ]
 
 identifier = T.identifier lexer