calculator 0.1.5.4 → 0.2.0.0
raw patch · 20 files changed
+352/−175 lines, 20 filesdep +containers
Dependencies added: containers
Files
- calculator.cabal +17/−7
- src/Calculator/Evaluator/Base.hs +3/−2
- src/Calculator/Evaluator/Cmd.hs +11/−9
- src/Calculator/Evaluator/Expr.hs +32/−23
- src/Calculator/Evaluator/Func.hs +13/−9
- src/Calculator/Evaluator/Statement.hs +2/−1
- src/Calculator/Help.hs +9/−8
- src/Calculator/Parser/Base.hs +8/−12
- src/Calculator/Parser/Cmd.hs +20/−10
- src/Calculator/Parser/Expr.hs +14/−11
- src/Calculator/Prim/Base.hs +0/−7
- src/Calculator/Prim/Bindings.hs +68/−0
- src/Calculator/Prim/Cmd.hs +4/−2
- src/Calculator/Prim/Definitions.hs +66/−0
- src/Calculator/Prim/Expr.hs +19/−60
- src/Calculator/Prim/Function.hs +52/−0
- src/Calculator/Prim/Statement.hs +3/−3
- src/Main.hs +6/−4
- src/Model/Arithmetic.hs +4/−5
- tests/Arithmetic.hs +1/−2
calculator.cabal view
@@ -1,9 +1,9 @@ name: calculator-version: 0.1.5.4+version: 0.2.0.0 synopsis: A calculator repl. description: A calculator repl that processes mathematical expressions. Does basic arithmetic, and provides pre-defined basic mathematical functions.- Provides binding functionality for variables, and single variable functions.+ Provides binding functionality for variables and functions. homepage: https://github.com/sumitsahrawat/calculator license: GPL-2 license-file: LICENSE@@ -20,20 +20,23 @@ other-modules: Calculator.Evaluator.Base , Calculator.Evaluator.Cmd , Calculator.Evaluator.Expr- , Calculator.Evaluator.Statement , Calculator.Evaluator.Func+ , Calculator.Evaluator.Statement+ , Calculator.Help , Calculator.Parser.Base , Calculator.Parser.Cmd , Calculator.Parser.Expr , Calculator.Parser.Statement- , Calculator.Prim.Base+ , Calculator.Prim.Bindings , Calculator.Prim.Cmd+ , Calculator.Prim.Definitions , Calculator.Prim.Expr+ , Calculator.Prim.Function , Calculator.Prim.Statement- , Calculator.Help -- other-extensions: build-depends: QuickCheck >= 2.7.6 && <2.7.7 , base >=4.7 && <4.8+ , containers >= 0.5.5.1 && <0.5.6.0 , haskeline >=0.7.1.0 && <0.7.2.0 , mtl >= 2.2.1 , parsec >=3.1.7 && <3.2@@ -44,20 +47,27 @@ test-suite model-test-arithmetic type: exitcode-stdio-1.0 main-is: Arithmetic.hs- other-modules: Calculator.Evaluator.Cmd+ other-modules: Calculator.Evaluator.Base+ , Calculator.Evaluator.Cmd , Calculator.Evaluator.Expr+ , Calculator.Evaluator.Func , Calculator.Evaluator.Statement+ , Calculator.Help+ , Calculator.Parser.Base , Calculator.Parser.Cmd , Calculator.Parser.Expr , Calculator.Parser.Statement- , Calculator.Prim.Base+ , Calculator.Prim.Bindings , Calculator.Prim.Cmd+ , Calculator.Prim.Definitions , Calculator.Prim.Expr+ , Calculator.Prim.Function , Calculator.Prim.Statement , Model.Arithmetic hs-source-dirs: tests/ src/ build-depends: QuickCheck >= 2.7.6 && <2.7.7 , base >=4.7 && <4.8+ , containers >= 0.5.5.1 && <0.5.6.0 , mtl >= 2.2.1 , parsec >=3.1.7 && <3.2 ghc-options: -Wall
src/Calculator/Evaluator/Base.hs view
@@ -4,7 +4,8 @@ import Calculator.Evaluator.Statement (evalStat) import Calculator.Parser.Statement (parseStat)-import Calculator.Prim.Expr (Bindings, Expr (..))+import Calculator.Prim.Bindings (Bindings, mkBind)+import Calculator.Prim.Expr (Expr (..)) -------------------------------------------------------------------------------- @@ -38,7 +39,7 @@ -------------------------------------------------------------------------------- evalTest :: String -> String-evalTest s = case eval ([], []) s of+evalTest s = case eval (mkBind [] []) s of Left (Constant n) -> show n _ -> ""
src/Calculator/Evaluator/Cmd.hs view
@@ -2,23 +2,25 @@ -------------------------------------------------------------------------------- -import Calculator.Evaluator.Expr (evalExpr)-import Calculator.Evaluator.Func (mkFun)-import Calculator.Help (help)-import Calculator.Prim.Cmd (Cmd (..))-import Calculator.Prim.Expr (Bindings, Expr (Message, Constant),- addFun, addVar, defBinds)+import Calculator.Evaluator.Expr (evalExpr)+import Calculator.Evaluator.Func (execFunc)+import Calculator.Help (help)+import Calculator.Prim.Bindings (Bindings, addFun, addVar, display)+import Calculator.Prim.Cmd (Cmd (..))+import Calculator.Prim.Definitions (defBinds)+import Calculator.Prim.Expr (Expr (Message, Constant)) -------------------------------------------------------------------------------- evalCmd :: Bindings -> Cmd -> Either [String] Bindings-evalCmd _ (Help) = Left help-evalCmd _ (Reset) = Right defBinds+evalCmd _ Help = Left help+evalCmd b Display = Left $ display b+evalCmd _ Reset = Right defBinds evalCmd b (Assign s e) = case evalExpr b e of Message xxs -> Left xxs Constant c -> Right $ addVar (s, c) b _ -> Left [" ~~ Erroneous Result ~~ "]-evalCmd b f@(Func i _ _) = Right $ addFun (i, mkFun b f) b+evalCmd b f@(Func i _ _) = Right $ addFun (i, execFunc b f) b --------------------------------------------------------------------------------
src/Calculator/Evaluator/Expr.hs view
@@ -2,34 +2,46 @@ -------------------------------------------------------------------------------- -import Calculator.Prim.Base (Number)-import Calculator.Prim.Expr (Bindings, Expr (..), Operator (..),- joinMessage)+import Calculator.Prim.Bindings (Bindings, getFun, getVar)+import Calculator.Prim.Expr (Expr (..), Operator (..),+ joinMessage, isConst)+import Calculator.Prim.Function (Function (..)) -------------------------------------------------------------------------------- -evalExpr :: Bindings -> Expr -> Expr-evalExpr _ e@(Constant _) = 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++evalExpr :: Bindings -> Expr -> Expr+evalExpr _ e@(Constant _) = e+evalExpr _ e@(Message _) = e+evalExpr b (BinOp (e, r)) = process b e r+evalExpr b (Variable s) =+ case getVar s b of 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 -> Message ["Unknown function " ++ show f]- Just g -> Constant $ g x- r@(Message _) -> r- _ -> Message ["Recieved Impossible result from evalExpr"]+evalExpr b (Call f args) =+ let argVals = map (evalExpr b) args+ in if all isConst argVals+ then fapply b f (map (\(Constant x) -> x) argVals)+ else getMessage argVals evalExpr _ _ = Message ["Could not find suitable pattern for evalExpr"] -------------------------------------------------------------------------------- +fapply :: Bindings -> String -> [Double] -> Expr+fapply b f args = case getFun f b of+ Nothing -> Message ["Unknown function " ++ show f]+ Just g -> case apply g args of+ Left m -> Message m+ Right v -> Constant v++--------------------------------------------------------------------------------++getMessage :: [Expr] -> Expr+getMessage xs = foldr joinMessage (Message []) xs++--------------------------------------------------------------------------------+ process :: Bindings -> Expr -> [(Operator, Expr)] -> Expr process bind expr rest = evalExpr bind $ foldl (evalPart bind) expr rest @@ -38,11 +50,8 @@ evalPart :: Bindings -> Expr -> (Operator, Expr) -> Expr evalPart b e1 ((BinaryOp op), e2) = case (evalExpr b e1, evalExpr b e2) of- (Constant n1, Constant n2) -> Constant $ op n1 n2- (e@(Message _), f@(Message _)) -> joinMessage e f- (_, e@(Message _)) -> e- (e@(Message _), _) -> e- _ -> Message ["Could not find matching pairs for evalPart"]+ (Constant n1, Constant n2) -> Constant $ op n1 n2+ (msg1, msg2) -> joinMessage msg1 msg2 evalPart _ _ _ = Message ["Could not find suitable pattern for evalPart"] --------------------------------------------------------------------------------
src/Calculator/Evaluator/Func.hs view
@@ -2,17 +2,21 @@ -------------------------------------------------------------------------------- -import Calculator.Prim.Base (Number)-import Calculator.Prim.Cmd (Cmd(Func))-import Calculator.Prim.Expr (addVar, Bindings, Expr(Constant))-import Calculator.Evaluator.Expr (evalExpr)+import Calculator.Evaluator.Expr (evalExpr)+import Calculator.Prim.Bindings (Bindings, appendVars)+import Calculator.Prim.Cmd (Cmd (Func))+import Calculator.Prim.Expr (Expr (Constant, Message))+import Calculator.Prim.Function (Function, mkFuncEither) -------------------------------------------------------------------------------- -mkFun :: Bindings -> Cmd -> (Number -> Number)-mkFun b (Func _ x e) = \v -> case evalExpr (addVar (x, v) b) e of- Constant z -> z- _ -> error "Invalid Result"-mkFun _ _ = error "Making function from invalid cmd"+execFunc :: Bindings -> Cmd -> Function Double+execFunc b (Func _ args e) =+ mkFuncEither (length args) $ \xs ->+ case evalExpr (appendVars (zip args xs) b) e of+ Constant z -> Right z+ Message ms -> Left ms+ _ -> error "Invalid Result"+execFunc _ _ = error "Making function from invalid cmd" --------------------------------------------------------------------------------
src/Calculator/Evaluator/Statement.hs view
@@ -4,7 +4,8 @@ import Calculator.Evaluator.Cmd (evalCmd) import Calculator.Evaluator.Expr (evalExpr)-import Calculator.Prim.Expr (Bindings, Expr (Message))+import Calculator.Prim.Bindings (Bindings)+import Calculator.Prim.Expr (Expr (Message)) import Calculator.Prim.Statement (Statement (..)) --------------------------------------------------------------------------------
src/Calculator/Help.hs view
@@ -2,28 +2,29 @@ -------------------------------------------------------------------------------- -import Calculator.Prim.Expr (binaryOps, dispatch, defVars)+import Calculator.Prim.Definitions (binaryOps, defFuns, defVars) -------------------------------------------------------------------------------- -import Data.List (intersperse, intercalate)+import Data.List (intercalate, intersperse) -------------------------------------------------------------------------------- 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"+ , " :var x=pi -- Binds x to pi"+ , " :func f(x)=x+1 -- Binds f(x) to \"x + 1\""+ , " :func f(x,y)=x+y -- 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)+ , " " ++ intercalate ", " (map fst defFuns) ] --------------------------------------------------------------------------------
src/Calculator/Parser/Base.hs view
@@ -2,27 +2,23 @@ -------------------------------------------------------------------------------- -import Calculator.Prim.Base (Number)------------------------------------------------------------------------------------import Control.Monad (liftM2)-import Control.Applicative ((<$>))-import Text.ParserCombinators.Parsec+import Control.Applicative ((<$>))+import Control.Monad (liftM2)+import Text.ParserCombinators.Parsec -------------------------------------------------------------------------------- -parseNumber :: Parser Number+parseNumber :: Parser Double parseNumber = read <$> do+ neg <- optionMaybe (char '-') dec <- many1 digit flt <- option "" (liftM2 (:) (char '.') (many1 digit))- return $ if null flt- then dec- else dec ++ flt+ return $ let num = dec ++ flt+ in maybe num (:num) neg -------------------------------------------------------------------------------- parseId :: Parser String-parseId = (liftM2 (:) letter (many (letter <|> digit)))+parseId = liftM2 (:) letter (many (letter <|> digit)) --------------------------------------------------------------------------------
src/Calculator/Parser/Cmd.hs view
@@ -17,10 +17,14 @@ parseCmd = char ':' >> parseCmd' ----------------------------------------------------------------------------------- cmd' -> reset | assign+-- cmd' -> show | help | reset | assign parseCmd' :: Parser Cmd-parseCmd' = parseHelp <|> parseReset <|> parseAssign <|> parseFunc+parseCmd' = parseShow+ <|> parseHelp+ <|> parseReset+ <|> parseAssign+ <|> parseFunc -------------------------------------------------------------------------------- -- help -> "?" | "help"@@ -31,6 +35,12 @@ -------------------------------------------------------------------------------- -- reset -> "reset" +parseShow :: Parser Cmd+parseShow = string "show" >> return Display++--------------------------------------------------------------------------------+-- reset -> "reset"+ parseReset :: Parser Cmd parseReset = string "reset" >> return Reset @@ -50,13 +60,13 @@ parseFunc :: Parser Cmd parseFunc = do- _ <- string "func "- str <- parseId- _ <- char '('- arg <- parseId- _ <- char ')'- _ <- char '='- ex <- parseExpr- return $ Func str arg ex+ _ <- string "func "+ str <- parseId+ _ <- char '('+ args <- sepBy parseId (char ',')+ _ <- char ')'+ _ <- char '='+ ex <- parseExpr+ return $ Func str args ex --------------------------------------------------------------------------------
src/Calculator/Parser/Expr.hs view
@@ -3,8 +3,8 @@ -------------------------------------------------------------------------------- import Calculator.Parser.Base (parseId, parseNumber)-import Calculator.Prim.Expr (Expr (..), Operator, binaryOps,- constEq)+import Calculator.Prim.Definitions (binaryOps)+import Calculator.Prim.Expr (Expr (..), Operator, constEq) -------------------------------------------------------------------------------- @@ -67,12 +67,18 @@ return (op, fact) ----------------------------------------------------------------------------------- val -> func? ( expr ) | number--- Parentheses can be parsed as function calls with no function+-- val -> ( expr ) | func ( expr ) | var | number parseVal :: Parser Expr-parseVal = parseCall <|> parseVariable <|> parseConstant+parseVal = parseBrackets <|> parseCall <|> parseVariable <|> parseConstant +parseBrackets :: Parser Expr+parseBrackets = do+ _ <- try (char '(')+ e <- parseExpr+ _ <- char ')'+ return e+ parseVariable :: Parser Expr parseVariable = Variable <$> parseId @@ -81,11 +87,8 @@ parseCall :: Parser Expr parseCall = do- ident <- try (optionMaybe parseId <* char '(')- expr <- parseExpr- _ <- char ')'- return $ case ident of- Nothing -> expr- Just s -> Function s expr+ ident <- try (parseId <* char '(')+ args <- (parseExpr `sepBy` char ',') <* char ')'+ return $ Call ident args --------------------------------------------------------------------------------
− src/Calculator/Prim/Base.hs
@@ -1,7 +0,0 @@-module Calculator.Prim.Base where------------------------------------------------------------------------------------type Number = Double----------------------------------------------------------------------------------
+ src/Calculator/Prim/Bindings.hs view
@@ -0,0 +1,68 @@+module Calculator.Prim.Bindings+ ( Bindings+ , mkBind+ , addVar+ , getVar+ , appendVars+ , addFun+ , getFun+ , display+ ) where++--------------------------------------------------------------------------------++import Calculator.Prim.Function (Function)++--------------------------------------------------------------------------------++import qualified Data.Map as M++--------------------------------------------------------------------------------++-- | Represents variable and function bindings+data Bindings = Bindings {+ varMap :: M.Map String Double+ , funMap :: M.Map String (Function Double)+ }++--------------------------------------------------------------------------------++-- | Make a new binding from two alists+mkBind :: [(String, Double)] -> [(String, Function Double)] -> Bindings+mkBind vars funs = Bindings {+ varMap = M.fromList vars+ , funMap = M.fromList funs+ }++--------------------------------------------------------------------------------++-- | Add a variable to @Bindings@+addVar :: (String, Double) -> Bindings -> Bindings+addVar (s, n) b = b { varMap = M.insert s n (varMap b) }++-- | Get a variable from @Bindings@+getVar :: String -> Bindings -> Maybe Double+getVar s b = M.lookup s (varMap b)++-- | Add a list of variables to @Bindings@+appendVars :: [(String, Double)] -> Bindings -> Bindings+appendVars alist b = foldr addVar b alist++--------------------------------------------------------------------------------++-- | Add a @Function@ to @Bindings@+addFun :: (String, Function Double) -> Bindings -> Bindings+addFun (s, f) b = b { funMap = M.insert s f (funMap b) }++-- | Get a @Function@ from @Bindings@+getFun :: String -> Bindings -> Maybe (Function Double)+getFun s b = M.lookup s (funMap b)++--------------------------------------------------------------------------------++-- | Display all variables+display :: Bindings -> [String]+display b = let alist = M.assocs (varMap b)+ in map (\(s, n) -> s ++ " = " ++ show n) alist++--------------------------------------------------------------------------------
src/Calculator/Prim/Cmd.hs view
@@ -1,4 +1,4 @@-module Calculator.Prim.Cmd where+module Calculator.Prim.Cmd ( Cmd (..) ) where -------------------------------------------------------------------------------- @@ -6,9 +6,11 @@ -------------------------------------------------------------------------------- +-- | Represents a command given to the calculator data Cmd = Assign String Expr- | Func String String Expr+ | Func String [String] Expr | Help | Reset+ | Display --------------------------------------------------------------------------------
+ src/Calculator/Prim/Definitions.hs view
@@ -0,0 +1,66 @@+module Calculator.Prim.Definitions + ( binaryOps+ , defVars+ , defFuns+ , defBinds+ ) where++--------------------------------------------------------------------------------++import Calculator.Prim.Bindings (Bindings, mkBind)+import Calculator.Prim.Expr (Operator (..))+import Calculator.Prim.Function (Function, oneArg)++--------------------------------------------------------------------------------++import Control.Arrow (second)++--------------------------------------------------------------------------------++-- | Binary Operators+binaryOps :: [(Char, Operator)]+binaryOps = [ ('+', BinaryOp (+))+ , ('-', BinaryOp (-))+ , ('*', BinaryOp (*))+ , ('/', BinaryOp (/))+ , ('^', BinaryOp (**))+ ]++--------------------------------------------------------------------------------++-- | List of pre-defined @Functions@+defFuns :: [(String, Function Double)]+defFuns = map (second oneArg)+ [ ("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)+ ]++--------------------------------------------------------------------------------++-- | List of provided variables+defVars :: [(String, Double)]+defVars = [ ("pi", pi)+ , ("e", exp 1)+ ]++--------------------------------------------------------------------------------++-- | Default bindings, created using defVars and defFuns+defBinds :: Bindings+defBinds = mkBind defVars defFuns++--------------------------------------------------------------------------------
src/Calculator/Prim/Expr.hs view
@@ -1,79 +1,36 @@-module Calculator.Prim.Expr where------------------------------------------------------------------------------------import Calculator.Prim.Base (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)+module Calculator.Prim.Expr + ( Expr (..)+ , Operator (..)+ , constEq+ , isConst+ , joinMessage+ ) where -------------------------------------------------------------------------------- -data Expr = Function String Expr- | Constant Number+-- | Represents an expression-tree+data Expr = Constant Double+ | Call String [Expr] | UnOp Operator Expr | BinOp (Expr, [(Operator, Expr)]) | Variable String | Message [String] -data Operator = UnaryOp (Number -> Number)- | BinaryOp (Number -> Number -> Number)------------------------------------------------------------------------------------binaryOps :: [(Char, Operator)]-binaryOps = [ ('+', BinaryOp (+))- , ('-', BinaryOp (-))- , ('*', BinaryOp (*))- , ('/', BinaryOp (/))- , ('^', BinaryOp (**))- ]--dispatch :: [(String, Number -> Number)]-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)- ]+-- | Represents an operator+data Operator = UnaryOp (Double -> Double)+ | BinaryOp (Double -> Double -> Double) -------------------------------------------------------------------------------- +-- | Check whether two expressions are the same numeric value+-- assuming they have been evaluated fully constEq :: Expr -> Expr -> Bool constEq (Constant x) (Constant y) = x == y constEq _ _ = False -------------------------------------------------------------------------------- -defVars :: [(String, Number)]-defVars = [ ("pi", pi)- , ("e", exp 1)- ]--defBinds :: Bindings-defBinds = (defVars, dispatch)-----------------------------------------------------------------------------------+-- | Checks whether an expression is a constant isConst :: Expr -> Bool isConst (Constant _) = True isConst _ = False@@ -82,6 +39,8 @@ joinMessage :: Expr -> Expr -> Expr joinMessage (Message e1) (Message e2) = Message (e1 ++ e2)-joinMessage _ _ = error "joinError used on non-error Expr"+joinMessage m@(Message _) _ = m+joinMessage _ m@(Message _) = m+joinMessage _ _ = error "joinMessage used on non-message Expr" --------------------------------------------------------------------------------
+ src/Calculator/Prim/Function.hs view
@@ -0,0 +1,52 @@+module Calculator.Prim.Function+ ( Function+ , apply+ , mkFunc+ , mkFuncEither+ , oneArg+ , partial+ ) where++--------------------------------------------------------------------------------++-- | Represents a function, where rank == No. of arguments+data Function a = Function {+ arity :: Int+ , apply :: [a] -> Either [String] a+ }++--------------------------------------------------------------------------------++-- | Make a @Function@ out of an arity and another function+mkFunc :: Int -> ([a] -> a) -> Function a+mkFunc a f = mkFuncEither a (Right . f)++--------------------------------------------------------------------------------++-- | Make a @Function@ with an arity using an error giving function+mkFuncEither :: Int -> ([a] -> Either [String] a) -> Function a+mkFuncEither a f = Function { arity = a , apply = g }+ where g xs = if length xs == a+ then f xs+ else Left $ [ "Invalid no. of arguments"+ , "Required: " ++ show a+ , "Provided: " ++ show (length xs)+ ]++--------------------------------------------------------------------------------++-- | Make a @Function@ out of a single argument function+oneArg :: (a -> a) -> Function a+oneArg f = mkFunc 1 (\ [x] -> f x)++--------------------------------------------------------------------------------++-- | Partially apply a function, thus creating a one-argument function.+-- To be used for parametrized functions, e.g getting g(x) = f(x,1,2)+-- this retains the free-variable 'x'+partial :: Function a -> [a] -> a -> Maybe a+partial f xs x = case apply f (x:xs) of+ Left _ -> Nothing+ Right v -> Just v++--------------------------------------------------------------------------------
src/Calculator/Prim/Statement.hs view
@@ -1,9 +1,9 @@-module Calculator.Prim.Statement where+module Calculator.Prim.Statement ( Statement (..) ) where -------------------------------------------------------------------------------- -import Calculator.Prim.Cmd (Cmd)-import Calculator.Prim.Expr (Expr)+import Calculator.Prim.Cmd (Cmd)+import Calculator.Prim.Expr (Expr) -------------------------------------------------------------------------------- -- stmt -> cmd | expr
src/Main.hs view
@@ -2,16 +2,17 @@ -------------------------------------------------------------------------------- -import Paths_calculator (version)+import Paths_calculator (version) -------------------------------------------------------------------------------- -import Calculator.Evaluator.Base (evaluate)-import Calculator.Prim.Expr (Bindings, defBinds)+import Calculator.Evaluator.Base (evaluate)+import Calculator.Prim.Bindings (Bindings)+import Calculator.Prim.Definitions (defBinds) -------------------------------------------------------------------------------- -import Data.Version (showVersion)+import Data.Version (showVersion) import System.Console.Haskeline --------------------------------------------------------------------------------@@ -37,5 +38,6 @@ ++ showVersion version ++ ". Use :? for help." runInputT defaultSettings (repl defBinds)+ putStrLn "Please report issues at: github.com/sumitsahrawat/calculator/issues" --------------------------------------------------------------------------------
src/Model/Arithmetic.hs view
@@ -3,7 +3,6 @@ -------------------------------------------------------------------------------- import Calculator.Parser.Base (parseNumber)-import Calculator.Prim.Base (Number) -------------------------------------------------------------------------------- @@ -20,12 +19,12 @@ -------------------------------------------------------------------------------- -expr :: Parser Number+expr :: Parser Double expr = buildExpressionParser table factor <?> "Expression" -------------------------------------------------------------------------------- -table :: [[ Operator Char st Number ]]+table :: [[ Operator Char st Double ]] table = [ [ op "^" (**) AssocRight ] , [ op "*" (*) AssocLeft, op "/" (/) AssocLeft ] , [ op "+" (+) AssocLeft, op "-" (-) AssocLeft ]@@ -34,7 +33,7 @@ -------------------------------------------------------------------------------- -parseFactor :: Parser Number+parseFactor :: Parser Double parseFactor = do _ <- char '(' x <- expr@@ -43,7 +42,7 @@ -------------------------------------------------------------------------------- -factor :: Parser Number+factor :: Parser Double factor = parseFactor <|> parseNumber --------------------------------------------------------------------------------
tests/Arithmetic.hs view
@@ -3,7 +3,6 @@ -------------------------------------------------------------------------------- import Calculator.Evaluator.Base (evalTest)-import Calculator.Prim.Base (Number) import Model.Arithmetic --------------------------------------------------------------------------------@@ -32,7 +31,7 @@ genOp = elements operators genArg :: Gen String-genArg = show . abs <$> (arbitrary :: Gen Number)+genArg = show . abs <$> (arbitrary :: Gen Double) genExprString :: Gen String genExprString = liftM concat .