src/parser/Expr.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49

module Parser.Expr (exprP) where

import           Control.Applicative

import           Expr
import           Parser.Core


-- Parse expression separated by one infix operator of the operator list
operatorChoiceChain :: Parser a -> [Parser (a -> a -> a)] -> Parser a
operatorChoiceChain x operators = x `chainl1` choice operators

-- Parse an expression (lowest operator priority)
exprP :: Parser Expr
exprP = operatorChoiceChain termP
            [ infixOp "+" Add
            , infixOp "-" Sub
            ]

termP :: Parser Expr
termP =  operatorChoiceChain factorP
            [ infixOp "**" Dot
            , infixOp "*" Mul
            , infixOp "/" Div
            , infixOp "%" Mod
            ]

factorP :: Parser Expr
factorP =  choice [ parenthesizedExprP
                  , Rational <$> floatP
                  , matrixP
                  , Function <$> funLabelP <*> parenthesizedExprP
                  , imaginaryP
                  , Variable <$> varLabelP
                  ] `chainl1` (infixOp "^" Exp)
    where
        parenthesizedExprP = parenthesis exprP

        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 ';')) >>= verify check)
            where matrixRowP = brackets (exprP `sepBy` (char ','))
                  brackets = between "[" "]"
                  check rows
                    | length rows == 0 = False
                    | otherwise        = all ((length (head rows) ==) . length) $ tail rows