summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDaniel Silverstone <dsilvers@digital-scurf.org>2013-03-05 21:23:42 +0000
committerDaniel Silverstone <dsilvers@digital-scurf.org>2013-03-05 21:23:42 +0000
commitdf3595ddb9cebf50072fcf1c0186261c998dad15 (patch)
treec5a29363e1f42489597cf1f54239eb6af4d912a4
parentdd661f4e446e50119da5bca95e62fcd529254e39 (diff)
downloadcalculator-df3595ddb9cebf50072fcf1c0186261c998dad15.tar.bz2
Added expression and statement parse trees.
This adds expression and statement parse trees and adds a print statement. Also we introduce identifiers and define some useful mathematical constants.
-rw-r--r--calculator.hs118
1 files changed, 95 insertions, 23 deletions
diff --git a/calculator.hs b/calculator.hs
index faf3b26..2c2b5b7 100644
--- a/calculator.hs
+++ b/calculator.hs
@@ -3,49 +3,121 @@ import Text.Parsec.String
import Text.Parsec.Token
import Text.Parsec.Language
import Text.Parsec.Expr
+import Control.Monad.State
+import qualified Data.Map as M
+
+data Expression = Constant Double
+ | Identifier String
+ | Addition Expression Expression
+ | Subtraction Expression Expression
+ | Multiplication Expression Expression
+ | Division Expression Expression
+ | Modulus Expression Expression
+ | Negation Expression
+ deriving (Show)
+
+data Statement = PrintStatement Expression
+ deriving (Show)
lexer :: TokenParser ()
lexer = makeTokenParser (javaStyle { opStart = oneOf "+-*/%"
, opLetter = oneOf "+-*/%" })
-parseNumber :: Parser Double
+parseNumber :: Parser Expression
parseNumber = do
val <- naturalOrFloat lexer
case val of
- Left i -> return $ fromIntegral i
- Right n -> return $ n
-
-doubleMod :: Double -> Double -> Double
-doubleMod top bottom = fromInteger $ (floor top) `mod` (floor bottom)
+ Left i -> return $ Constant $ fromIntegral i
+ Right n -> return $ Constant $ n
-parseExpression :: Parser Double
+parseExpression :: Parser Expression
parseExpression = (flip buildExpressionParser) parseTerm $ [
- [ Prefix (reservedOp lexer "-" >> return negate)
+ [ Prefix (reservedOp lexer "-" >> return Negation)
, Prefix (reservedOp lexer "+" >> return id) ]
- , [ Infix (reservedOp lexer "*" >> return (*)) AssocLeft
- , Infix (reservedOp lexer "/" >> return (/)) AssocLeft
- , Infix (reservedOp lexer "%" >> return doubleMod) AssocLeft ]
- , [ Infix (reservedOp lexer "+" >> return (+)) AssocLeft
- , Infix (reservedOp lexer "-" >> return (-)) AssocLeft ]
+ , [ Infix (reservedOp lexer "*" >> return Multiplication) AssocLeft
+ , Infix (reservedOp lexer "/" >> return Division) AssocLeft
+ , Infix (reservedOp lexer "%" >> return Modulus) AssocLeft ]
+ , [ Infix (reservedOp lexer "+" >> return Addition) AssocLeft
+ , Infix (reservedOp lexer "-" >> return Subtraction) AssocLeft ]
]
-parseTerm :: Parser Double
-parseTerm = parens lexer parseExpression <|> parseNumber
+parseTerm :: Parser Expression
+parseTerm =
+ parens lexer parseExpression
+ <|> parseNumber
+ <|> (identifier lexer >>= return . Identifier)
-parseInput :: Parser Double
+parsePrint :: Parser Statement
+parsePrint = do
+ reserved lexer "print"
+ expr <- parseExpression
+ return $ PrintStatement expr
+
+parseInput :: Parser Statement
parseInput = do
- whiteSpace lexer
- n <- parseExpression
+ whiteSpace lexer
+ s <- parsePrint
eof
- return n
+ return s
+
+-- Interpreter
+
+type Calculator a = StateT (M.Map String Expression) IO a
+
+interpretExpression :: Expression -> Calculator Double
+interpretExpression (Constant n) = return n
+interpretExpression (Identifier i) = do
+ varmap <- get
+ case M.lookup i varmap of
+ Nothing -> fail ("Unknown identifier: " ++ i)
+ Just e -> interpretExpression e
+
+interpretExpression (Addition e1 e2) = do
+ v1 <- interpretExpression e1
+ v2 <- interpretExpression e2
+ return (v1 + v2)
+interpretExpression (Subtraction e1 e2) = do
+ v1 <- interpretExpression e1
+ v2 <- interpretExpression e2
+ return (v1 - v2)
+interpretExpression (Multiplication e1 e2) = do
+ v1 <- interpretExpression e1
+ v2 <- interpretExpression e2
+ return (v1 * v2)
+interpretExpression (Division e1 e2) = do
+ v1 <- interpretExpression e1
+ v2 <- interpretExpression e2
+ return (v1 * v2)
+interpretExpression (Modulus e1 e2) = do
+ v1 <- interpretExpression e1
+ v2 <- interpretExpression e2
+ let n1 = floor v1
+ n2 = floor v2
+ m = n1 `mod` n2
+ return $ fromInteger m
+interpretExpression (Negation e1) = do
+ v1 <- interpretExpression e1
+ return $ negate v1
+
+interpretStatement :: Statement -> Calculator ()
+interpretStatement (PrintStatement expr) = do
+ n <- interpretExpression expr
+ liftIO $ print n
+
+defaultVars :: M.Map String Expression
+defaultVars = M.fromList
+ [ ("e", Constant (exp 1))
+ , ("pi", Constant pi)
+ , ("phi", Constant ((1 + (sqrt 5)) / 2))
+ ]
-calculate :: String -> String
+calculate :: String -> IO ()
calculate s =
case ret of
- Left e -> "error: " ++ (show e)
- Right n -> "answer: " ++ (show n)
+ Left e -> putStrLn $ "error: " ++ (show e)
+ Right n -> evalStateT (interpretStatement n) defaultVars
where
ret = parse parseInput "" s
main :: IO ()
-main = interact (unlines . (map calculate) . lines)
+main = getContents >>= (mapM_ calculate) . lines