diff --git a/app/Main.hs b/app/Main.hs index 167abc2..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) +import Lib (exprparser, evaluate, replaceVars, Expr, extractVariableDefinitions) import Data.Map (Map) import qualified Data.Map as Map @@ -10,8 +10,11 @@ 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 @@ -19,21 +22,19 @@ 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) + postpoint_digits = reverse . dropWhile (=='0') . reverse .(take p) . (drop (length prepoint_digits)) . show . round . abs $ (r * 10^p) -useResult :: Either ParseError Expr -> String -useResult (Right expr) = either id ((showRatio precision) . evaluate) $ replaceVars expr vars -useResult (Left error) = show error +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 b9c05aa..ceee931 100644 --- a/src/Lib.hs +++ b/src/Lib.hs @@ -1,5 +1,5 @@ module Lib - ( exprparser, evaluate, replaceVars, Expr + ( 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,23 +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 -> 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 (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 - evaluate :: Expr -> Rational evaluate (Constant c) = c evaluate (Binary Plus a b) = evaluate a + evaluate b