aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/atom.hs4
-rw-r--r--src/complex.hs17
-rw-r--r--src/context.hs22
-rw-r--r--src/expr.hs38
-rw-r--r--src/imag.hs6
-rw-r--r--src/matrix.hs3
-rw-r--r--src/parser.hs131
-rw-r--r--src/parser/complex.hs0
-rw-r--r--src/parser/matrix.hs0
-rw-r--r--src/rational.hs3
10 files changed, 100 insertions, 124 deletions
diff --git a/src/atom.hs b/src/atom.hs
index d01b157..5f1b42c 100644
--- a/src/atom.hs
+++ b/src/atom.hs
@@ -30,6 +30,10 @@ _ /? (ARational 0) = Nothing
(ARational a) /? (ARational b) = Just $ ARational (a / b)
_ /? _ = Nothing
+infixl 7 %?
+(%?) :: Atom -> Atom -> Maybe Atom
+_ %? _ = Nothing
+
infixr 8 ^?
(^?) :: Atom -> Atom -> Maybe Atom
(ARational a) ^? (ARational b) = Just $ ARational (a ** b)
diff --git a/src/complex.hs b/src/complex.hs
deleted file mode 100644
index 220fe1f..0000000
--- a/src/complex.hs
+++ /dev/null
@@ -1,17 +0,0 @@
-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/context.hs b/src/context.hs
deleted file mode 100644
index c5abfe0..0000000
--- a/src/context.hs
+++ /dev/null
@@ -1,22 +0,0 @@
-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
new file mode 100644
index 0000000..87a700b
--- /dev/null
+++ b/src/expr.hs
@@ -0,0 +1,38 @@
+module Expr where
+
+import Atom
+
+
+data Expr
+ = EAtom Atom
+ | Add Expr Expr
+ | Sub Expr Expr
+ | Mul Expr Expr
+ | Div Expr Expr
+ | Mod Expr Expr
+ | Exp Expr Expr
+ -- | Dot Expr Expr
+
+
+eval :: Expr -> Maybe Atom
+eval (EAtom a) = Just a
+eval (Add e1 e2) = evalBin e1 e2 (+?)
+eval (Sub e1 e2) = evalBin e1 e2 (-?)
+eval (Mul e1 e2) = evalBin e1 e2 (*?)
+eval (Div e1 e2) = evalBin e1 e2 (/?)
+eval (Mod e1 e2) = evalBin e1 e2 (%?)
+eval (Exp e1 e2) = evalBin e1 e2 (^?)
+
+evalBin :: Expr -> Expr -> (Atom -> Atom -> Maybe Atom) -> Maybe Atom
+evalBin e1 e2 f = do a <- eval e1
+ b <- eval e2
+ f a b
+
+instance Show Expr where
+ show (EAtom a) = show a
+ show (Add e1 e2) = show e1 ++ " + " ++ show e2
+ show (Sub e1 e2) = show e1 ++ " - " ++ show e2
+ show (Mul e1 e2) = show e1 ++ " * " ++ show e2
+ show (Div e1 e2) = show e1 ++ " / " ++ show e2
+ show (Mod e1 e2) = show e1 ++ " % " ++ show e2
+ show (Exp e1 e2) = show e1 ++ " ^ " ++ show e2
diff --git a/src/imag.hs b/src/imag.hs
deleted file mode 100644
index 16ac28e..0000000
--- a/src/imag.hs
+++ /dev/null
@@ -1,6 +0,0 @@
-module Imag where
-
--- newtype Imag = Imag { getImag :: Float }
-
--- instance Show Imag where
--- show (Imag i) = show i ++ "i"
diff --git a/src/matrix.hs b/src/matrix.hs
deleted file mode 100644
index 7de634b..0000000
--- a/src/matrix.hs
+++ /dev/null
@@ -1,3 +0,0 @@
-module Matrix where
-
-
diff --git a/src/parser.hs b/src/parser.hs
index 64f452a..405ff9b 100644
--- a/src/parser.hs
+++ b/src/parser.hs
@@ -4,15 +4,14 @@ import Control.Applicative
import Control.Monad
import Data.Char
+import Atom
import Expr
-import Imag
-import Matrix
+newtype Parser a = Parser { parse :: String -> Maybe (a, String) }
-newtype Parser a = Parser (String -> Maybe (a, String))
-
-parse :: Parser a -> String -> Maybe (a, String)
-parse (Parser p) input = p input
+parseStrict :: Parser a -> String -> Maybe a
+parseStrict p input = case parse p input of Just (a, "") -> Just a
+ _ -> Nothing
instance Functor Parser where
-- fmap :: (a -> b) -> Parser a -> Parser b
@@ -54,11 +53,22 @@ satisfyChar f = Parser p
p (c:cs) = if f c then Just (c, cs)
else Nothing
-sepBy :: Parser b -> Parser a -> Parser [a]
-sepBy sep x = (:) <$> x <*> (many (sep *> x))
+-- sepBy :: Parser b -> Parser a -> Parser [a]
+-- sepBy sep x = (:) <$> x <*> (many (sep *> x))
+-- sepByMap :: (b -> a -> a) -> Parser b -> Parser a -> Parser [a]
+-- sepByMap f sep x = (:) <$> x <*> (many (f <$> sep <*> x))
+
+chainl :: Parser a -> Parser (a -> a -> a) -> a -> Parser a
+chainl p op a = chainl1 p op <|> pure a
+
+chainl1 :: Parser a -> Parser (a -> a -> a) -> Parser a
+chainl1 p op = do first <- p
+ rest first
+ where rest prev = do f <- op
+ e <- p
+ rest (f prev e)
+ <|> return prev
-sepByMap :: (b -> a -> a) -> Parser b -> Parser a -> Parser [a]
-sepByMap f sep x = (:) <$> x <*> (many (f <$> sep <*> x))
signed :: Num a => Parser a -> Parser a
signed p = do charP '-'
x <- p
@@ -68,9 +78,18 @@ signed p = do charP '-'
readParser :: Read a => Parser String -> Parser a
readParser p = read <$> p
+infixOp :: String -> (a -> a -> a) -> Parser (a -> a -> a)
+infixOp opStr f = stringP opStr *> pure f
+
+parenthesize :: Parser a -> Parser a
+parenthesize p = charP '(' *> p <* charP ')'
+
charP :: Char -> Parser Char
charP c = satisfyChar (c ==)
+stringP :: String -> Parser String
+stringP s = sequenceA $ charP <$> s
+
alphaP :: Parser Char
alphaP = satisfyChar isAlpha
@@ -97,67 +116,33 @@ unsignedFloatP = readParser p
floatP :: Parser Float
floatP = signed unsignedFloatP
-imagP :: Parser Imag
-imagP = Imag <$> (floatP <* charP 'i')
-
-matrixP :: Parser (Matrix AExpr)
-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 '+'
- y <- aExprP
- return (AExpr x y)
- <|> (AExprSingle <$> 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 <$> 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 '?')
+imaginaryP :: Parser Atom
+imaginaryP = AImaginary <$> (floatP <* charP 'i')
+
+rationalP :: Parser Atom
+rationalP = ARational <$> floatP
+
+termOpP :: Parser (Expr -> Expr -> Expr)
+termOpP = infixOp "+" Add <|> infixOp "-" Sub
+
+factorOpP :: Parser (Expr -> Expr -> Expr)
+factorOpP = infixOp "*" Mul <|> infixOp "/" Div <|> infixOp "%" Mod
+
+expOpP :: Parser (Expr -> Expr -> Expr)
+expOpP = infixOp "^" Exp
+
+exprP :: Parser Expr
+exprP = termP `chainl1` termOpP
+
+termP :: Parser Expr
+termP = factorP `chainl1` factorOpP
+
+factorP :: Parser Expr
+factorP = endpointP `chainl1` expOpP
+ where endpointP = parenthesisP <|> (EAtom <$> atomP)
+
+parenthesisP :: Parser Expr
+parenthesisP = parenthesize exprP
+atomP :: Parser Atom
+atomP = imaginaryP <|> rationalP
diff --git a/src/parser/complex.hs b/src/parser/complex.hs
deleted file mode 100644
index e69de29..0000000
--- a/src/parser/complex.hs
+++ /dev/null
diff --git a/src/parser/matrix.hs b/src/parser/matrix.hs
deleted file mode 100644
index e69de29..0000000
--- a/src/parser/matrix.hs
+++ /dev/null
diff --git a/src/rational.hs b/src/rational.hs
deleted file mode 100644
index 7eb1785..0000000
--- a/src/rational.hs
+++ /dev/null
@@ -1,3 +0,0 @@
-module Rational where
-
-type Rational = Float
generated by cgit (git 2.34.1) at 2026-05-16 07:28:37 +0000