variable and function context between prompts

4 files changed, 113 insertions, 67 deletions

diff --git a/src/Assignment.hs b/src/Assignment.hs
index c086280..51e619a 100644
--- a/src/Assignment.hs
+++ b/src/Assignment.hs
@@ -5,6 +5,24 @@ import qualified Expr as E
 data Assignment
     = Variable String E.Expr
     | Function String String E.Expr
+    deriving (Eq)
+
+name :: Assignment -> String
+name (Variable n _) = n
+name (Function n _ _) = n
+
+type Context = [Assignment]
+
+update :: Context -> Assignment -> Context
+update context a
+  | name a `elem` map name context = map replaceIf context
+  | otherwise = a:context
+  where replaceIf a' = if name a' == name a then a else a'
+
+get :: Context -> String -> Maybe Assignment
+get context n = case found of [] -> Nothing
+                              [a] -> Just a
+    where found = filter (\a -> name a == n) context
 
 instance Show Assignment where
     show (Variable name e) = name ++ " = " ++ show e
diff --git a/src/Evaluation.hs b/src/Evaluation.hs
new file mode 100644
index 0000000..b0b5aab
--- /dev/null
+++ b/src/Evaluation.hs
@@ -0,0 +1,69 @@
+module Evaluation where
+
+import Expr
+import qualified Assignment as A
+
+eval :: A.Context -> Expr -> Maybe Atom
+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))
+                           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 (*?)
+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
+
+evalInfix :: A.Context -> Expr -> Expr -> (Atom -> Atom -> Maybe Atom) -> Maybe Atom
+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 e3d8aef..7a1b5e5 100644
--- a/src/Expr.hs
+++ b/src/Expr.hs
@@ -2,11 +2,11 @@ module Expr where
 
 import Data.List
 
-
 data Atom
     = Rational Float
     | Imaginary Float
     | Matrix [[Expr]]
+    deriving (Eq)
 
 data Expr
     = EAtom Atom
@@ -19,65 +19,7 @@ data Expr
     | Dot Expr Expr
     | Variable String
     | Function String Expr
-
-eval :: Expr -> Maybe Atom
-eval (EAtom a) = Just a
-eval (Add e1 e2) = evalInfix e1 e2 (+?)
-eval (Sub e1 e2) = evalInfix e1 e2 (-?)
-eval (Mul e1 e2) = evalInfix e1 e2 (*?)
-eval (Div e1 e2) = evalInfix e1 e2 (/?)
-eval (Mod e1 e2) = evalInfix e1 e2 (%?)
-eval (Exp e1 e2) = evalInfix e1 e2 (^?)
-eval (Dot e1 e2) = evalInfix e1 e2 (**?)
-eval _ = Nothing
-
-evalInfix :: Expr -> Expr -> (Atom -> Atom -> Maybe Atom) -> Maybe Atom
-evalInfix e1 e2 f = do a <- eval e1
-                       b <- eval 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
+    deriving (Eq)
 
 instance Show Expr where
     show (EAtom a) = show a
diff --git a/src/main.hs b/src/main.hs
index 34a190a..569ba28 100644
--- a/src/main.hs
+++ b/src/main.hs
@@ -2,17 +2,26 @@ import System.IO
 import Statement
 import Parser.Statement
 import Parser.Core
+import Statement
+import Assignment
+import Expr
+import Evaluation
+
 
+main = promptLoop []
 
-main = do
+promptLoop :: Context -> IO ()
+promptLoop context = do
     line <- prompt
-    loop line
+    if line /= "exit"
+       then loop line context >>= promptLoop
+       else return ()
 
-loop :: String -> IO ()
-loop "exit" = return ()
-loop line   = do s <- parseIO line
-                 putStrLn $ show s
-                 main
+loop :: String -> Context -> IO Context
+loop line context = do s <- parseIO line
+                       context <- printStatement s context
+                       putStrLn $ show context
+                       return context
 
 prompt :: IO String
 prompt = do putStr "> "
@@ -23,3 +32,11 @@ parseIO :: String -> IO Statement
 parseIO input = case parseStrict statementP input of
                   Nothing -> fail "Couldn't parse input"
                   Just s  -> return s
+
+printStatement :: Statement -> Context -> IO Context
+printStatement (SAssignment a) context = do putStrLn $ show a
+                                            return $ update context a
+printStatement (SExpr e) context = do putStrLn evalStr
+                                      return context
+    where evalStr = case eval context e of Nothing -> "Couldn't evaluate expression"
+                                           Just a  -> show a