95 lines
3.7 KiB
Haskell
95 lines
3.7 KiB
Haskell
module Ubc.Parse.Expression
|
|
( Expression(..)
|
|
, BinaryOperator(..)
|
|
, expressionParser
|
|
)
|
|
where
|
|
import Control.Monad ( (<$!>) )
|
|
import Data.Functor
|
|
import Text.Parsec.Expr (Operator(Infix), Assoc (AssocLeft), buildExpressionParser)
|
|
import qualified Ubc.Parse.Language as UbcLanguage
|
|
import Text.Parsec (ParsecT, (<|>), (<?>), choice, option)
|
|
|
|
data Expression = Binary BinaryOperator Expression Expression
|
|
| ConstantInteger Integer
|
|
| FunctionCall String [Expression]
|
|
| Variable String
|
|
| If Expression Expression (Maybe Expression)
|
|
deriving (Show)
|
|
data BinaryOperator = Plus
|
|
| Minus
|
|
| Multiply
|
|
| Divide
|
|
| Modulo
|
|
| ShiftLeft
|
|
| ShiftRight
|
|
| LessThan
|
|
| GreaterThan
|
|
| LessEqual
|
|
| GreaterEqual
|
|
| Equal
|
|
| NotEqual
|
|
| BitAnd
|
|
| BitOr
|
|
| BitXor
|
|
deriving (Show)
|
|
|
|
operatorTable :: Monad m => [[Operator String u m Expression]]
|
|
operatorTable =
|
|
[
|
|
[ Infix (UbcLanguage.reservedOperator "*" >> return (Binary Multiply)) AssocLeft
|
|
, Infix (UbcLanguage.reservedOperator "/" >> return (Binary Divide)) AssocLeft
|
|
, Infix (UbcLanguage.reservedOperator "%" >> return (Binary Modulo)) AssocLeft
|
|
]
|
|
,
|
|
[ Infix (UbcLanguage.reservedOperator "+" >> return (Binary Plus)) AssocLeft
|
|
, Infix (UbcLanguage.reservedOperator "-" >> return (Binary Minus)) AssocLeft
|
|
]
|
|
,
|
|
[ Infix (UbcLanguage.reservedOperator "<<" >> return (Binary ShiftLeft)) AssocLeft
|
|
, Infix (UbcLanguage.reservedOperator ">>" >> return (Binary ShiftRight)) AssocLeft
|
|
]
|
|
,
|
|
[ Infix (UbcLanguage.reservedOperator ">=" >> return (Binary GreaterEqual)) AssocLeft
|
|
, Infix (UbcLanguage.reservedOperator "<=" >> return (Binary LessEqual)) AssocLeft
|
|
, Infix (UbcLanguage.reservedOperator "<" >> return (Binary LessThan)) AssocLeft
|
|
, Infix (UbcLanguage.reservedOperator ">" >> return (Binary GreaterThan)) AssocLeft
|
|
]
|
|
,
|
|
[ Infix (UbcLanguage.reservedOperator "==" >> return (Binary Equal)) AssocLeft
|
|
, Infix (UbcLanguage.reservedOperator "!=" >> return (Binary NotEqual)) AssocLeft
|
|
]
|
|
,
|
|
[ Infix (UbcLanguage.reservedOperator "&" >> return (Binary BitAnd)) AssocLeft
|
|
, Infix (UbcLanguage.reservedOperator "|" >> return (Binary BitOr)) AssocLeft
|
|
, Infix (UbcLanguage.reservedOperator "^" >> return (Binary BitXor)) AssocLeft
|
|
]
|
|
]
|
|
|
|
expressionParser :: (Monad m) => ParsecT String u m Expression
|
|
expressionParser = buildExpressionParser operatorTable termParser <?> "expression"
|
|
|
|
termParser :: Monad m => ParsecT String u m Expression
|
|
termParser = UbcLanguage.parens expressionParser
|
|
<|> fmap ConstantInteger UbcLanguage.integer
|
|
<|> expressionIf
|
|
<|> functionCallOrVariable
|
|
|
|
expressionIf :: Monad m => ParsecT String u m Expression
|
|
expressionIf = do
|
|
_ <- UbcLanguage.reserved "if"
|
|
condition <- expressionParser
|
|
_ <- UbcLanguage.reserved "then"
|
|
then_ <- expressionParser
|
|
else_ <- option Nothing (UbcLanguage.reserved "else" >> expressionParser <&> Just)
|
|
|
|
return $ If condition then_ else_
|
|
|
|
functionCallOrVariable :: Monad m => ParsecT String u m Expression
|
|
functionCallOrVariable = do
|
|
name <- UbcLanguage.identifier
|
|
choice
|
|
[ FunctionCall name <$!> UbcLanguage.parens (UbcLanguage.commaSeparated expressionParser)
|
|
, return $ Variable name
|
|
]
|
|
|