diff --git a/app/Main.hs b/app/Main.hs index 669c576..6252a07 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) +import Lib (exprparser, evaluate, replaceVars, Expr, extractVariableDefinitions, updateVariables) import Data.Map (Map) import qualified Data.Map as Map @@ -21,20 +21,27 @@ 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 -> Either ParseError Expr -> String -useResult vs (Right expr) = either id ((showRatio precision) . evaluate) $ replaceVars expr vs -useResult vs (Left error) = show error +useResult :: Map String Rational -> Expr -> String +useResult vs expr = either id ((showRatio precision) . evaluate) $ replaceVars expr vs ioLoop :: Map String Rational -> IO () ioLoop vs = do done <- isEOF if done then putStrLn "Quit!" else do inp <- getLine - 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 + 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) diff --git a/src/Lib.hs b/src/Lib.hs index ceee931..837103c 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -1,5 +1,5 @@ module Lib - ( exprparser, evaluate, replaceVars, Expr, extractVariableDefinitions + ( exprparser, evaluate, replaceVars, Expr, extractVariableDefinitions, updateVariables ) 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 Rational +data Expr = Variable String | Constant Rational | Binary BinaryOperator Expr Expr | VariableDefinition String Expr 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 <- constantInteger <|> constantRational + value <- exprparser return (VariableDefinition name value) ) @@ -90,16 +90,29 @@ term = m_parens exprparser <|> fmap Constant constantInteger <|> fmap Constant constantRational -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 +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 e + Right uvs -> case replaceVars e uvs of + Left e -> Left e + Right exp -> Right $ Map.insert name (evaluate exp) uvs + where + nvs = extractVariableDefinitions e 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 _ value ) vs = Right $ Constant value +replaceVars (VariableDefinition name _) vs = replaceVars (Variable name) vs replaceVars (Binary op l r) vs = case leftBranch of Left s -> Left s Right a -> case rightBranch of @@ -107,7 +120,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