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)
 
 import Data.Map (Map)
 import qualified Data.Map as Map
@@ -10,31 +10,29 @@ import Data.Ratio
 
 import System.IO
 
-initVars :: Map String Rational
-initVars = Map.fromList [("pi", 245850922 % 78256779), ("e", 271801 % 99990)]
-
 main :: IO ()
-main = ioLoop initVars
+main = ioLoop
 
 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 "")
+showRatio p r = (if (r < 0) then "-" else "") ++ prepoint_digits ++ "." ++ postpoint_digits
     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 = (take p) . (drop (length prepoint_digits)) . show . round . abs $ (r * 10^p)
 
-useResult :: Map String Rational -> Either ParseError Expr -> String
+useResult (Right e) = (showRatio precision) . evaluate $ replaceVars e vars
-useResult vs (Right expr)  = either id ((showRatio precision) . evaluate) $ replaceVars expr vs
+useResult (Left  e) = show e
-useResult vs (Left  error) = show error
 
-ioLoop :: Map String Rational -> IO ()
+vars :: Map String Rational
-ioLoop vs = do done <- isEOF
+vars = Map.fromList [("pi", 245850922 % 78256779), ("e", 271801 % 99990)]
-               if done
+
-                 then putStrLn "Quit!"
+ioLoop :: IO ()
-                 else do inp <- getLine
+ioLoop = do done <- isEOF
-                         let expr = parse exprparser "<stdin>" inp
+            if done
-			 let uvs  = either (const vs) (\e -> Map.unionWith (flip const) vs (extractVariableDefinitions e)) expr
+              then putStrLn "Quit!"
-                         putStrLn $ useResult uvs expr
+              else do inp <- getLine
-                         ioLoop uvs
+                      let expr = parse exprparser "<stdin>" inp
+                      putStrLn . useResult $ expr
+                      ioLoop
 

src/Lib.hs

@@ -1,5 +1,5 @@
 module Lib
-    ( exprparser, evaluate, replaceVars, Expr, extractVariableDefinitions
+    ( exprparser, evaluate, replaceVars 
     ) 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
     deriving Show
 data BinaryOperator = Plus | Minus | Multiply | Divide | Power
     deriving Show
@@ -73,42 +73,9 @@ 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
+    let denominator = 10 ^ (decimal_length + natural_length - 1)
     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)
@@ -120,6 +87,16 @@ 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
@@ -127,4 +104,3 @@ 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"