summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDaniel Silverstone <dsilvers@digital-scurf.org>2013-03-10 17:18:08 +0000
committerDaniel Silverstone <dsilvers@digital-scurf.org>2013-03-10 17:18:08 +0000
commitc2e16e868e78df03b7a35ee3bbaefcb2ba4816c1 (patch)
tree0df55288ce095395e3c6fa67acff2a3084c4f653
parent7065d160aca5f025e51fb8b567d24b08f2bbe558 (diff)
downloadcalculator-c2e16e868e78df03b7a35ee3bbaefcb2ba4816c1.tar.bz2
Basic function definition and invocation
-rw-r--r--calculator.hs57
1 files changed, 47 insertions, 10 deletions
diff --git a/calculator.hs b/calculator.hs
index 040c1d3..a59f0fb 100644
--- a/calculator.hs
+++ b/calculator.hs
@@ -14,10 +14,15 @@ data Expression = Constant Double
| Division Expression Expression
| Modulus Expression Expression
| Negation Expression
+ | FunctionInvocation String Expression
deriving (Show)
+data FunctionBody = FunctionBody String Expression
+ deriving (Show)
+
data Statement = PrintStatement Expression
| AssignmentStatement String Expression
+ | FunctionDefinition String FunctionBody
deriving (Show)
lexer :: TokenParser ()
@@ -42,10 +47,17 @@ parseExpression = (flip buildExpressionParser) parseTerm $ [
, Infix (reservedOp lexer "-" >> return Subtraction) AssocLeft ]
]
+parseFunctionInvocation :: Parser Expression
+parseFunctionInvocation = do
+ ident <- identifier lexer
+ expr <- parens lexer parseExpression
+ return $ FunctionInvocation ident expr
+
parseTerm :: Parser Expression
parseTerm =
parens lexer parseExpression
- <|> parseNumber
+ <|> parseNumber
+ <|> try parseFunctionInvocation
<|> (identifier lexer >>= return . Identifier)
parsePrint :: Parser Statement
@@ -62,16 +74,27 @@ parseAssignment = do
expr <- parseExpression
return $ AssignmentStatement ident expr
+parseFunctionDefinition :: Parser Statement
+parseFunctionDefinition = do
+ reserved lexer "def"
+ ident <- identifier lexer
+ argname <- parens lexer $ identifier lexer
+ reservedOp lexer "="
+ expr <- parseExpression
+ return $ FunctionDefinition ident (FunctionBody argname expr)
+
parseInput :: Parser Statement
parseInput = do
whiteSpace lexer
- s <- (parsePrint <|> parseAssignment)
+ s <- (parsePrint <|> parseAssignment <|> parseFunctionDefinition)
eof
return s
-- Interpreter
-
-type Calculator a = StateT (M.Map String Expression) IO a
+
+type StoredVal = Either Double FunctionBody
+
+type Calculator a = StateT (M.Map String StoredVal) IO a
interpretExpression :: Expression -> Calculator Double
interpretExpression (Constant n) = return n
@@ -79,7 +102,8 @@ interpretExpression (Identifier i) = do
varmap <- get
case M.lookup i varmap of
Nothing -> fail ("Unknown identifier: " ++ i)
- Just e -> interpretExpression e
+ Just (Left n) -> return n
+ Just (Right _) -> fail ("You must call function: " ++ i)
interpretExpression (Addition e1 e2) = do
v1 <- interpretExpression e1
@@ -107,6 +131,17 @@ interpretExpression (Modulus e1 e2) = do
interpretExpression (Negation e1) = do
v1 <- interpretExpression e1
return $ negate v1
+interpretExpression (FunctionInvocation fn e) = do
+ ctx <- get
+ case M.lookup fn ctx of
+ Nothing -> fail ("Unknown function: " ++ fn)
+ Just (Left _) -> fail ("Cannot call constant: " ++ fn)
+ Just (Right (FunctionBody argname expr)) -> do
+ n <- interpretExpression e
+ modify (M.insert argname (Left n))
+ r <- interpretExpression expr
+ modify (M.delete argname)
+ return r
interpretStatement :: Statement -> Calculator ()
interpretStatement (PrintStatement expr) = do
@@ -114,13 +149,15 @@ interpretStatement (PrintStatement expr) = do
liftIO $ print n
interpretStatement (AssignmentStatement ident expr) = do
n <- interpretExpression expr
- modify (M.insert ident (Constant n))
+ modify (M.insert ident (Left n))
+interpretStatement (FunctionDefinition fn body) = do
+ modify (M.insert fn (Right body))
-defaultVars :: M.Map String Expression
+defaultVars :: M.Map String StoredVal
defaultVars = M.fromList
- [ ("e", Constant (exp 1))
- , ("pi", Constant pi)
- , ("phi", Constant ((1 + (sqrt 5)) / 2))
+ [ ("e", Left (exp 1))
+ , ("pi", Left pi)
+ , ("phi", Left ((1 + (sqrt 5)) / 2))
]
calculate :: String -> Calculator ()