From 18c9cfd7c1fb4baf1789f178a8d56ddb8f0f1456 Mon Sep 17 00:00:00 2001
From: Charles <sircharlesaze@gmail.com>
Date: Sat, 14 Mar 2020 12:41:34 +0100
Subject: Draft expr compatibility

---
 src/context.hs |  22 ++++++
 src/expr.hs    | 206 +++++++++++++++++++++++++++++++++++++++++++++++++--------
 src/imag.hs    |   6 +-
 src/manifest   |  84 ++++++++++++++++++++---
 src/matrix.hs  |  12 ++--
 src/parser.hs  |  27 ++++++++
 6 files changed, 309 insertions(+), 48 deletions(-)
 create mode 100644 src/context.hs

(limited to 'src')

diff --git a/src/context.hs b/src/context.hs
new file mode 100644
index 0000000..c5abfe0
--- /dev/null
+++ b/src/context.hs
@@ -0,0 +1,22 @@
+module Context where
+
+import Data.List
+import Control.Alternative
+
+type Label = String
+data State a = State [a]
+data Context a = Context [Decl] a
+
+instance Functor Context where
+    fmap f (Context state x) = Context (f x) state
+
+getLabel :: Declaration a => State a -> Label -> Maybe a
+getLabel (State decls) l = find (label . (l ==)) decls
+
+class Declaration a where
+    label :: a -> Label
+    -- value for variable
+    -- partial expression where the only variable left is the argument
+    resolve :: a -> State -> b
+
+
diff --git a/src/expr.hs b/src/expr.hs
index ccc0e36..c69948e 100644
--- a/src/expr.hs
+++ b/src/expr.hs
@@ -1,41 +1,189 @@
 module Expr where
 
-import Imag
-import Matrix
+import Data.List
 
--- data X = Expr | Imag | Matrix
+type Label = String
 
--- class ExprElement where
---     subExpr :: ExprElement a => a -> a
---     composed :: ExprElement a -> a -> (a, a)
+class Expression where
+    eval :: Expression a => a -> Maybe a
+    eval (Context _ e) = Just e
+    interpret :: Context a -> a
+    reduce :: Expression a => a -> a
+    reduce e = e
 
-data AExpr  = AExpr Term AExpr   | AExprSingle Term
-data Term   = Term Factor Term   | TermSingle Factor
-data Factor = Factor Base Factor | FactorSingle Base
-data Base   = Base AExpr         | BaseSingle Expr
+-- class ExpressionNum where
+--     evalNum :: ExpressionNum a, Num a => Context a -> Maybe a
+--     evalNum (Context c n) = eval n
 
-data Expr   = ExprF Float | ExprI Imag | ExprM (Matrix AExpr)
 
-instance Show AExpr where
-    show (AExprSingle t) = show t
-    show (AExpr t e) = show t ++ " + " ++ show e
+-- leaf type
+newtype Rational  = Float deriving (Expression)
+newtype Imaginary = Float deriving (Expression)
+newtype Matrix a  = [MatrixRow a]
+type MatrixRow a  = [a]
+type Var          = Label
 
-instance Show Term where
-    show (TermSingle f) = show f
-    show (Term f t) = show f ++ " * " ++ show t
+-- recursive types
+data Func a = Func
+    { name     :: Label
+    , argument :: a
+    }
 
-instance Show Factor where
-    show (FactorSingle b) = show b
-    show (Factor b f) = show b ++ " ^ " ++ show f
+class MaybeNum where
+    (+) :: a -> b -> Maybe c
+    _ + _  = Nothing
 
-instance Show Base where
-    show (BaseSingle x) = show x
-    show (Base e) = "(" ++ show e ++ ")"
+    (-) :: a -> b -> Maybe c
+    _ - _  = Nothing
 
