builtin cleaning

6 files changed, 141 insertions, 77 deletions

diff --git a/manifest b/manifest
index 7216fa7..8bb90e4 100644
--- a/manifest
+++ b/manifest
@@ -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