summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--calculator.hs77
1 files changed, 74 insertions, 3 deletions
diff --git a/calculator.hs b/calculator.hs
index 795cdf2..6a81adf 100644
--- a/calculator.hs
+++ b/calculator.hs
@@ -16,8 +16,17 @@ data Expression = Constant Double
| Modulus Expression Expression
| Negation Expression
| FunctionInvocation String Expression
+ | Conditional Condition Expression Expression
deriving (Show)
+data Condition = And Condition Condition
+ | Or Condition Condition
+ | Not Condition
+ | Equal Expression Expression
+ | LessThan Expression Expression
+ | LessThanEqual Expression Expression
+ deriving (Show)
+
data FunctionBody = FunctionBody String Expression
deriving (Show)
@@ -27,9 +36,10 @@ data Statement = PrintStatement Expression
deriving (Show)
lexer :: TokenParser ()
-lexer = makeTokenParser (javaStyle { opStart = oneOf "+-*/%|&=!<>"
- , opLetter = oneOf "+-*/%|&=!<>"
- , reservedNames = ["let", "def", "print"]})
+lexer = makeTokenParser (javaStyle { opStart = oneOf "+-*/%|&=!<>¬"
+ , opLetter = oneOf "+-*/%|&=!<>¬"
+ , reservedNames = ["let", "def", "print"
+ ,"if", "then", "else"]})
parseNumber :: Parser Expression
parseNumber = do
@@ -55,11 +65,46 @@ parseFunctionInvocation = do
expr <- parens lexer parseExpression
return $ FunctionInvocation ident expr
+parseConditional :: Parser Expression
+parseConditional = do
+ reserved lexer "if"
+ c <- parseCondition
+ reserved lexer "then"
+ e1 <- parseExpression
+ reserved lexer "else"
+ e2 <- parseExpression
+ return $ Conditional c e1 e2
+
+parseCondition :: Parser Condition
+parseCondition = (flip buildExpressionParser) parseConditionalTerm $ [
+ [ Prefix (reservedOp lexer "¬" >> return Not) ]
+ , [ Infix (reservedOp lexer "&&" >> return And) AssocLeft
+ , Infix (reservedOp lexer "||" >> return Or) AssocLeft ]
+ ]
+
+parseConditionalTerm :: Parser Condition
+parseConditionalTerm =
+ parens lexer parseCondition
+ <|> parseComparison
+
+parseComparison :: Parser Condition
+parseComparison = do
+ e1 <- parseExpression
+ f <- (reserved lexer "==" >> return (Equal e1))
+ <|> (reserved lexer "<" >> return (LessThan e1))
+ <|> (reserved lexer "<=" >> return (LessThanEqual e1))
+ <|> (reserved lexer ">" >> return (Not . (LessThanEqual e1)))
+ <|> (reserved lexer ">=" >> return (Not . (LessThan e1)))
+ <|> (reserved lexer "!=" >> return (Not . (Equal e1)))
+ e2 <- parseExpression
+ return $ f e2
+
parseTerm :: Parser Expression
parseTerm =
parens lexer parseExpression
<|> parseNumber
<|> try parseFunctionInvocation
+ <|> try parseConditional
<|> (identifier lexer >>= return . Identifier)
parsePrint :: Parser Statement
@@ -99,6 +144,29 @@ type StoredVal = Either Double FunctionBody
type CannotFailCalculator = StateT (M.Map String StoredVal) IO
type Calculator a = ErrorT String CannotFailCalculator a
+interpretCondition :: Condition -> Calculator Bool
+interpretCondition (Not c) = interpretCondition c >>= return . not
+interpretCondition (And c1 c2) = do
+ b1 <- interpretCondition c1
+ b2 <- interpretCondition c2
+ return (b1 && b2)
+interpretCondition (Or c1 c2) = do
+ b1 <- interpretCondition c1
+ b2 <- interpretCondition c2
+ return (b1 || b2)
+interpretCondition (Equal e1 e2) = do
+ v1 <- interpretExpression e1
+ v2 <- interpretExpression e2
+ return (v1 == v2)
+interpretCondition (LessThan e1 e2) = do
+ v1 <- interpretExpression e1
+ v2 <- interpretExpression e2
+ return (v1 < v2)
+interpretCondition (LessThanEqual e1 e2) = do
+ v1 <- interpretExpression e1
+ v2 <- interpretExpression e2
+ return (v1 <= v2)
+
interpretExpression :: Expression -> Calculator Double
interpretExpression (Constant n) = return n
interpretExpression (Identifier i) = do
@@ -145,6 +213,9 @@ interpretExpression (FunctionInvocation fn e) = do
r <- interpretExpression expr
put ctx
return r
+interpretExpression (Conditional cond e1 e2) = do
+ b <- interpretCondition cond
+ if b then interpretExpression e1 else interpretExpression e2
interpretStatement :: Statement -> Calculator ()
interpretStatement (PrintStatement expr) = do