-instance Show Expr where
-    show (ExprF f) = show f
-    show (ExprI i) = show i
-    show (ExprM m) = show m
+    (*) :: a -> b -> Maybe c
+    _ * _  = Nothing
+
+    (/) :: a -> b -> Maybe c
+    _ / _  = Nothing
+
+    (%) :: a -> b -> Maybe c
+    _ % _  = Nothing
+
+    (^) :: a -> b -> Maybe c
+    _ ^ _  = Nothing
+
+    (**) :: a -> b -> Maybe c
+    _ ** _  = Nothing
+
+
+instance MaybeNum Rational where
+    (Rational a) + (Rational b) = Just (a + b)
+    (Rational a) + (Imaginary b) = Just (Complex a b)
+
+    (Rational a) - (Rational b) = Just (a - b)
+    (Rational a) - (Imaginary b) = Just (Complex a (-b))
+
+    (Rational a) * (Rational b) = Just (a * b)
+    (Rational a) * (Imaginary b)     = Just (Imag (a * b))
+    (Rational a) * (Matrix b)   = Just (fmap (a*) b)
+
+    _ / (Rational 0) = Nothing
+    (Rational a) / (Rational b) = Just (a * b)
+    -- x / yi possible?
+
+    -- (Rational a) % (Rational b)  = Nothing
+
+    (Rational a) ^ (Rational b) = Just (a ^ b)
+
+instance MaybeNum Imaginary where
+    (Imaginary a) + (Imaginary b) = Just $ Imaginary (a + b)
+    (Imaginary a) + (Rational b) = Just (Complex b a)
+
+    (Imaginary a) - (Imaginary b) = Just $ Imaginary (a - b)
+    (Imaginary a) - (Rational b) = Just $ Complex (-b) a
+
+    (Imaginary a) * (Imaginary b) = Just $ Imaginary (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) = Just $ a ^ (b - 4)
+
+instance MaybeNum Matrix where
+    (Matrix a) + (Matrix b) = if shape a == shape b then Just $ (+) <$> a <*> b
+                                                    else Nothing
+    (Matrix a) - (Matrix b) = if shape a == shape b then Just $ (-) <$> a <*> b
+                                                    else Nothing
+    (Matrix a) * (Rational b) = Just $ fmap (*b) a
+    (Matrix a) / (Rational b) = Just $ fmap (/b) a
+
+    (Matrix a) ^ (Rational 1) = Just a
+    (Matrix a) ^ (Rational b) = if isSquare a then a ** (a ^ (b - 1))
+                                              else Nothing
+
+    (Matrix a) ** (Matrix b) = undefined
+
+
+data (Evaluable a, MaybeNum b) => Ast a b = Operation a (Ast a b) (Ast a b) | Operand b
+
+instance Functor Ast where
+    fmap f (Operation op l r) = Operation op (fmap f l) (fmap f r)
+    fmap f (Operand x) = Operand (f x)
+
+--
+-- data BinExpr a a = BinExpr a a | BinEmpty
+-- data Sum    = Sum    Term   Sum    | SumSingle    Term
+-- data Term   = Term   Factor Term   | TermSingle   Factor
+-- data Factor = Factor Base   Factor | FactorSingle Base
+-- data Base   = Base   Expr          | BaseSingle   Expr
+
+-- data X a = X a X | XSingle a
+
+
+
+-- data Sum a = Sum a a
+
+-- instance Expression a, Num a => Expression (Sum a) where
+--     eval (Context c (Sum x y)) = (+) <$> eval (Context c x) <*> eval (Context c y)
+--
+-- data Multiplication a = Multiplication a a
+-- instance Expression a, Num a => Expression (Multiplication a) where
+--     eval (Context c (Multiplication x y)) = (*) <$> eval (Context c x) <*> eval (Context c y)
+
+Bin b => b a  (a -> a -> a) -> a
+x f = f <$> eval fst x <*> eval snd x
+
+-- dot :: Matrix a -> Matrix a -> a
+
+-- evalNum :: Num a => (a -> a -> a) -> b a -> b a -> Maybe a
+-- evalNum f x y = f <$> eval x <*> eval y
+
+
+-- data FuncExpr = FuncExpr
+--     { getName :: String
+--     , getParam :: Expr
+--     }
+
+-- data Expr
+--     = ExprR Real
+--     | ExprI Imag
+--     | ExprM (Matrix Expr)
+--     | ExprV Var
+--     | ExprF FuncEval
+
+
+data FuncDecl = FuncDecl
+    { getName :: String
+    , getArg :: String
+    , getContent :: Expr
+    }
+
+instance Show a => Show (Matrix a) where
+    show (Matrix m) = intercalate "\n" (map showLine m)
+        where showLine l = "[ " ++ intercalate " , " (map show l) ++ " ]"
+
+instance Show Imag where
+    show (Imag i) = show i ++ "i"
+
+-- instance Show AExpr where
+--     show (AExprSingle t) = show t
+--     show (AExpr t e) = show t ++ " + " ++ show e
+--
+-- instance Show Term where
+--     show (TermSingle f) = show f
+--     show (Term f t) = show f ++ " * " ++ show t
+--
+-- instance Show Factor where
+--     show (FactorSingle b) = show b
+--     show (Factor b f) = show b ++ " ^ " ++ show f
+--
+-- instance Show Base where
+--     show (BaseSingle x) = show x
+--     show (Base e) = "(" ++ show e ++ ")"
+--
+-- instance Show FuncExpr where
+--     show (FuncExpr name arg) = (init $ tail (show name)) ++ "(" ++ (show arg) ++ ")"
+--
+-- instance Show Expr where
+--     show (ExprR r) = show r
+--     show (ExprI i) = show i
+--     show (ExprM m) = show m
+--     show (ExprV v) = init $ tail (show v)
 
