diff --git a/app/Main.hs b/app/Main.hs index 5644a65..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) +import Lib (exprparser, evaluate, replaceVars, Expr, extractVariableDefinitions) import Data.Map (Map) import qualified Data.Map as Map @@ -10,29 +10,31 @@ import Data.Ratio import System.IO +initVars :: Map String Rational +initVars = Map.fromList [("pi", 245850922 % 78256779), ("e", 271801 % 99990)] + main :: IO () -main = ioLoop +main = ioLoop initVars precision = 5 :: Int showRatio :: Int -> Rational -> String -showRatio p r = (if (r < 0) then "-" else "") ++ prepoint_digits ++ "." ++ postpoint_digits +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 = (take p) . (drop (length prepoint_digits)) . show . round . abs $ (r * 10^p) + postpoint_digits = reverse . dropWhile (=='0') . reverse .(take p) . (drop (length prepoint_digits)) . show . round . abs $ (r * 10^p) -useResult (Right e) = (showRatio precision) . evaluate $ replaceVars e vars -useResult (Left e) = show e +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 -vars :: Map String Rational -vars = Map.fromList [("pi", 245850922 % 78256779), ("e", 271801 % 99990)] - -ioLoop :: IO () -ioLoop = do done <- isEOF - if done - then putStrLn "Quit!" - else do inp <- getLine - let expr = parse exprparser "" inp - putStrLn . useResult $ expr - ioLoop +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 diff --git a/src/Lib.hs b/src/Lib.hs index 2b24d47..ceee931 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -1,5 +1,5 @@ module Lib - ( exprparser, evaluate, replaceVars + ( 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 +data Expr = Variable String | Constant Rational | Binary BinaryOperator Expr Expr | VariableDefinition String Rational deriving Show data BinaryOperator = Plus | Minus | Multiply | Divide | Power deriving Show @@ -73,9 +73,42 @@ constantRational = do let natural_length = length . show $ natural let decimal_length = length decimal_digits let numerator = natural * (10 ^ decimal_length) + decimal - let denominator = 10 ^ (decimal_length + natural_length - 1) + let denominator = 10 ^ decimal_length return (numerator % denominator) +variableDefinition :: Parser Expr +variableDefinition = try (do + name <- m_identifier + _ <- char '=' + value <- constantInteger <|> constantRational + return (VariableDefinition name value) + ) + +term = m_parens exprparser + <|> variableDefinition + <|> fmap Variable m_identifier + <|> 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 + +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 (Binary op l r) vs = case leftBranch of + Left s -> Left s + Right a -> case rightBranch of + Left s -> Left s + Right b -> Right $ Binary op a b + where + leftBranch = replaceVars l vs + rightBranch = replaceVars r vs + {- - a/b ^ c/d - (a ^ c/d) / b ^ (c/d) @@ -87,16 +120,6 @@ rationalPower a b = rationalPower' (numerator a, denominator a) (numerator b, de rationalPower' (a, b) (c, 1) = a ^ c % b ^ c rationalPower' _ _ = error "Powers with unnatural numbers are not supported yet" -term = m_parens exprparser - <|> fmap Variable m_identifier - <|> fmap Constant constantInteger - <|> fmap Constant constantRational - -replaceVars :: Expr -> Map.Map String Rational -> Expr -replaceVars (Variable name) vs = Constant . maybe (0 % 1) id $ Map.lookup name vs -replaceVars (Binary op a b) vs = Binary op (replaceVars a vs) (replaceVars b vs) -replaceVars (Constant c) vs = Constant c - evaluate :: Expr -> Rational evaluate (Constant c) = c evaluate (Binary Plus a b) = evaluate a + evaluate b @@ -104,3 +127,4 @@ evaluate (Binary Minus a b) = evaluate a - evaluate b evaluate (Binary Divide a b) = evaluate a / evaluate b evaluate (Binary Multiply a b) = evaluate a * evaluate b evaluate (Binary Power a b) = rationalPower (evaluate a) (evaluate b) +evaluate (Variable _) = error "Unreachable Code"