calculator 0.1.3.0 → 0.1.4.0
raw patch · 9 files changed
+85/−48 lines, 9 files
Files
- calculator.cabal +1/−1
- src/Calculator/Evaluator/Base.hs +13/−10
- src/Calculator/Evaluator/Cmd.hs +5/−3
- src/Calculator/Evaluator/Expr.hs +17/−17
- src/Calculator/Parser/Cmd.hs +16/−2
- src/Calculator/Parser/Expr.hs +3/−3
- src/Calculator/Prim/Cmd.hs +1/−0
- src/Calculator/Prim/Expr.hs +23/−5
- src/Main.hs +6/−7
calculator.cabal view
@@ -1,5 +1,5 @@ name: calculator-version: 0.1.3.0+version: 0.1.4.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.
src/Calculator/Evaluator/Base.hs view
@@ -2,29 +2,32 @@ -------------------------------------------------------------------------------- -import Calculator.Prim.Expr (Bindings, Expr(..))-import Calculator.Parser.Statement (parseStat)-import Calculator.Evaluator.Statement (evalStat)+import Calculator.Evaluator.Statement (evalStat)+import Calculator.Parser.Statement (parseStat)+import Calculator.Prim.Expr (Bindings, Expr (..)) -------------------------------------------------------------------------------- -import Text.ParserCombinators.Parsec (parse, eof)-import Control.Applicative ((<*))+import Control.Applicative ((<*))+import Data.List (nub)+import Text.ParserCombinators.Parsec (eof, parse) -------------------------------------------------------------------------------- eval :: Bindings -> String -> Either Expr Bindings eval b inp = case parse (parseStat <* eof) "Statement" inp of- Left e -> Left $ InvalidError $ show e+ Left e -> Left . InvalidError . tail . lines $ 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+result e =+ case e of+ Left (Constant c) -> Left $ " == " ++ show c+ Left (InvalidError x) -> Left . init . unlines . map (" !! " ++ ) . nub $ x+ Right b -> Right b+ Left _ -> Left " ~~ Erroneous Result ~~" --------------------------------------------------------------------------------
src/Calculator/Evaluator/Cmd.hs view
@@ -2,14 +2,16 @@ -------------------------------------------------------------------------------- -import Calculator.Prim.Expr (Bindings, def_vars, fromConst)+import Calculator.Prim.Expr (Bindings, defBinds, fromConst, addVar, addFun) import Calculator.Prim.Cmd (Cmd(..))+import Calculator.Evaluator.Func (mkFun) import Calculator.Evaluator.Expr (evalExpr) -------------------------------------------------------------------------------- evalCmd :: Bindings -> Cmd -> Bindings-evalCmd _ (Reset) = def_vars-evalCmd b (Assign s e) = (s, fromConst $ evalExpr b e) : b+evalCmd _ (Reset) = defBinds+evalCmd b (Assign s e) = addVar (s, fromConst $ evalExpr b e) b+evalCmd b f@(Func i _ _) = addFun (i, mkFun b f) b --------------------------------------------------------------------------------
src/Calculator/Evaluator/Expr.hs view
@@ -4,7 +4,7 @@ import Calculator.Prim.Base (Number) import Calculator.Prim.Expr (Bindings, Expr (..), Operator (..),- dispatch, fromConst, isConst)+ fromConst, isConst, joinErrors) -------------------------------------------------------------------------------- @@ -17,21 +17,20 @@ 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 (vs, _) (Variable s) =+ case lookup s vs 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)+evalExpr b@(_, fs) (Function f e) =+ let func = lookup f fs :: 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"+ Constant x -> case func of+ Nothing -> InvalidError ["Unknown function " ++ show f]+ Just g -> Constant $ g x+ r@(InvalidError _) -> r+ _ -> InvalidError ["Recieved Impossible result from evalExpr"]+evalExpr _ _ = InvalidError ["Could not find suitable pattern for evalExpr"] -------------------------------------------------------------------------------- @@ -47,9 +46,10 @@ in if ((&&) `on` isConst) val1 val2 then Constant $ (op `on` fromConst) val1 val2 else case (val1, val2) of- (e@(InvalidError _), _) -> e+ (e@(InvalidError _), f@(InvalidError _)) -> joinErrors e f (_, e@(InvalidError _)) -> e- _ -> InvalidError "Could not find matching pairs for evalPart"-evalPart _ _ _ = InvalidError "Could not find suitable pattern for evalPart"+ (e@(InvalidError _), _) -> e+ _ -> InvalidError ["Could not find matching pairs for evalPart"]+evalPart _ _ _ = InvalidError ["Could not find suitable pattern for evalPart"] --------------------------------------------------------------------------------
src/Calculator/Parser/Cmd.hs view
@@ -20,7 +20,7 @@ -- cmd' -> reset | assign parseCmd' :: Parser Cmd-parseCmd' = parseReset <|> parseAssign+parseCmd' = parseReset <|> parseAssign <|> parseFunc -------------------------------------------------------------------------------- -- reset -> "reset"@@ -29,7 +29,7 @@ parseReset = string "reset" >> return Reset ----------------------------------------------------------------------------------- assign -> "let" var "=" expr+-- assign -> "var" id "=" expr parseAssign :: Parser Cmd parseAssign = do@@ -38,5 +38,19 @@ _ <- char '=' ex <- parseExpr return $ Assign str ex++--------------------------------------------------------------------------------+-- func -> "func" id arg "=" expr++parseFunc :: Parser Cmd+parseFunc = do+ _ <- string "func "+ str <- parseId+ _ <- char '('+ arg <- parseId+ _ <- char ')'+ _ <- char '='+ ex <- parseExpr+ return $ Func str arg ex --------------------------------------------------------------------------------
src/Calculator/Parser/Expr.hs view
@@ -71,7 +71,7 @@ -- Parentheses can be parsed as function calls with no function parseVal :: Parser Expr-parseVal = parseFunction <|> parseVariable <|> parseConstant+parseVal = parseCall <|> parseVariable <|> parseConstant parseVariable :: Parser Expr parseVariable = Variable <$> parseId@@ -79,8 +79,8 @@ parseConstant :: Parser Expr parseConstant = Constant <$> parseNumber -parseFunction :: Parser Expr-parseFunction = do+parseCall :: Parser Expr+parseCall = do ident <- try (parseId <* char '(') expr <- parseExpr _ <- char ')'
src/Calculator/Prim/Cmd.hs view
@@ -12,6 +12,7 @@ -------------------------------------------------------------------------------- data Cmd = Assign String Expr+ | Func String String Expr | Reset --------------------------------------------------------------------------------
src/Calculator/Prim/Expr.hs view
@@ -6,14 +6,23 @@ -------------------------------------------------------------------------------- -type Bindings = [(String, Number)]+type Bindings = ( [(String, Number)]+ , [(String, Number -> Number)] ) +addVar :: (String, Number) -> Bindings -> Bindings+addVar v (vs, fs) = (v:vs, fs)++addFun :: (String, Number -> Number) -> Bindings -> Bindings+addFun f (vs, fs) = (vs, f:fs)++--------------------------------------------------------------------------------+ data Expr = Function String Expr | Constant Number | UnOp Operator Expr | BinOp (Expr, [(Operator, Expr)]) | Variable String- | InvalidError String+ | InvalidError [String] data Operator = UnaryOp (Number -> Number) | BinaryOp (Number -> Number -> Number)@@ -28,7 +37,7 @@ , ('^', BinaryOp (**)) ] -dispatch :: (RealFrac a, Floating a) => [(String, a -> a)]+dispatch :: [(String, Number -> Number)] dispatch = [ ("sin", sin) , ("cos", cos) , ("tan", tan)@@ -55,9 +64,12 @@ -------------------------------------------------------------------------------- -def_vars :: Bindings-def_vars = [ ("pi", pi) ]+defVars :: [(String, Number)]+defVars = [ ("pi", pi) ] +defBinds :: Bindings+defBinds = (defVars, dispatch)+ -------------------------------------------------------------------------------- fromConst :: Expr -> Number@@ -73,5 +85,11 @@ isConst :: Expr -> Bool isConst (Constant _) = True isConst _ = False++--------------------------------------------------------------------------------++joinErrors :: Expr -> Expr -> Expr+joinErrors (InvalidError e1) (InvalidError e2) = InvalidError (e1 ++ e2)+joinErrors _ _ = error "joinError used on non-error Expr" --------------------------------------------------------------------------------
src/Main.hs view
@@ -3,7 +3,7 @@ -------------------------------------------------------------------------------- import Calculator.Evaluator.Base (evaluate)-import Calculator.Prim.Expr (Bindings, def_vars)+import Calculator.Prim.Expr (Bindings, defBinds) -------------------------------------------------------------------------------- @@ -19,15 +19,14 @@ repl b = do input <- getInputLine "calc> " case input of- Nothing -> return ()- Just inp -> let result = evaluate b inp- in case result of- Left s -> outputStrLn s >> repl b- Right b' -> repl b'+ Nothing -> return ()+ Just inp -> case evaluate b inp of+ Left s -> outputStrLn s >> repl b+ Right b' -> repl b' -------------------------------------------------------------------------------- main :: IO ()-main = runInputT defaultSettings (repl def_vars)+main = runInputT defaultSettings (repl defBinds) --------------------------------------------------------------------------------