diff options
| -rw-r--r-- | manifest | 23 | ||||
| -rw-r--r-- | src/Assignment.hs | 25 | ||||
| -rw-r--r-- | src/Builtin.hs | 66 | ||||
| -rw-r--r-- | src/Evaluation.hs | 52 | ||||
| -rw-r--r-- | src/Expr.hs | 25 | ||||
| -rw-r--r-- | src/parser/Expr.hs | 27 |
6 files changed, 141 insertions, 77 deletions
@@ -94,3 +94,26 @@ i^1 = sqrt(-1) = i i^2 = -1 i^3 = -sqrt(-1) = -i i^4 = 1 + + + + + +atoms: evaluate to itself +- rational +- imaginary +- complex + +containers: evaluate contained +- matrix +- variable? +- f() ? + +operations: +- + +- - +- * +- / +- % +- ^ +- ** diff --git a/src/Assignment.hs b/src/Assignment.hs index 51e619a..2dc7aef 100644 --- a/src/Assignment.hs +++ b/src/Assignment.hs @@ -1,23 +1,42 @@ module Assignment where +import Data.List import qualified Expr as E data Assignment = Variable String E.Expr | Function String String E.Expr - deriving (Eq) + +instance Eq Assignment where + (Variable n1 _) == (Variable n2 _) = n1 == n2 + (Function n1 _ _) == (Function n2 _ _) = n1 == n2 + _ == _ = False name :: Assignment -> String name (Variable n _) = n name (Function n _ _) = n +-- data Context a = Context { vars :: [Assignment], payload :: a } type Context = [Assignment] +-- instance Functor Context where +-- fmap f (Context as x) = Context as (f x) +-- +-- instance Applicative Context where +-- pure x = Context [] x +-- (Context a1 f) <*> (Context a2 x) = Context (a1 `union` a2) (f x) +-- +-- instance Monad Context where +-- return = pure +-- (Context a1 x) >>= f = Context (vars res `union` a1) (payload res) +-- where res = f x + + update :: Context -> Assignment -> Context update context a - | name a `elem` map name context = map replaceIf context + | a `elem` context = map replaceIf context | otherwise = a:context - where replaceIf a' = if name a' == name a then a else a' + where replaceIf a' = if a' == a then a else a' get :: Context -> String -> Maybe Assignment get context n = case found of [] -> Nothing diff --git a/src/Builtin.hs b/src/Builtin.hs new file mode 100644 index 0000000..8287d5a --- /dev/null +++ b/src/Builtin.hs @@ -0,0 +1,66 @@ +module Builtin where + + +builtinAdd :: Expr -> Expr -> Maybe Expr + +builtinAdd (Rational a) (Rational b) = Just $ Rational (a + b) +builtinAdd (Rational a) (Imaginary b) = Just $ Complex a b +builtinAdd (Rational a) (Complex br bi) = Just $ Complex (br + a) bi + +builtinAdd (Imaginary a) (Imaginary b) = Just $ Imaginary (a + b) +builtinAdd (Imaginary a) (Rational b) = Just $ Complex b a +builtinAdd (Imaginary a) (Complex br bi) = Just $ Complex br (a + bi) + +builtinAdd (Complex ar ai) (Complex br bi) = Just $ Complex (ar + br) (ai + bi) +builtinAdd (Complex ar ai) (Rational b) = Just $ Complex (ar + b) ai +builtinAdd (Complex ar ai) (Imaginary b) = Just $ Complex ar (ai + b) + +builtinAdd _ _ = Nothing + + +builtinSub :: Expr -> Expr -> Maybe Expr +builtinSub a b = a `builtinAdd` ((Rational (-1)) `builtinMul` b) +builtinSub _ _ = Nothing + + +-- could be derived from addition +builtinMul :: Expr -> Expr -> Maybe Expr +builtinMul (Rational a) (Rational b) = Just $ Ratinal (a * b) +builtinMul (Rational a) (Imaginary b) = Just $ Imaginary (a * b) +builtinMul (Rational a) (Complex br bi) = Just $ Complex (a * br) (a * bi) + +builtinMul (Imaginary a) (Imaginary b) = Just $ Imaginary (a * b) +builtinMul (Imaginary a) (Rational b) = Just $ Complex b a +builtinMul (Imaginary a) (Complex br bi) = Just $ Complex (a * br) (a * bi) + +builtinMul _ _ = Nothing + + +builtinDiv :: Expr -> Expr -> Maybe Expr +builtinDiv _ (Rational 0) = Nothing +builtinDiv _ (Imaginary 0) = Nothing +builtinDiv _ (Complex 0 0) = Nothing +builtinDiv a b = Just $ a `builtinMul` (b `builtinExp` (Rational -1)) +builtinDiv _ _ = Nothing + + +builtinMod :: Expr -> Expr -> Maybe Expr +builtinMod _ _ = Nothing + + +-- could be derived from multiplication +builtinExp :: Expr -> Expr -> Maybe Expr +builtinExp (Rational a) (Rational b) = Just $ Rational (a ** b) + +builtinExp (Imaginary a) (Rational b) + | b < 0 = Just $ (Rational 1) `builtinDiv` ((Imaginary a) `builtinExp` (Rational b) + | b == 0 = Just $ Rational a + | b == 1 = Just $ Imaginary a + | b == 2 = Just $ Rational (-a) + | b == 3 = Just $ Imaginary (-a) + | otherwise = Imaginary a `builtinExp` (Rational (b - 4)) + +builtinExp _ _ = Nothing + +builtinDot :: Expr -> Expr -> Maybe Expr +_ **? _ = Nothing diff --git a/src/Evaluation.hs b/src/Evaluation.hs index b0b5aab..f0db71c 100644 --- a/src/Evaluation.hs +++ b/src/Evaluation.hs @@ -3,14 +3,13 @@ module Evaluation where import Expr import qualified Assignment as A -eval :: A.Context -> Expr -> Maybe Atom +eval :: A.Context -> Expr -> Maybe Expr eval c (Variable n) = do (A.Variable _ e) <- A.get c n eval c e eval c (Function n e) = do x <- eval c e (A.Function _ param fe) <- A.get c n - let tmp = A.update c (A.Variable param (EAtom x)) + let tmp = A.update c (A.Variable param x) eval tmp fe -eval c (EAtom a) = Just a eval c (Add e1 e2) = evalInfix c e1 e2 (+?) eval c (Sub e1 e2) = evalInfix c e1 e2 (-?) eval c (Mul e1 e2) = evalInfix c e1 e2 (*?) @@ -18,52 +17,9 @@ eval c (Div e1 e2) = evalInfix c e1 e2 (/?) eval c (Mod e1 e2) = evalInfix c e1 e2 (%?) eval c (Exp e1 e2) = evalInfix c e1 e2 (^?) eval c (Dot e1 e2) = evalInfix c e1 e2 (**?) --- eval _ _ = Nothing +eval c x = Just x -evalInfix :: A.Context -> Expr -> Expr -> (Atom -> Atom -> Maybe Atom) -> Maybe Atom +evalInfix :: A.Context -> Expr -> Expr -> (Expr -> Expr -> Maybe Expr) -> Maybe Expr evalInfix c e1 e2 f = do a <- eval c e1 b <- eval c e2 f a b - -infixl 6 +? -(+?) :: Atom -> Atom -> Maybe Atom -(Rational a) +? (Rational b) = Just $ Rational (a + b) -(Imaginary a) +? (Imaginary b) = Just $ Imaginary (a + b) -_ +? _ = Nothing - -infixl 6 -? -(-?) :: Atom -> Atom -> Maybe Atom -(Rational a) -? (Rational b) = Just $ Rational (a - b) -(Imaginary a) -? (Imaginary b) = Just $ Imaginary (a - b) -_ -? _ = Nothing - -infixl 7 *? -(*?) :: Atom -> Atom -> Maybe Atom -(Rational a) *? (Rational b) = Just $ Rational (a * b) -(Rational a) *? (Imaginary b) = Just $ Imaginary (a * b) -(Imaginary a) *? (Imaginary b) = (Imaginary (a * b)) ^? Rational 2 -_ *? _ = Nothing - -infixl 7 /? -(/?) :: Atom -> Atom -> Maybe Atom -_ /? (Rational 0) = Nothing -(Rational a) /? (Rational b) = Just $ Rational (a / b) -_ /? _ = Nothing - -infixl 7 %? -(%?) :: Atom -> Atom -> Maybe Atom -_ %? _ = Nothing - -infixr 8 ^? -(^?) :: Atom -> Atom -> Maybe Atom -(Rational a) ^? (Rational b) = Just $ Rational (a ** b) -(Imaginary a) ^? (Rational 0) = Just $ Rational a -(Imaginary a) ^? (Rational 1) = Just $ Imaginary a -(Imaginary a) ^? (Rational 2) = Just $ Rational (-a) -(Imaginary a) ^? (Rational 3) = Just $ Imaginary (-a) -(Imaginary a) ^? (Rational b) = Imaginary a ^? (Rational (b - 4)) -_ ^? _ = Nothing - -infixr 8 **? -(**?) :: Atom -> Atom -> Maybe Atom -_ **? _ = Nothing diff --git a/src/Expr.hs b/src/Expr.hs index 7a1b5e5..4bf2c70 100644 --- a/src/Expr.hs +++ b/src/Expr.hs @@ -2,14 +2,11 @@ module Expr where import Data.List -data Atom +data Expr = Rational Float | Imaginary Float + | Complex Float Float | Matrix [[Expr]] - deriving (Eq) - -data Expr - = EAtom Atom | Add Expr Expr | Sub Expr Expr | Mul Expr Expr @@ -21,8 +18,19 @@ data Expr | Function String Expr deriving (Eq) +data Expr + = Atom + | BinOp + | Variable String + | Function String Expr + + instance Show Expr where - show (EAtom a) = show a + show (Rational r) = show r + show (Imaginary i) = show i ++ "i" + show (Complex a b) = show a ++ " + " ++ show b ++ "i" + show (Matrix m) = intercalate "\n" (map showRow m) + where showRow r = "[ " ++ intercalate ", " (map show r) ++ " ]" show (Add e1 e2) = show e1 ++ " + " ++ show e2 show (Sub e1 e2) = show e1 ++ " - " ++ show e2 show (Mul e1 e2) = show e1 ++ " * " ++ show e2 @@ -33,8 +41,3 @@ instance Show Expr where show (Variable name) = name show (Function name e) = name ++ "(" ++ show e ++ ")" -instance Show Atom where - show (Rational r) = show r - show (Imaginary i) = show i ++ "i" - show (Matrix m) = intercalate "\n" (map showRow m) - where showRow r = "[ " ++ intercalate ", " (map show r) ++ " ]" diff --git a/src/parser/Expr.hs b/src/parser/Expr.hs index 5ba4be7..2d6937a 100644 --- a/src/parser/Expr.hs +++ b/src/parser/Expr.hs @@ -6,13 +6,13 @@ import Parser.Core import Expr -imaginaryP :: Parser Atom +imaginaryP :: Parser Expr imaginaryP = Imaginary <$> (floatP <* char 'i') -rationalP :: Parser Atom +rationalP :: Parser Expr rationalP = Rational <$> floatP -matrixP :: Parser Atom +matrixP :: Parser Expr matrixP = Matrix <$> (char '[' *> sepBy (char ';') matrixRowP <* char ']') where matrixRowP = char '[' *> sepBy (char ',') exprP <* char ']' @@ -27,16 +27,13 @@ termP = factorP `chainl1` factorOpP factorP :: Parser Expr factorP = endpointP `chainl1` expOpP where expOpP = infixOp "^" Exp - endpointP = parenthesisExprP <|> (EAtom <$> atomP) <|> functionP <|> variableP -variableP :: Parser Expr -variableP = Variable <$> alphaStringP - -functionP :: Parser Expr -functionP = Function <$> alphaStringP <*> parenthesisExprP - -parenthesisExprP :: Parser Expr -parenthesisExprP = parenthesize exprP - -atomP :: Parser Atom -atomP = imaginaryP <|> rationalP <|> matrixP + endpointP = parensExprP + <|> imaginaryP + <|> rationalP + <|> matrixP + <|> functionP + <|> variableP + where variableP = Variable <$> alphaStringP + functionP = Function <$> alphaStringP <*> parensExprP + parensExprP = parenthesize exprP |