variables
This commit is contained in:
parent
9e7ad28c5c
commit
3dc3e3b842
2 changed files with 54 additions and 37 deletions
25
app/Main.hs
25
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
|
||||
|
||||
|
|
@ -21,19 +24,17 @@ showRatio p r = (if (r < 0) then "-" else "") ++ prepoint_digits ++ (if (length
|
|||
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 :: 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
|
||||
ioLoop :: Map String Rational -> IO ()
|
||||
ioLoop vs = do done <- isEOF
|
||||
if done
|
||||
then putStrLn "Quit!"
|
||||
else do inp <- getLine
|
||||
let expr = parse exprparser "<stdin>" inp
|
||||
putStrLn . useResult $ expr
|
||||
ioLoop
|
||||
let uvs = either (const vs) (\e -> Map.unionWith (flip const) vs (extractVariableDefinitions e)) expr
|
||||
putStrLn $ useResult uvs expr
|
||||
ioLoop uvs
|
||||
|
||||
|
|
|
|||
56
src/Lib.hs
56
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
|
||||
|
|
|
|||
Loading…
Reference in a new issue