variables

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 :: Map String Rational -> Either ParseError Expr -> String
-useResult (Left  e) = show e
+useResult vs (Right expr)  = either id ((showRatio precision) . evaluate) $ replaceVars expr vs
+useResult vs (Left  error) = show error
 
-vars :: Map String Rational
+ioLoop :: Map String Rational -> IO ()
-vars = Map.fromList [("pi", 245850922 % 78256779), ("e", 271801 % 99990)]
+ioLoop vs = do done <- isEOF
-
+               if done
-ioLoop :: IO ()
+                 then putStrLn "Quit!"
-ioLoop = do done <- isEOF
+                 else do inp <- getLine
-            if done
+                         let expr = parse exprparser "<stdin>" inp
-              then putStrLn "Quit!"
+			 let uvs  = either (const vs) (\e -> Map.unionWith (flip const) vs (extractVariableDefinitions e)) expr
-              else do inp <- getLine
+                         putStrLn $ useResult uvs expr
-                      let expr = parse exprparser "<stdin>" inp
+                         ioLoop uvs
-                      putStrLn . useResult $ expr
-                      ioLoop
 

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"