Basic expression parsing

9 files changed, 170 insertions, 53 deletions

diff --git a/src/complex.hs b/src/complex.hs
new file mode 100644
index 0000000..220fe1f
--- /dev/null
+++ b/src/complex.hs
@@ -0,0 +1,17 @@
+module Complex where
+
+type Imaginary = Float
+
+data Complex = Complex Float Imaginary
+
+-- instance Num Complex where
+--     (Complex r1 i1) + (Complex r2 i2) = Complex (r1 + r2) (i1 + i2)
+--     (Complex r1 i1) * (Complex r2 i2) = undefined
+--     negate (Complex r1 i1) = undefined
+--     abs (Complex r1 i1) = undefined
+--     signum (Complex r1 i1) = undefined
+    -- fromInteger r = Complex r 0
+
+instance Show Complex where
+    show (Complex r i) = show r ++ showI ++ "i"
+        where showI = if i < 0 then " - " ++ show (-i) else " + " ++ show i
diff --git a/src/expr.hs b/src/expr.hs
new file mode 100644
index 0000000..3cada63
--- /dev/null
+++ b/src/expr.hs
@@ -0,0 +1,24 @@
+module Expr where
+
+-- data X = Expr | Imag | Matrix
+
+data Expr   = Expr Term Expr     | ExprSingle Term
+data Term   = Term Factor Term   | TermSingle Factor
+data Factor = Factor Base Factor | FactorSingle Base
+data Base   = Base Expr          | BaseSingle Float
+
+instance Show Expr where
+    show (ExprSingle t) = show t
+    show (Expr 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 ++ " )"
diff --git a/src/manifest b/src/manifest
new file mode 100644
index 0000000..dc03948
--- /dev/null
+++ b/src/manifest
@@ -0,0 +1,31 @@
+Data struct:
+    - expression
+        - matrix
+        - complex
+
+        - polynomial
+
+State Data struct:
+    - function
+    - variable
+
+
+1. ( )
+2. ^
+3. * / % **
+4. + -
+
+expr         ::= <term>   (+ | -)           <expr>   | <term>
+term         ::= <factor> (* | / | % | **)? <term>   | <factor>  -- default to '*'
+factor       ::= <base>   '^'               <factor> | <base>
+base         ::= '(' <expr> ')'                      | ( <real> | <imag> | <matrix> )
+
+imag         ::= <expr> '*'? 'i'
+real         ::= [0-9]+
+
+matrix       ::= '[' (<line> ';')* ']'
+line         ::= '[' (<expr> ',')* ']'
+
+func         ::= [a-zA-Z]+ '(' <var> ')'
+var          ::= [a-zA-Z]+
+endpoint     ::= (<var> | <func>) '=' <expr>
diff --git a/src/matrix.hs b/src/matrix.hs
new file mode 100644
index 0000000..21c85f0
--- /dev/null
+++ b/src/matrix.hs
@@ -0,0 +1,10 @@
+module Matrix where
+
+import Data.List
+
+
+newtype Matrix a = Matrix { getMatrix :: [[a]] }
+
+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 d523001..f402b80 100644
--- a/src/parser.hs
+++ b/src/parser.hs
@@ -1,13 +1,15 @@
-module Parser
-( parse
-, equationP
-) where
+module Parser where
+-- ( parse
+-- , equationP
+-- ) where
 
 import Control.Applicative
 import Control.Monad
 import Data.Char
 
-import Equation
+import Expr
+-- import Equation
+-- import Complex
 
 
 newtype Parser a = Parser (String -> Maybe (a, String))
@@ -39,61 +41,91 @@ instance Alternative Parser where
     (Parser p1) <|> (Parser p2) = Parser new_p
         where new_p s = p1 s <|> p2 s
 
+instance Monad Parser where
+    -- return :: a -> Parser a
+    return x = pure x
+    -- (>>=) :: Parser a -> (a -> Parser b) -> Parser b
+    (Parser p1) >>= f = Parser new_p
+        where new_p s = do
+                (x, s') <- p1 s
+                parse (f x) s'
+
 
-satisfy :: (Char -> Bool) -> Parser Char
-satisfy f = Parser p
+satisfyChar :: (Char -> Bool) -> Parser Char
+satisfyChar f = Parser p
     where p []     = Nothing
           p (c:cs) = if f c then Just (c, cs)
                             else Nothing
 
+sepBy :: Parser b -> Parser a -> Parser [a]
+sepBy sep x = many (sep *> x)
+
+sepByMap :: (b -> a -> a) -> Parser b -> Parser a -> Parser [a]
+sepByMap f sep x = many (f <$> sep <*> x)
+
+signed :: Num a => Parser a -> Parser a
+signed p = do charP '-'
+              x <- p
+              return (-x)
+           <|> p
+
+readParser :: Read a => Parser String -> Parser a
+readParser p = read <$> p
+
 charP :: Char -> Parser Char
-charP c = satisfy (c ==)
+charP c = satisfyChar (c ==)
+
+alphaP :: Parser Char
+alphaP = satisfyChar isAlpha
 
 digitsP :: Parser String
-digitsP = some (satisfy isDigit) -- at least one digit to avoid read exception
+digitsP = some (satisfyChar isDigit) -- at least one digit to avoid read exception
 
 spacesP :: Parser String
-spacesP = many (satisfy isSpace)
-
-sepBy :: Parser b -> Parser a -> Parser [a]
-sepBy sep x = many (sep *> x)
-
-naturalP :: Parser Int
-naturalP = read <$> digitsP
-
-floatPositiveP :: Parser Float
-floatPositiveP = (f <$> digitsP <*> charP '.' <*> digitsP) <|> (read <$> digitsP)
-    where f pos dot dec = read $ pos ++ [dot] ++ dec
-
--- Equation parsers
-
-unsignedTermP :: Parser Term
-unsignedTermP = fullP <|> varExpP <|> varConstP <|> constP
-    where
-        -- 1 * X ^ 1
-        fullP     = (\c e -> Term c e) <$> floatPositiveP <* mulP <* varP <* expP <*> naturalP
-        -- X ^ 1
-        varExpP   = (\e -> Term 1 e)   <$> (varP *> expP *> naturalP)
-        -- 1 * X
-        varConstP = (\c -> Term c 1)   <$> floatPositiveP <* mulP <* varP
-        -- 1
-        constP    = (\c -> Term c 0)   <$> floatPositiveP
-
-        mulP = spacesP *> charP '*' *> spacesP
-        varP = spacesP *> charP 'X' *> spacesP
-        expP = spacesP *> charP '^' *> spacesP
-
-signedTermP :: Parser Term
-signedTermP = signF <$> signP <* spacesP <*> unsignedTermP
-    where signP = charP '-' <|> charP '+'
-          signF '-' (Term c e) = Term (-c) e
-          signF _   t          = t
-
-polynomialP :: Parser Polynomial
-polynomialP = (:) <$> firstTermP <* spacesP <*> (sepBy spacesP signedTermP)
-    where firstTermP = signedTermP <|> unsignedTermP
-
-equationP :: Parser Equation
-equationP = (\l r -> Equation l r)
-             <$> polynomialP
-             <*> (spacesP *> charP '=' *> spacesP *> polynomialP)
+spacesP = many (satisfyChar isSpace)
+
+unsignedIntP :: Parser Int
+unsignedIntP = readParser digitsP
+
+intP :: Parser Int
+intP = signed unsignedIntP
+
+unsignedFloatP :: Parser Float
+unsignedFloatP = readParser p
+    where p = do pos <- digitsP
+                 charP '.'
+                 dec <- digitsP
+                 return (pos ++ "." ++ dec)
+              <|> digitsP
+
+floatP :: Parser Float
+floatP = signed unsignedFloatP
+
+-- imaginaryP :: Parser Imaginary
+-- imaginaryP = floatP <* charP 'i'
+
+exprP :: Parser Expr
+exprP = do x <- termP
+           charP '+'
+           y <- exprP
+           return (Expr x y)
+        <|> (ExprSingle <$> termP)
+
+termP :: Parser Term
+termP = do f <- factorP
+           charP '*'
+           t <- termP
+           return (Term f t)
+        <|> (TermSingle <$> factorP)
+
+
+factorP :: Parser Factor
+factorP = do b <- baseP
+             charP '^'
+             e <- factorP
+             return (Factor b e)
+          <|> (FactorSingle <$> baseP)
+
+baseP :: Parser Base
+baseP = (charP '(' *> (Base <$> exprP) <* charP ')')
+        <|> (BaseSingle <$> floatP)
diff --git a/src/parser/complex.hs b/src/parser/complex.hs
new file mode 100644
index 0000000..e69de29
--- /dev/null
+++ b/src/parser/complex.hs
diff --git a/src/parser/matrix.hs b/src/parser/matrix.hs
new file mode 100644
index 0000000..e69de29
--- /dev/null
+++ b/src/parser/matrix.hs
diff --git a/src/equation.hs b/src/polynomial.hs
index f332131..f332131 100644
--- a/src/equation.hs
+++ b/src/polynomial.hs
diff --git a/src/rational.hs b/src/rational.hs
new file mode 100644
index 0000000..7eb1785
--- /dev/null
+++ b/src/rational.hs
@@ -0,0 +1,3 @@
+module Rational where
+
+type Rational = Float