calculator 0.1.4.2 → 0.1.5.0
raw patch · 12 files changed
+117/−77 lines, 12 files
Files
- calculator.cabal +4/−4
- src/Calculator/Evaluator/Base.hs +7/−6
- src/Calculator/Evaluator/Cmd.hs +6/−4
- src/Calculator/Evaluator/Expr.hs +14/−14
- src/Calculator/Evaluator/Func.hs +0/−14
- src/Calculator/Evaluator/Statement.hs +4/−2
- src/Calculator/Help.hs +29/−0
- src/Calculator/Parser/Cmd.hs +8/−2
- src/Calculator/Parser/Expr.hs +18/−16
- src/Calculator/Prim/Cmd.hs +1/−0
- src/Calculator/Prim/Expr.hs +14/−12
- src/Main.hs +12/−3
calculator.cabal view
@@ -1,9 +1,9 @@ name: calculator-version: 0.1.4.2-synopsis: A calculator that operates on string inputs+version: 0.1.5.0+synopsis: A calculator repl. description: A calculator repl that processes mathematical expressions. Does basic arithmetic, and provides pre-defined basic mathematical functions.- Aims to provide variable bindings and function bindings in the future.+ Provides binding functionality for variables, and single variable functions. homepage: https://github.com/sumitsahrawat/calculator license: GPL-2 license-file: LICENSE@@ -21,7 +21,6 @@ , Calculator.Evaluator.Cmd , Calculator.Evaluator.Expr , Calculator.Evaluator.Statement- , Calculator.Evaluator.Func , Calculator.Parser.Cmd , Calculator.Parser.Expr , Calculator.Parser.Statement@@ -29,6 +28,7 @@ , Calculator.Prim.Cmd , Calculator.Prim.Expr , Calculator.Prim.Statement+ , Calculator.Help -- other-extensions: build-depends: QuickCheck >= 2.7.6 && <2.7.7 , base >=4.7 && <4.8
src/Calculator/Evaluator/Base.hs view
@@ -9,14 +9,14 @@ -------------------------------------------------------------------------------- import Control.Applicative ((<*))-import Data.List (nub)+-- 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 . tail . lines $ show e+ Left e -> Left . Message . tail . lines $ show e Right s -> evalStat b s --------------------------------------------------------------------------------@@ -24,10 +24,11 @@ result :: Either Expr Bindings -> Either String Bindings 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 ~~"+ Left (Constant c) -> Left $ " == " ++ show c+-- Left (Message x) -> Left . init . unlines . map (" !! " ++ ) . nub $ x+ Left (Message x) -> Left . init . unlines . map (" -!- " ++ ) $ x+ Right b -> Right b+ Left _ -> Left " ~~ Erroneous Result ~~" --------------------------------------------------------------------------------
src/Calculator/Evaluator/Cmd.hs view
@@ -6,12 +6,14 @@ import Calculator.Prim.Cmd (Cmd(..)) import Calculator.Evaluator.Func (mkFun) import Calculator.Evaluator.Expr (evalExpr)+import Calculator.Help (help) -------------------------------------------------------------------------------- -evalCmd :: Bindings -> Cmd -> Bindings-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+evalCmd :: Bindings -> Cmd -> Either [String] Bindings+evalCmd _ (Help) = Left help+evalCmd _ (Reset) = Right defBinds+evalCmd b (Assign s e) = Right $ addVar (s, fromConst $ evalExpr b e) b+evalCmd b f@(Func i _ _) = Right $ 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 (..),- fromConst, isConst, joinErrors)+ fromConst, isConst, joinMessage) -------------------------------------------------------------------------------- @@ -14,23 +14,23 @@ evalExpr :: Bindings -> Expr -> Expr evalExpr _ e@(Constant _) = e-evalExpr _ e@(InvalidError _) = e+evalExpr _ e@(Message _) = e -- evalExpr b (UnOp (UnaryOp op) e) = Constant . op . fromConst $ evalExpr b e evalExpr b (BinOp (expr, rest)) = process b expr rest evalExpr (vs, _) (Variable s) = case lookup s vs of- Nothing -> InvalidError ["Unknown variable " ++ show s]+ Nothing -> Message ["Unknown variable " ++ show s] Just v -> Constant v evalExpr b (Function "" e) = evalExpr b e 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- r@(InvalidError _) -> r- _ -> InvalidError ["Recieved Impossible result from evalExpr"]-evalExpr _ _ = InvalidError ["Could not find suitable pattern for evalExpr"]+ Constant x -> case func of+ Nothing -> Message ["Unknown function " ++ show f]+ Just g -> Constant $ g x+ r@(Message _) -> r+ _ -> Message ["Recieved Impossible result from evalExpr"]+evalExpr _ _ = Message ["Could not find suitable pattern for evalExpr"] -------------------------------------------------------------------------------- @@ -46,10 +46,10 @@ in if ((&&) `on` isConst) val1 val2 then Constant $ (op `on` fromConst) val1 val2 else case (val1, val2) of- (e@(InvalidError _), f@(InvalidError _)) -> joinErrors e f- (_, e@(InvalidError _)) -> e- (e@(InvalidError _), _) -> e- _ -> InvalidError ["Could not find matching pairs for evalPart"]-evalPart _ _ _ = InvalidError ["Could not find suitable pattern for evalPart"]+ (e@(Message _), f@(Message _)) -> joinMessage e f+ (_, e@(Message _)) -> e+ (e@(Message _), _) -> e+ _ -> Message ["Could not find matching pairs for evalPart"]+evalPart _ _ _ = Message ["Could not find suitable pattern for evalPart"] --------------------------------------------------------------------------------
− src/Calculator/Evaluator/Func.hs
@@ -1,14 +0,0 @@-module Calculator.Evaluator.Func where------------------------------------------------------------------------------------import Calculator.Prim.Base (Number)-import Calculator.Prim.Cmd (Cmd(Func))-import Calculator.Prim.Expr (addVar, Bindings, fromConst)-import Calculator.Evaluator.Expr (evalExpr)------------------------------------------------------------------------------------mkFun :: Bindings -> Cmd -> (Number -> Number)-mkFun b (Func _ x e) = \v -> fromConst $ evalExpr (addVar (x, v) b) e-mkFun _ _ = error "Making function from invalid cmd"
src/Calculator/Evaluator/Statement.hs view
@@ -4,7 +4,7 @@ import Calculator.Evaluator.Cmd (evalCmd) import Calculator.Evaluator.Expr (evalExpr)-import Calculator.Prim.Expr (Bindings, Expr)+import Calculator.Prim.Expr (Bindings, Expr (Message)) import Calculator.Prim.Statement (Statement (..)) --------------------------------------------------------------------------------@@ -12,6 +12,8 @@ evalStat :: Bindings -> Statement -> Either Expr Bindings evalStat b stat = case stat of Expression e -> Left $ evalExpr b e- Command c -> Right $ evalCmd b c+ Command c -> case evalCmd b c of+ Left s -> Left . Message $ s+ Right b' -> Right b' --------------------------------------------------------------------------------
+ src/Calculator/Help.hs view
@@ -0,0 +1,29 @@+module Calculator.Help (help) where++--------------------------------------------------------------------------------++import Calculator.Prim.Expr (binaryOps, dispatch, defVars)++--------------------------------------------------------------------------------++import Data.List (intersperse, intercalate)++--------------------------------------------------------------------------------++help :: [String]+help = [ "Commands:"+ , " :var x=pi -- Binds x to pi"+ , " :func f(x)=x+1 -- Binds f(x) to \"x + 1\""+ , " :reset -- Reset variable and function bindings"+-- , " :show -- Display all variable bindings"+ , " :? or :help -- Display this help message"+ , ""+ , "Supported Operations: " ++ intersperse ' ' (map fst binaryOps)+ , ""+ , "Pre-defined variables: " ++ intercalate ", " (map fst defVars)+ , ""+ , "Provided Functions: "+ , " " ++ intercalate ", " (map fst dispatch)+ ]++--------------------------------------------------------------------------------
src/Calculator/Parser/Cmd.hs view
@@ -2,9 +2,9 @@ -------------------------------------------------------------------------------- +import Calculator.Parser.Expr (parseExpr) import Calculator.Prim.Base (parseId) import Calculator.Prim.Cmd (Cmd (..))-import Calculator.Parser.Expr (parseExpr) -------------------------------------------------------------------------------- @@ -20,7 +20,13 @@ -- cmd' -> reset | assign parseCmd' :: Parser Cmd-parseCmd' = parseReset <|> parseAssign <|> parseFunc+parseCmd' = parseHelp <|> parseReset <|> parseAssign <|> parseFunc++--------------------------------------------------------------------------------+-- help -> "?" | "help"++parseHelp :: Parser Cmd+parseHelp = (string "?" <|> string "help") >> return Help -------------------------------------------------------------------------------- -- reset -> "reset"
src/Calculator/Parser/Expr.hs view
@@ -16,17 +16,17 @@ parseExpr :: Parser Expr parseExpr = do- term <- parseTerm- rest <- parseRestExpr+ term <- parseTerm <* spaces+ rest <- parseRestExpr <* spaces if null rest then return term else return $ BinOp (term, rest) parseRestExpr :: Parser [(Operator, Expr)] parseRestExpr = many $ do- oper <- oneOf "+-"+ oper <- oneOf "+-" <* spaces let (Just op) = lookup oper binaryOps- expr <- parseTerm+ expr <- parseTerm <* spaces return (op, expr) --------------------------------------------------------------------------------@@ -34,17 +34,17 @@ parseTerm :: Parser Expr parseTerm = do- fact <- parseFact- rest <- parseRestTerm+ fact <- parseFact <* spaces+ rest <- parseRestTerm <* spaces if null rest then return fact else return $ BinOp (fact, rest) parseRestTerm :: Parser [(Operator, Expr)] parseRestTerm = many $ do- oper <- oneOf "*/"+ oper <- oneOf "*/" <* spaces let (Just op) = lookup oper binaryOps- expr <- parseFact+ expr <- parseFact <* spaces return (op, expr) --------------------------------------------------------------------------------@@ -53,8 +53,8 @@ parseFact :: Parser Expr parseFact = do- val <- parseVal- pow <- parsePower+ val <- parseVal <* spaces+ pow <- parsePower <* spaces if constEq (Constant 1) (snd pow) then return val else return $ BinOp (val, [pow])@@ -62,8 +62,9 @@ parsePower :: Parser (Operator, Expr) parsePower = let (Just op) = lookup '^' binaryOps in option (op, Constant 1) $ do- _ <- char '^'- fact <- parseFact+ _ <- spaces+ _ <- char '^' <* spaces+ fact <- parseFact <* spaces return (op, fact) --------------------------------------------------------------------------------@@ -81,10 +82,11 @@ parseCall :: Parser Expr parseCall = do- ident <- optionMaybe parseId- _ <- char '('- expr <- parseExpr- _ <- char ')'+ _ <- spaces+ ident <- optionMaybe parseId <* spaces+ _ <- char '(' <* spaces+ expr <- parseExpr <* spaces+ _ <- char ')' <* spaces return $ case ident of Nothing -> expr Just s -> Function s expr
src/Calculator/Prim/Cmd.hs view
@@ -13,6 +13,7 @@ data Cmd = Assign String Expr | Func String String Expr+ | Help | Reset --------------------------------------------------------------------------------
src/Calculator/Prim/Expr.hs view
@@ -22,7 +22,7 @@ | UnOp Operator Expr | BinOp (Expr, [(Operator, Expr)]) | Variable String- | InvalidError [String]+ | Message [String] data Operator = UnaryOp (Number -> Number) | BinaryOp (Number -> Number -> Number)@@ -60,12 +60,14 @@ constEq :: Expr -> Expr -> Bool constEq (Constant x) (Constant y) = x == y-constEq _ _ = False+constEq _ _ = False -------------------------------------------------------------------------------- defVars :: [(String, Number)]-defVars = [ ("pi", pi) ]+defVars = [ ("pi", pi)+ , ("e", exp 1)+ ] defBinds :: Bindings defBinds = (defVars, dispatch)@@ -73,12 +75,12 @@ -------------------------------------------------------------------------------- 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"+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 (Message _) = error "fromConst Message" -------------------------------------------------------------------------------- @@ -88,8 +90,8 @@ -------------------------------------------------------------------------------- -joinErrors :: Expr -> Expr -> Expr-joinErrors (InvalidError e1) (InvalidError e2) = InvalidError (e1 ++ e2)-joinErrors _ _ = error "joinError used on non-error Expr"+joinMessage :: Expr -> Expr -> Expr+joinMessage (Message e1) (Message e2) = Message (e1 ++ e2)+joinMessage _ _ = error "joinError used on non-error Expr" --------------------------------------------------------------------------------
src/Main.hs view
@@ -2,11 +2,16 @@ -------------------------------------------------------------------------------- -import Calculator.Evaluator.Base (evaluate)-import Calculator.Prim.Expr (Bindings, defBinds)+import Paths_calculator (version) -------------------------------------------------------------------------------- +import Calculator.Evaluator.Base (evaluate)+import Calculator.Prim.Expr (Bindings, defBinds)++--------------------------------------------------------------------------------++import Data.Version (showVersion) import System.Console.Haskeline --------------------------------------------------------------------------------@@ -27,6 +32,10 @@ -------------------------------------------------------------------------------- main :: IO ()-main = runInputT defaultSettings (repl defBinds)+main = do+ putStrLn $ "calculator, version "+ ++ showVersion version+ ++ ". Use :? for help"+ runInputT defaultSettings (repl defBinds) --------------------------------------------------------------------------------