diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Expr.hs | 45 | ||||
| -rw-r--r-- | src/parser/Core.hs | 15 | ||||
| -rw-r--r-- | src/parser/Expr.hs | 13 | ||||
| -rw-r--r-- | src/parser/Statement.hs | 8 |
4 files changed, 41 insertions, 40 deletions
diff --git a/src/Expr.hs b/src/Expr.hs index 852ee47..93828d9 100644 --- a/src/Expr.hs +++ b/src/Expr.hs @@ -4,10 +4,27 @@ import Control.Monad import Data.List import qualified Data.Map as M +-- data Operand +-- = Rational Float +-- | Complex Float Float +-- | Matrix [[Operand]] +-- +-- +-- data (Operable a, Operable b) => Operator a b +-- = Add a b +-- | Sub a b +-- | Mul a b +-- | Div a b +-- | Mod a b +-- | Exp a b +-- | Dot a b +-- +-- data Label +-- = Variable String +-- | Function String Expr data Expr = Rational Float -- values - | Imaginary Float | Complex Float Float | Matrix [[Expr]] @@ -25,8 +42,7 @@ data Expr instance Show Expr where show (Rational a) = show a - show (Imaginary b) = show b ++ "i" - show (Complex a b) = show a ++ " + " ++ show (Imaginary b) + show (Complex a b) = (if a /= 0 then show a ++ " + " else "") ++ show b ++ "i" show (Add e1 e2) = show e1 ++ " + " ++ show e2 show (Sub e1 e2) = show e1 ++ " - " ++ show e2 show (Mul e1 e2) = show e1 ++ " * " ++ show e2 @@ -42,7 +58,6 @@ instance Show Expr where isLitteral :: Expr -> Bool isLitteral (Rational _) = True -isLitteral (Imaginary _) = True isLitteral (Complex _ _) = True isLitteral _ = False @@ -53,16 +68,10 @@ isLitteral _ = False add :: Expr -> Expr -> Maybe Expr add (Rational a) (Rational b) = Just $ Rational (a + b) -add (Rational a) (Imaginary b) = Just $ Complex a b add (Rational a) (Complex br bi) = Just $ Complex (br + a) bi -add (Imaginary a) (Imaginary b) = Just $ Imaginary (a + b) -add (Imaginary a) (Rational b) = Just $ Complex b a -add (Imaginary a) (Complex br bi) = Just $ Complex br (a + bi) - add (Complex ar ai) (Complex br bi) = Just $ Complex (ar + br) (ai + bi) add (Complex ar ai) (Rational b) = Just $ Complex (ar + b) ai -add (Complex ar ai) (Imaginary b) = Just $ Complex ar (ai + b) add _ _ = Nothing @@ -73,19 +82,14 @@ sub a b = add a =<< Rational (-1) `mul` b mul :: Expr -> Expr -> Maybe Expr mul (Rational a) (Rational b) = Just $ Rational (a * b) -mul (Rational a) (Imaginary b) = Just $ Imaginary (a * b) mul (Rational a) (Complex br bi) = Just $ Complex (a * br) (a * bi) -mul (Imaginary a) (Imaginary b) = Just $ Imaginary (a * b) -mul (Imaginary a) (Rational b) = Just $ Complex b a -mul (Imaginary a) (Complex br bi) = Just $ Complex (a * br) (a * bi) mul _ _ = Nothing div :: Expr -> Expr -> Maybe Expr div _ (Rational 0) = Nothing -div _ (Imaginary 0) = Nothing div _ (Complex 0 0) = Nothing div a b = mul a =<< b `Expr.exp` Rational (-1) @@ -96,21 +100,12 @@ mod _ _ = Nothing exp :: Expr -> Expr -> Maybe Expr exp (Rational a) (Rational b) = Just $ Rational (a ** b) - -exp (Imaginary a) (Rational b) - | b < 0 = Expr.div (Rational 1) =<< Imaginary a `Expr.exp` Rational b - | b == 0 = Just $ Rational a - | b == 1 = Just $ Imaginary a - | b == 2 = Just $ Rational (-a) - | b == 3 = Just $ Imaginary (-a) - | otherwise = Imaginary a `Expr.exp` Rational (b - 4) - exp _ _ = Nothing dot :: Expr -> Expr -> Maybe Expr dot (Matrix a) (Matrix b) - | shape a == shape bT = Matrix <$> mapM (\ai -> mapM (dotProd ai) bT) a + | shape a == shape bT = Matrix <$> mapM (\aRow -> mapM (dotProd aRow) bT) a | otherwise = Nothing where bT = transpose b shape m = [length m, length (head m)] diff --git a/src/parser/Core.hs b/src/parser/Core.hs index 5928fe4..64e0b84 100644 --- a/src/parser/Core.hs +++ b/src/parser/Core.hs @@ -100,13 +100,16 @@ choice :: [Parser a] -> Parser a choice [] = empty choice (p:ps) = p <|> choice ps --- verify :: (a -> Bool) -> Parser a -> Parser a --- verify predicate p = do a <- p --- if predicate a then p else Parser (\_ -> Left "Bonjour") +verify :: (a -> Bool) -> a -> Parser a +verify predicate x = if predicate x then pure x else empty --- Parse a string of alpha character, converted to lower case -labelP :: Parser String -labelP = (map toLower) <$> some (satisfyChar isAlpha) +-- Parse a string of alpha character +-- Convert to lower case and check that the label isn't `i` +varLabelP :: Parser String +varLabelP = (map toLower <$> some (satisfyChar isAlpha)) >>= verify (/= "i") + +funLabelP :: Parser String +funLabelP = map toLower <$> some (satisfyChar isAlpha) floatP :: Parser Float diff --git a/src/parser/Expr.hs b/src/parser/Expr.hs index 5334578..b462197 100644 --- a/src/parser/Expr.hs +++ b/src/parser/Expr.hs @@ -27,20 +27,23 @@ termP = operatorChoiceChain factorP factorP :: Parser Expr factorP = choice [ parenthesizedExprP - , imaginaryP , Rational <$> floatP , matrixP - , Function <$> labelP <*> parenthesizedExprP - , Variable <$> labelP + , Function <$> funLabelP <*> parenthesizedExprP + , imaginaryP + , Variable <$> varLabelP ] `chainl1` (infixOp "^" Exp) where parenthesizedExprP = parenthesis exprP - imaginaryP = Imaginary <$> (floatP <|> pure 1.0) <* char 'i' + imaginaryP = (Complex 0) <$> (floatP <|> pure 1.0) <* char 'i' -- Parse a matrix in the following format: -- [ [a, b]; [c, d] ] matrixP :: Parser Expr - matrixP = Matrix <$> brackets (matrixRowP `sepBy` (char ';')) + matrixP = Matrix <$> (brackets (matrixRowP `sepBy` (char ';')) >>= verify check) where matrixRowP = brackets (exprP `sepBy` (char ',')) brackets = between "[" "]" + check rows + | length rows == 0 = False + | otherwise = all ((length (head rows) ==) . length) $ tail rows diff --git a/src/parser/Statement.hs b/src/parser/Statement.hs index 889f24f..cfeabe1 100644 --- a/src/parser/Statement.hs +++ b/src/parser/Statement.hs @@ -14,15 +14,15 @@ data Statement | FunctionDeclaration String String Expr statementP :: Parser Statement -statementP = functionDeclarationP <|> variableDeclarationP <|> polynomEvaluationP <|> evaluationP +statementP = functionDeclarationP <|> variableDeclarationP <|> evaluationP <|> polynomEvaluationP where functionDeclarationP = FunctionDeclaration - <$> labelP - <*> parenthesis labelP + <$> funLabelP + <*> parenthesis varLabelP <*> (char '=' *> exprP) variableDeclarationP = VariableDeclaration - <$> labelP + <$> varLabelP <*> (char '=' *> exprP) polynomEvaluationP = PolynomEvaluation <$> exprP <*> (char '=' *> exprP <* char '?') |