Expression parsing and evaluation

src/Lib.hs

@@ -12,11 +12,9 @@ import Text.Parsec.Expr
 import Text.Parsec.Token
 import Text.Parsec.Language
 
-data Expr = Var String | Constant Integer | Unary UnaryOperator Expr | Binary BinaryOperator Expr Expr
+data Expr = Variable String | Constant Rational | Binary BinaryOperator Expr Expr
     deriving Show
-data UnaryOperator = Not
+data BinaryOperator = Plus | Minus | Multiply | Divide | Power
-    deriving Show
-data BinaryOperator = Plus | Minus | Multiply | Divide
     deriving Show
 
 naturalRatio a = a % 1
@@ -25,9 +23,9 @@ def = emptyDef{ commentStart = ""
               , commentEnd = ""
               , identStart = letter <|> char '_'
               , identLetter = alphaNum <|> char '_'
-              , opStart = oneOf "+-/*"
+              , opStart = oneOf "+-/*^"
-              , opLetter = oneOf "+-/*"
+              , opLetter = oneOf "+-/*^"
-              , reservedOpNames = ["+", "-", "/", "*"]
+              , reservedOpNames = ["+", "-", "/", "*", "^"]
               , reservedNames = ["pi", "e"]
               }
 
@@ -37,12 +35,16 @@ TokenParser{ parens = m_parens
            , reserved   = m_reserved
            , semiSep1   = m_semiSep1
            , natural    = m_natural
+           , integer    = m_integer
            , whiteSpace = m_whiteSpace } = makeTokenParser def
 
 exprparser :: Parser Expr
 exprparser = buildExpressionParser table term <?> "expression"
 
 table = [
+            [
+                Infix (m_reservedOp "^" >> return (Binary Power)) AssocLeft
+            ],
             [
                 Infix (m_reservedOp "*" >> return (Binary Multiply)) AssocLeft,
                 Infix (m_reservedOp "/" >> return (Binary Divide)) AssocLeft
@@ -53,6 +55,43 @@ table = [
             ]
         ]
 
+constantInteger :: Parser Rational
+constantInteger = try (do
+        n <- m_integer
+        notFollowedBy . char $ '.'
+        return (n % 1)
+    )
+
+constantRational :: Parser Rational
+constantRational = do
+    natural <- m_natural
+    _       <- char '.'
+    decimal <- m_natural
+    let natural_length = length . show $ natural
+    let decimal_length = length . show $ decimal
+    let numerator   = natural * (10 ^ decimal_length) + decimal
+    let denominator = 10 ^ (decimal_length + natural_length - 2)
+    return (numerator % denominator)
+
+{-
+ - a/b ^ c/d
+ - (a ^ c/d) / b ^ (c/d)
+ - root(a ^ c, d) / root(b ^ c, d)
+ -}
+rationalPower :: Rational -> Rational -> Rational
+rationalPower a b = rationalPower' (numerator a, denominator a) (numerator b, denominator b)
+    where
+        rationalPower' (a, b) (c, 1) = a ^ c % b ^ c
+
 term = m_parens exprparser
-       <|> fmap Var m_identifier
+       <|> fmap Variable m_identifier
-       <|> fmap Constant m_natural
+       <|> fmap Constant constantInteger
+       <|> fmap Constant constantRational
+
+evaluate :: Expr -> Rational
+evaluate (Constant c) = c
+evaluate (Binary Plus     a b) = evaluate a + evaluate b
+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)