calculator 0.1.2.3 → 0.1.3.0
raw patch · 16 files changed
+454/−197 lines, 16 filesdep +mtl
Dependencies added: mtl
Files
- calculator.cabal +24/−6
- src/Calculator/Evaluator.hs +0/−40
- src/Calculator/Evaluator/Base.hs +34/−0
- src/Calculator/Evaluator/Cmd.hs +15/−0
- src/Calculator/Evaluator/Expr.hs +55/−0
- src/Calculator/Evaluator/Statement.hs +17/−0
- src/Calculator/Parser.hs +0/−85
- src/Calculator/Parser/Cmd.hs +42/−0
- src/Calculator/Parser/Expr.hs +89/−0
- src/Calculator/Parser/Statement.hs +19/−0
- src/Calculator/Prim/Base.hs +31/−0
- src/Calculator/Prim/Cmd.hs +17/−0
- src/Calculator/Prim/Expr.hs +77/−0
- src/Calculator/Prim/Statement.hs +14/−0
- src/Calculator/Primitives.hs +0/−58
- src/Main.hs +20/−8
calculator.cabal view
@@ -1,5 +1,5 @@ name: calculator-version: 0.1.2.3+version: 0.1.3.0 synopsis: A calculator that operates on string inputs description: A calculator repl that processes mathematical expressions. Does basic arithmetic, and provides pre-defined basic mathematical functions.@@ -17,12 +17,22 @@ executable calculator main-is: Main.hs- other-modules: Calculator.Evaluator- , Calculator.Parser+ other-modules: Calculator.Evaluator.Base+ , Calculator.Evaluator.Cmd+ , Calculator.Evaluator.Expr+ , Calculator.Evaluator.Statement+ , Calculator.Parser.Cmd+ , Calculator.Parser.Expr+ , Calculator.Parser.Statement+ , Calculator.Prim.Base+ , Calculator.Prim.Cmd+ , Calculator.Prim.Expr+ , Calculator.Prim.Statement -- other-extensions: build-depends: QuickCheck >= 2.7.6 && <2.7.7 , base >=4.7 && <4.8 , haskeline >=0.7.1.0 && <0.7.2.0+ , mtl >= 2.2.1 , parsec >=3.1.7 && <3.2 hs-source-dirs: src/ ghc-options: -Wall@@ -31,13 +41,21 @@ test-suite model-test-arithmetic type: exitcode-stdio-1.0 main-is: Arithmetic.hs- other-modules: Calculator.Evaluator- , Calculator.Parser- , Calculator.Primitives+ other-modules: Calculator.Evaluator.Cmd+ , Calculator.Evaluator.Expr+ , Calculator.Evaluator.Statement+ , Calculator.Parser.Cmd+ , Calculator.Parser.Expr+ , Calculator.Parser.Statement+ , Calculator.Prim.Base+ , Calculator.Prim.Cmd+ , Calculator.Prim.Expr+ , Calculator.Prim.Statement , Model.Arithmetic hs-source-dirs: tests/ src/ build-depends: QuickCheck >= 2.7.6 && <2.7.7 , base >=4.7 && <4.8+ , mtl >= 2.2.1 , parsec >=3.1.7 && <3.2 ghc-options: -Wall default-language: Haskell2010
− src/Calculator/Evaluator.hs
@@ -1,40 +0,0 @@-module Calculator.Evaluator (eval) where--import Calculator.Parser (parseExpr)-import Calculator.Primitives--import Control.Applicative ((<$>), (<*))-import Data.Function (on)-import Text.ParserCombinators.Parsec (ParseError, eof, parse)--evaluate :: Expr -> Expr-evaluate e@(Constant _) = e-evaluate e@(InvalidError _) = e-evaluate (UnOp (UnaryOp op) e) = Constant . op . fromConst $ evaluate e-evaluate (BinOp (expr, rest)) = process expr rest-evaluate (Function "" e) = evaluate e-evaluate (Function f e) =- let func = lookup f dispatch :: Maybe (Number -> Number)- val = fromConst $ evaluate e- in case func of- Nothing -> InvalidError $ "Unknown function " ++ show f- Just g -> Constant $ g val-evaluate _ = InvalidError evalFaliure--process :: Expr -> [(Operator, Expr)] -> Expr-process expr rest = evaluate $ foldl evalPart expr rest--evalPart :: Expr -> (Operator, Expr) -> Expr-evalPart e1 ((BinaryOp op), e2) =- let val1 = evaluate e1- val2 = evaluate e2- in if isConst val1 && isConst val2- then Constant $ (op `on` fromConst) val1 val2- else case (val1, val2) of- (e@(InvalidError _), _) -> e- (_, e@(InvalidError _)) -> e- (_, _) -> InvalidError evalFaliure-evalPart _ _ = InvalidError evalFaliure--eval :: String -> Either ParseError Expr-eval s = evaluate <$> parse (parseExpr <* eof) s s
+ src/Calculator/Evaluator/Base.hs view
@@ -0,0 +1,34 @@+module Calculator.Evaluator.Base (evaluate) where++--------------------------------------------------------------------------------++import Calculator.Prim.Expr (Bindings, Expr(..))+import Calculator.Parser.Statement (parseStat)+import Calculator.Evaluator.Statement (evalStat)++--------------------------------------------------------------------------------++import Text.ParserCombinators.Parsec (parse, eof)+import Control.Applicative ((<*))++--------------------------------------------------------------------------------++eval :: Bindings -> String -> Either Expr Bindings+eval b inp = case parse (parseStat <* eof) "Statement" inp of+ Left e -> Left $ InvalidError $ show e+ Right s -> evalStat b s++--------------------------------------------------------------------------------++result :: Either Expr Bindings -> Either String Bindings+result e = case e of+ Left (Constant c) -> Left $ show c+ Left (InvalidError x) -> Left x+ Right b -> Right b++--------------------------------------------------------------------------------++evaluate :: Bindings -> String -> Either String Bindings+evaluate b s = result $ eval b s++--------------------------------------------------------------------------------
+ src/Calculator/Evaluator/Cmd.hs view
@@ -0,0 +1,15 @@+module Calculator.Evaluator.Cmd (evalCmd) where++--------------------------------------------------------------------------------++import Calculator.Prim.Expr (Bindings, def_vars, fromConst)+import Calculator.Prim.Cmd (Cmd(..))+import Calculator.Evaluator.Expr (evalExpr)++--------------------------------------------------------------------------------++evalCmd :: Bindings -> Cmd -> Bindings+evalCmd _ (Reset) = def_vars+evalCmd b (Assign s e) = (s, fromConst $ evalExpr b e) : b++--------------------------------------------------------------------------------
+ src/Calculator/Evaluator/Expr.hs view
@@ -0,0 +1,55 @@+module Calculator.Evaluator.Expr (evalExpr) where++--------------------------------------------------------------------------------++import Calculator.Prim.Base (Number)+import Calculator.Prim.Expr (Bindings, Expr (..), Operator (..),+ dispatch, fromConst, isConst)++--------------------------------------------------------------------------------++import Data.Function (on)++--------------------------------------------------------------------------------++evalExpr :: Bindings -> Expr -> Expr+evalExpr _ e@(Constant _) = e+evalExpr _ e@(InvalidError _) = e+-- evalExpr b (UnOp (UnaryOp op) e) = Constant . op . fromConst $ evalExpr b e+evalExpr b (BinOp (expr, rest)) = process b expr rest+evalExpr b (Variable s) =+ let val = lookup s b+ in case val of+ Nothing -> InvalidError $ "Unknown variable " ++ show s+ Just v -> Constant v+evalExpr b (Function "" e) = evalExpr b e+evalExpr b (Function f e) =+ let func = lookup f dispatch :: Maybe (Number -> Number)+ in case evalExpr b e of+ Constant x -> case func of+ Nothing -> InvalidError $ "Unknown function " ++ show f+ Just g -> Constant $ g x+ e@(InvalidError _) -> e+ _ -> InvalidError "Recieved Impossible result from evalExpr"+evalExpr _ _ = InvalidError "Could not find suitable pattern for evalExpr"++--------------------------------------------------------------------------------++process :: Bindings -> Expr -> [(Operator, Expr)] -> Expr+process bind expr rest = evalExpr bind $ foldl (evalPart bind) expr rest++--------------------------------------------------------------------------------++evalPart :: Bindings -> Expr -> (Operator, Expr) -> Expr+evalPart b e1 ((BinaryOp op), e2) =+ let val1 = evalExpr b e1+ val2 = evalExpr b e2+ in if ((&&) `on` isConst) val1 val2+ then Constant $ (op `on` fromConst) val1 val2+ else case (val1, val2) of+ (e@(InvalidError _), _) -> e+ (_, e@(InvalidError _)) -> e+ _ -> InvalidError "Could not find matching pairs for evalPart"+evalPart _ _ _ = InvalidError "Could not find suitable pattern for evalPart"++--------------------------------------------------------------------------------
+ src/Calculator/Evaluator/Statement.hs view
@@ -0,0 +1,17 @@+module Calculator.Evaluator.Statement (evalStat) where++--------------------------------------------------------------------------------++import Calculator.Evaluator.Cmd (evalCmd)+import Calculator.Evaluator.Expr (evalExpr)+import Calculator.Prim.Expr (Bindings, Expr)+import Calculator.Prim.Statement (Statement (..))++--------------------------------------------------------------------------------++evalStat :: Bindings -> Statement -> Either Expr Bindings+evalStat b stat = case stat of+ Expression e -> Left $ evalExpr b e+ Command c -> Right $ evalCmd b c++--------------------------------------------------------------------------------
− src/Calculator/Parser.hs
@@ -1,85 +0,0 @@-module Calculator.Parser (parseExpr) where--import Calculator.Primitives--import Control.Applicative ((<$>))-import Control.Monad (liftM2)-import Text.ParserCombinators.Parsec---- expr -> term ( "+-" term )*--parseExpr :: Parser Expr-parseExpr = do- term <- parseTerm- rest <- parseRestExpr- if null rest- then return term- else return $ BinOp (term, rest)--parseRestExpr :: Parser [(Operator, Expr)]-parseRestExpr = many $ do- oper <- oneOf "+-"- let (Just op) = lookup oper binaryOps- expr <- parseTerm- return (op, expr)---- term -> fact ( "*/" fact )*--parseTerm :: Parser Expr-parseTerm = do- fact <- parseFact- rest <- parseRestTerm- if null rest- then return fact- else return $ BinOp (fact, rest)--parseRestTerm :: Parser [(Operator, Expr)]-parseRestTerm = many $ do- oper <- oneOf "*/"- let (Just op) = lookup oper binaryOps- expr <- parseFact- return (op, expr)---- fact -> val ( "^" fact )?--- Right recursion for right associativity--constEq :: Expr -> Expr -> Bool-constEq (Constant x) (Constant y) = x == y-constEq _ _ = False--parseFact :: Parser Expr-parseFact = do- val <- parseVal- pow <- parsePower- if constEq (Constant 1) (snd pow)- then return val- else return $ BinOp (val, [pow])--parsePower :: Parser (Operator, Expr)-parsePower = let (Just op) = lookup '^' binaryOps- in option (op, Constant 1) $ do- _ <- char '^'- fact <- parseFact- return (op, fact)---- val -> func? ( expr ) | number--- Parentheses can be seen as function calls--parseVal :: Parser Expr-parseVal = parseFunction <|> parseNumber--parseFunction :: Parser Expr-parseFunction = do- fname <- option "" (many letter)- _ <- char '('- e <- parseExpr- _ <- char ')'- return $ Function fname e--parseNumber :: Parser Expr-parseNumber = Constant . read <$> do- dec <- many1 digit- flt <- option "" (liftM2 (:) (char '.') (many1 digit))- if null flt- then return dec- else return $ dec ++ flt
+ src/Calculator/Parser/Cmd.hs view
@@ -0,0 +1,42 @@+module Calculator.Parser.Cmd (parseCmd) where++--------------------------------------------------------------------------------++import Calculator.Prim.Base (parseId)+import Calculator.Prim.Cmd (Cmd (..))+import Calculator.Parser.Expr (parseExpr)++--------------------------------------------------------------------------------++import Text.ParserCombinators.Parsec++--------------------------------------------------------------------------------+-- cmd -> ':' cmd'++parseCmd :: Parser Cmd+parseCmd = char ':' >> parseCmd'++--------------------------------------------------------------------------------+-- cmd' -> reset | assign++parseCmd' :: Parser Cmd+parseCmd' = parseReset <|> parseAssign++--------------------------------------------------------------------------------+-- reset -> "reset"++parseReset :: Parser Cmd+parseReset = string "reset" >> return Reset++--------------------------------------------------------------------------------+-- assign -> "let" var "=" expr++parseAssign :: Parser Cmd+parseAssign = do+ _ <- string "var "+ str <- parseId+ _ <- char '='+ ex <- parseExpr+ return $ Assign str ex++--------------------------------------------------------------------------------
+ src/Calculator/Parser/Expr.hs view
@@ -0,0 +1,89 @@+module Calculator.Parser.Expr (parseExpr) where++--------------------------------------------------------------------------------++import Calculator.Prim.Base (parseId, parseNumber)+import Calculator.Prim.Expr (Expr (..), Operator, binaryOps,+ constEq)++--------------------------------------------------------------------------------++import Control.Applicative ((<$>), (<*))+import Text.ParserCombinators.Parsec++--------------------------------------------------------------------------------+-- expr -> term ( "+-" term )*++parseExpr :: Parser Expr+parseExpr = do+ term <- parseTerm+ rest <- parseRestExpr+ if null rest+ then return term+ else return $ BinOp (term, rest)++parseRestExpr :: Parser [(Operator, Expr)]+parseRestExpr = many $ do+ oper <- oneOf "+-"+ let (Just op) = lookup oper binaryOps+ expr <- parseTerm+ return (op, expr)++--------------------------------------------------------------------------------+-- term -> fact ( "*/" fact )*++parseTerm :: Parser Expr+parseTerm = do+ fact <- parseFact+ rest <- parseRestTerm+ if null rest+ then return fact+ else return $ BinOp (fact, rest)++parseRestTerm :: Parser [(Operator, Expr)]+parseRestTerm = many $ do+ oper <- oneOf "*/"+ let (Just op) = lookup oper binaryOps+ expr <- parseFact+ return (op, expr)++--------------------------------------------------------------------------------+-- fact -> val ( "^" fact )?+-- Right recursion for right associativity++parseFact :: Parser Expr+parseFact = do+ val <- parseVal+ pow <- parsePower+ if constEq (Constant 1) (snd pow)+ then return val+ else return $ BinOp (val, [pow])++parsePower :: Parser (Operator, Expr)+parsePower = let (Just op) = lookup '^' binaryOps+ in option (op, Constant 1) $ do+ _ <- char '^'+ fact <- parseFact+ return (op, fact)++--------------------------------------------------------------------------------+-- val -> func? ( expr ) | number+-- Parentheses can be parsed as function calls with no function++parseVal :: Parser Expr+parseVal = parseFunction <|> parseVariable <|> parseConstant++parseVariable :: Parser Expr+parseVariable = Variable <$> parseId++parseConstant :: Parser Expr+parseConstant = Constant <$> parseNumber++parseFunction :: Parser Expr+parseFunction = do+ ident <- try (parseId <* char '(')+ expr <- parseExpr+ _ <- char ')'+ return $ Function ident expr++--------------------------------------------------------------------------------
+ src/Calculator/Parser/Statement.hs view
@@ -0,0 +1,19 @@+module Calculator.Parser.Statement (parseStat) where++--------------------------------------------------------------------------------++import Calculator.Parser.Cmd (parseCmd)+import Calculator.Parser.Expr (parseExpr)+import Calculator.Prim.Statement (Statement (..))++--------------------------------------------------------------------------------++import Control.Applicative ((<$>))+import Text.ParserCombinators.Parsec++--------------------------------------------------------------------------------++parseStat :: Parser Statement+parseStat = (Expression <$> parseExpr) <|> (Command <$> parseCmd)++--------------------------------------------------------------------------------
+ src/Calculator/Prim/Base.hs view
@@ -0,0 +1,31 @@+module Calculator.Prim.Base where++--------------------------------------------------------------------------------++import Text.ParserCombinators.Parsec++--------------------------------------------------------------------------------++import Control.Applicative ((<$>))+import Control.Monad (liftM2)++--------------------------------------------------------------------------------++type Number = Double++--------------------------------------------------------------------------------++parseNumber :: Parser Number+parseNumber = read <$> do+ dec <- many1 digit+ flt <- option "" (liftM2 (:) (char '.') (many1 digit))+ if null flt+ then return dec+ else return $ dec ++ flt++--------------------------------------------------------------------------------++parseId :: Parser String+parseId = (liftM2 (:) letter (many (letter <|> digit)))++--------------------------------------------------------------------------------
+ src/Calculator/Prim/Cmd.hs view
@@ -0,0 +1,17 @@+module Calculator.Prim.Cmd where++--------------------------------------------------------------------------------++import Calculator.Prim.Base (Number)+import Calculator.Prim.Expr (Expr)++--------------------------------------------------------------------------------++type Bindings = [(String, Number)]++--------------------------------------------------------------------------------++data Cmd = Assign String Expr+ | Reset++--------------------------------------------------------------------------------
+ src/Calculator/Prim/Expr.hs view
@@ -0,0 +1,77 @@+module Calculator.Prim.Expr where++--------------------------------------------------------------------------------++import Calculator.Prim.Base (Number)++--------------------------------------------------------------------------------++type Bindings = [(String, Number)]++data Expr = Function String Expr+ | Constant Number+ | UnOp Operator Expr+ | BinOp (Expr, [(Operator, Expr)])+ | Variable String+ | InvalidError String++data Operator = UnaryOp (Number -> Number)+ | BinaryOp (Number -> Number -> Number)++--------------------------------------------------------------------------------++binaryOps :: [(Char, Operator)]+binaryOps = [ ('+', BinaryOp (+))+ , ('-', BinaryOp (-))+ , ('*', BinaryOp (*))+ , ('/', BinaryOp (/))+ , ('^', BinaryOp (**))+ ]++dispatch :: (RealFrac a, Floating a) => [(String, a -> a)]+dispatch = [ ("sin", sin)+ , ("cos", cos)+ , ("tan", tan)+ , ("asin", asin)+ , ("acos", acos)+ , ("atan", atan)+ , ("sinh", sinh)+ , ("cosh", cosh)+ , ("tanh", tanh)+ , ("exp", exp)+ , ("log", log)+ , ("log10", logBase 10)+ , ("sqrt", sqrt)+ , ("ceil", fromInteger . ceiling)+ , ("floor", fromInteger . floor)+ , ("abs", abs)+ ]++--------------------------------------------------------------------------------++constEq :: Expr -> Expr -> Bool+constEq (Constant x) (Constant y) = x == y+constEq _ _ = False++--------------------------------------------------------------------------------++def_vars :: Bindings+def_vars = [ ("pi", pi) ]++--------------------------------------------------------------------------------++fromConst :: Expr -> Number+fromConst (Constant v) = v+fromConst (Function _ _) = error "fromConst Function"+fromConst (UnOp _ _) = error "fromConst UnOp"+fromConst (BinOp _) = error "fromConst BinOp"+fromConst (Variable _) = error "fromConst Variable"+fromConst (InvalidError _) = error "fromConst InvalidError"++--------------------------------------------------------------------------------++isConst :: Expr -> Bool+isConst (Constant _) = True+isConst _ = False++--------------------------------------------------------------------------------
+ src/Calculator/Prim/Statement.hs view
@@ -0,0 +1,14 @@+module Calculator.Prim.Statement where++--------------------------------------------------------------------------------++import Calculator.Prim.Cmd (Cmd)+import Calculator.Prim.Expr (Expr)++--------------------------------------------------------------------------------+-- stmt -> cmd | expr++data Statement = Expression Expr+ | Command Cmd++--------------------------------------------------------------------------------
− src/Calculator/Primitives.hs
@@ -1,58 +0,0 @@-module Calculator.Primitives where--import Text.ParserCombinators.Parsec.Error (ParseError)--type Number = Double--data Expr = Function String Expr- | Constant Number- | UnOp Operator Expr- | BinOp (Expr, [(Operator, Expr)])- | InvalidError String--data Operator = UnaryOp (Number -> Number)- | BinaryOp (Number -> Number -> Number)--evalFaliure :: String-evalFaliure = "Evaluation Failed"--fromConst :: Expr -> Number-fromConst (Constant c) = c-fromConst _ = error "Error: Making number from expr"--isConst :: Expr -> Bool-isConst (Constant _) = True-isConst _ = False--result :: Either ParseError Expr -> String-result (Right (Constant c)) = " == " ++ show c-result (Right (InvalidError e)) = " !! " ++ e-result (Left e) = show e-result _ = evalFaliure--binaryOps :: [(Char, Operator)]-binaryOps = [ ('+', BinaryOp (+))- , ('-', BinaryOp (-))- , ('*', BinaryOp (*))- , ('/', BinaryOp (/))- , ('^', BinaryOp (**))- ]--dispatch :: (RealFrac a, Floating a) => [(String, a -> a)]-dispatch = [ ("sin", sin)- , ("cos", cos)- , ("tan", tan)- , ("asin", asin)- , ("acos", acos)- , ("atan", atan)- , ("sinh", sinh)- , ("cosh", cosh)- , ("tanh", tanh)- , ("exp", exp)- , ("log", log)- , ("log10", logBase 10)- , ("sqrt", sqrt)- , ("ceil", fromInteger . ceiling)- , ("floor", fromInteger . floor)- , ("abs", abs)- ]
src/Main.hs view
@@ -1,21 +1,33 @@ module Main where -import Calculator.Evaluator (eval)-import Calculator.Primitives (result)+-------------------------------------------------------------------------------- +import Calculator.Evaluator.Base (evaluate)+import Calculator.Prim.Expr (Bindings, def_vars)++--------------------------------------------------------------------------------+ import System.Console.Haskeline +--------------------------------------------------------------------------------+ type Repl a = InputT IO a -process :: String -> Repl ()-process input = outputStrLn $ result $ eval input+-------------------------------------------------------------------------------- -repl :: Repl ()-repl = do+repl :: Bindings -> Repl ()+repl b = do input <- getInputLine "calc> " case input of Nothing -> return ()- Just inp -> process inp >> repl+ Just inp -> let result = evaluate b inp+ in case result of+ Left s -> outputStrLn s >> repl b+ Right b' -> repl b' +--------------------------------------------------------------------------------+ main :: IO ()-main = runInputT defaultSettings repl+main = runInputT defaultSettings (repl def_vars)++--------------------------------------------------------------------------------