--- eval :: Expr -> Float
--- eval
diff --git a/src/imag.hs b/src/imag.hs
index 71c0607..16ac28e 100644
--- a/src/imag.hs
+++ b/src/imag.hs
@@ -1,6 +1,6 @@
 module Imag where
 
-newtype Imag = Imag { getImag :: Float }
+-- newtype Imag = Imag { getImag :: Float }
 
-instance Show Imag where
-    show (Imag i) = show i ++ "i"
+-- instance Show Imag where
+--     show (Imag i) = show i ++ "i"
diff --git a/src/manifest b/src/manifest
index 60f7683..7216fa7 100644
--- a/src/manifest
+++ b/src/manifest
@@ -10,23 +10,87 @@ State Data struct:
     - variable
 
 
+
+Instruction/line:
+    if is '?' evaluate label else declare label.
+
+instruction  ::= <label> '=' (<expr> | '?')
+
+
+Declaration:
+    label is a declaration of function or variable name
+
+label        ::= <funcDecl> | <var>
+funcDecl     ::= <var> '(' <var> ')'
+var          ::= [a-zA-Z]+
+
+
+Expression:
+
 5. real imag matrix
 4. + -
 3. * / % **
 2. ^
-1. ( )
+1. ( )    -- not an operator
+
+expr         ::= <sum> | <imag> | <matrix> | <real> | <var> | <funcExpr>
+
+Arithmetic:
 
-expr         ::= <term>   (+ | -)           <expr>   | <term>
+sum          ::= <term>   (+ | -)           <sum>    | <term>
 term         ::= <factor> (* | / | % | **)? <term>   | <factor>  -- default to '*'
 factor       ::= <base>   '^'               <factor> | <base>
-base         ::= '(' <expr> ')'                      | ( <real> | <imag> | <matrix> )
+base         ::= '(' <expr> ')'                      | <expr>
 
-imag         ::= <expr> '*'? 'i'
-real         ::= [0-9]+
+Leaf:
 
-matrix       ::= '[' (<line> ';')* ']'
-line         ::= '[' (<expr> ',')* ']'
+real         ::= [0-9]+(\.[0-9]+)?
+imag         ::= <real> '*'? 'i'
+matrix       ::= '[' (<matrixRow> ';')* ']'
+matrixRow    ::= '[' (<expr> ',')* ']'
+fundExpr     ::= <var> '(' <expr> ')'
 
