aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/complex.hs17
-rw-r--r--src/expr.hs24
-rw-r--r--src/manifest31
-rw-r--r--src/matrix.hs10
-rw-r--r--src/parser.hs138
-rw-r--r--src/parser/complex.hs0
-rw-r--r--src/parser/matrix.hs0
-rw-r--r--src/polynomial.hs (renamed from src/equation.hs)0
-rw-r--r--src/rational.hs3
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
generated by cgit (git 2.34.1) at 2026-05-16 07:58:01 +0000