diff --git a/app/Main.hs b/app/Main.hs index 6252a07..669c576 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -2,7 +2,7 @@ module Main (main) where import Text.Parsec -import Lib (exprparser, evaluate, replaceVars, Expr, extractVariableDefinitions, updateVariables) +import Lib (exprparser, evaluate, replaceVars, Expr, extractVariableDefinitions) import Data.Map (Map) import qualified Data.Map as Map @@ -21,27 +21,20 @@ precision = 5 :: Int showRatio :: Int -> Rational -> String showRatio p r = (if (r < 0) then "-" else "") ++ prepoint_digits ++ (if (length postpoint_digits > 0) then ("." ++ postpoint_digits) else "") where - prepoint_digits = init . show . round . abs $ (r * 10) - postpoint_digits = reverse . dropWhile (=='0') . reverse .(take p) . (drop (length prepoint_digits)) . show . round . abs $ (r * 10^p) + prepoint_digits = init . show . round . abs $ (r * 10) + postpoint_digits = reverse . dropWhile (=='0') . reverse .(take p) . (drop (length prepoint_digits)) . show . round . abs $ (r * 10^p) -useResult :: Map String Rational -> Expr -> String -useResult vs expr = either id ((showRatio precision) . evaluate) $ replaceVars expr vs +useResult :: Map String Rational -> Either ParseError Expr -> String +useResult vs (Right expr) = either id ((showRatio precision) . evaluate) $ replaceVars expr vs +useResult vs (Left error) = show error ioLoop :: Map String Rational -> IO () ioLoop vs = do done <- isEOF if done then putStrLn "Quit!" else do inp <- getLine - let expr_res = parse exprparser "" inp - case expr_res of - Left err -> do - putStrLn . show $ err - ioLoop vs - Right expr -> do - let vardefs = extractVariableDefinitions expr - let uvs_res = updateVariables vardefs vs - case uvs_res of - Left err -> putStrLn err - Right uvs -> putStrLn $ useResult uvs expr - ioLoop (either (const vs) (id) uvs_res) + let expr = parse exprparser "" inp + let uvs = either (const vs) (\e -> Map.unionWith (flip const) vs (extractVariableDefinitions e)) expr + putStrLn $ useResult uvs expr + ioLoop uvs diff --git a/src/Lib.hs b/src/Lib.hs index 8e9a7e5..ceee931 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -1,5 +1,5 @@ module Lib - ( exprparser, evaluate, replaceVars, Expr, extractVariableDefinitions, updateVariables + ( exprparser, evaluate, replaceVars, Expr, extractVariableDefinitions ) where import Control.Applicative((<*)) @@ -14,7 +14,7 @@ import Text.Parsec.Expr import Text.Parsec.Token import Text.Parsec.Language -data Expr = Variable String | Constant Rational | Binary BinaryOperator Expr Expr | VariableDefinition String Expr +data Expr = Variable String | Constant Rational | Binary BinaryOperator Expr Expr | VariableDefinition String Rational deriving Show data BinaryOperator = Plus | Minus | Multiply | Divide | Power deriving Show @@ -80,7 +80,7 @@ variableDefinition :: Parser Expr variableDefinition = try (do name <- m_identifier _ <- char '=' - value <- exprparser + value <- constantInteger <|> constantRational return (VariableDefinition name value) ) @@ -90,29 +90,16 @@ term = m_parens exprparser <|> fmap Constant constantInteger <|> fmap Constant constantRational -extractVariableDefinitions :: Expr -> [(String,Expr)] -extractVariableDefinitions (VariableDefinition name value) = [(name, value)] -extractVariableDefinitions (Binary _ a b) = extractVariableDefinitions a ++ extractVariableDefinitions b -extractVariableDefinitions (Constant _) = [] -extractVariableDefinitions (Variable _) = [] - -updateVariables :: [(String, Expr)] -> Map String Rational -> Either String (Map String Rational) -updateVariables ds vs = foldl updateVariable (Right vs) ds - -updateVariable :: Either String (Map String Rational) -> (String, Expr) -> Either String (Map String Rational) -updateVariable (Left e) _ = Left e -updateVariable (Right vs) (name, e) = case updateVariables nvs vs of - Left e -> Left $ "In definition of variable '" ++ name ++ "':\n" ++ e - Right uvs -> case replaceVars e uvs of - Left e -> Left $ "In definition of variable '" ++ name ++ "':\n" ++ e - Right exp -> Right $ Map.insert name (evaluate exp) uvs - where - nvs = extractVariableDefinitions e +extractVariableDefinitions :: Expr -> Map.Map String Rational +extractVariableDefinitions (VariableDefinition name value) = Map.singleton name value +extractVariableDefinitions (Binary _ a b) = Map.union (extractVariableDefinitions a) (extractVariableDefinitions b) +extractVariableDefinitions (Constant _) = Map.empty +extractVariableDefinitions (Variable _) = Map.empty replaceVars :: Expr -> Map.Map String Rational -> Either String Expr replaceVars (Constant c) vs = Right $ Constant c replaceVars (Variable name) vs = maybe (Left ("Usage of unknown variable: '" ++ name ++ "'\nSuggestion: define the variable\n++ " ++ name ++ "=42")) (Right . Constant . id) $ Map.lookup name vs -replaceVars (VariableDefinition name _) vs = replaceVars (Variable name) vs +replaceVars (VariableDefinition _ value ) vs = Right $ Constant value replaceVars (Binary op l r) vs = case leftBranch of Left s -> Left s Right a -> case rightBranch of @@ -120,7 +107,7 @@ replaceVars (Binary op l r) vs = case leftBranch of Right b -> Right $ Binary op a b where leftBranch = replaceVars l vs - rightBranch = replaceVars r vs + rightBranch = replaceVars r vs {- - a/b ^ c/d @@ -130,9 +117,7 @@ replaceVars (Binary op l r) vs = case leftBranch of rationalPower :: Rational -> Rational -> Rational rationalPower a b = rationalPower' (numerator a, denominator a) (numerator b, denominator b) where - rationalPower' (a, b) (c, 1) - | c >= 0 = a ^ c % b ^ c - | otherwise = 1 / rationalPower (a % b) (-c % 1) + rationalPower' (a, b) (c, 1) = a ^ c % b ^ c rationalPower' _ _ = error "Powers with unnatural numbers are not supported yet" evaluate :: Expr -> Rational