-func         ::= [a-zA-Z]+ '(' <var> ')'
-var          ::= [a-zA-Z]+
-endpoint     ::= (<var> | <func>) '=' <expr>
+REPL:
+
+1. read user input
+2. parse it into an ast
+3. reduce the ast to the minimum possible form
+4.
+
+every expression is a binary tree, except () which can be interpreted by changing the
+structure of the tree.
+
+operators and operand are both expression (tree nodes).
+
+operators always need 2 operand  (not leaf node)
+operand need 0                   (leaf node)
+
+evaluation of operand return the operand
+evaluation of operator, evaluate his childs, perform the operation on them, return the result
+
+fold?
+!monoid
+
+    +
+   / \
+  *   \
+ / \   \      3 * 4 + (5 - 3i)
+3   4   -
+       / \
+      5   3i
+
+Node +
+|_ Node *
+|  |_ Leaf 3
+|  |_ Leaf 4
+|
+|_ Node -
+   |_ Leaf 5
+   |_ Leaf 3i
+
+
+i^0 = 1
+i^1 = sqrt(-1) = i
+i^2 = -1
+i^3 = -sqrt(-1) = -i
+i^4 = 1
diff --git a/src/matrix.hs b/src/matrix.hs
index c2e6654..38780bb 100644
--- a/src/matrix.hs
+++ b/src/matrix.hs
@@ -1,10 +1,10 @@
 module Matrix where
 
-import Data.List
+-- import Data.List
 
-newtype Matrix a = Matrix { getMatrix :: [MatrixRow a] }
-type MatrixRow a = [a]
+-- newtype Matrix a = Matrix { getMatrix :: [MatrixRow a] }
+-- type MatrixRow a = [a]
 
-instance Show a => Show (Matrix a) where
-    show (Matrix m) = intercalate "\n" (map showLine m)
-        where showLine l = "[ " ++ intercalate " , " (map show l) ++ " ]"
+-- instance Show a => Show (Matrix a) where
+--     show (Matrix m) = intercalate "\n" (map showLine m)
+--         where showLine l = "[ " ++ intercalate " , " (map show l) ++ " ]"
diff --git a/src/parser.hs b/src/parser.hs
index d708a6c..64f452a 100644
--- a/src/parser.hs
+++ b/src/parser.hs
@@ -106,6 +106,16 @@ matrixP = Matrix <$> (charP '[' *> (sepBy (charP ';') matrixRowP) <* charP ']')
 matrixRowP :: Parser (MatrixRow AExpr)
 matrixRowP = charP '[' *> (sepBy (charP ',') aExprP) <* charP ']'
 
+varP :: Parser Var
+varP = some alphaP
+
+funcExprP :: Parser FuncExpr
+funcExprP = do name <- varP
+               charP '('
+               arg <- aExprP
+               charP ')'
+               return (FuncExpr name arg)
+
 aExprP :: Parser AExpr
 aExprP = do x <- termP
             charP '+'
@@ -133,4 +143,21 @@ baseP = (charP '(' *> (Base <$> aExprP) <* charP ')')
         <|> (BaseSingle <$> ExprI <$> imagP)
         <|> (BaseSingle <$> ExprF <$> floatP)
         <|> (BaseSingle <$> ExprM <$> matrixP)
+        <|> (BaseSingle <$> ExprFE <$> funcExprP)
+        <|> (BaseSingle <$> ExprV <$> varP)
+
+funcDeclP :: Parser FuncDecl
+funcDeclP = do name <- varP
+               charP '('
+               argName <- varP
+               charP ')'
+               return (FuncDecl name argName)
+
+labelP :: Parser Label
+labelP = varP <|> funcDeclP
+
+evalP :: Parser Eval
+evalP = do labelP
+           charP '='
+           (EvalDecl <$> exprP) <|> (EvalTry <$ charP '?')
 
-- 
cgit