Parse expressions

This commit is contained in:
Eugen Wissner 2024-07-24 01:22:20 +02:00
parent 9d1f038594
commit 947c5aa7ef
4 changed files with 76 additions and 22 deletions

View File

@ -30,7 +30,7 @@ library elna-internal
Language.Elna.AST Language.Elna.AST
Language.Elna.Parser Language.Elna.Parser
build-depends: build-depends:
vector >= 0.12 && < 0.14 parser-combinators ^>= 1.3
hs-source-dirs: lib hs-source-dirs: lib
executable elna executable elna
@ -56,8 +56,7 @@ test-suite elna-test
hspec >= 2.10.9 && < 2.12, hspec >= 2.10.9 && < 2.12,
hspec-expectations ^>= 0.8.2, hspec-expectations ^>= 0.8.2,
hspec-megaparsec ^>= 2.2.0, hspec-megaparsec ^>= 2.2.0,
text, text
vector
build-tool-depends: build-tool-depends:
hspec-discover:hspec-discover hspec-discover:hspec-discover
default-language: GHC2021 default-language: GHC2021

View File

@ -61,9 +61,6 @@ data Expression
= VariableExpression Identifier = VariableExpression Identifier
| LiteralExpression Literal | LiteralExpression Literal
| NegationExpression Expression | NegationExpression Expression
| NotExpression Expression
| ReferenceExpression Expression
| DereferenceExpression Expression
| SumExpression Expression Expression | SumExpression Expression Expression
| SubtractionExpression Expression Expression | SubtractionExpression Expression Expression
| ProductExpression Expression Expression | ProductExpression Expression Expression
@ -74,7 +71,7 @@ data Expression
| GreaterExpression Expression Expression | GreaterExpression Expression Expression
| LessOrEqualExpression Expression Expression | LessOrEqualExpression Expression Expression
| GreaterOrEqualExpression Expression Expression | GreaterOrEqualExpression Expression Expression
| FieldExpression Expression Identifier | ArrayExpression Expression Expression
deriving Eq deriving Eq
instance Show Expression instance Show Expression
@ -82,9 +79,6 @@ instance Show Expression
show (VariableExpression variable) = show variable show (VariableExpression variable) = show variable
show (LiteralExpression literal) = show literal show (LiteralExpression literal) = show literal
show (NegationExpression negation) = '-' : show negation show (NegationExpression negation) = '-' : show negation
show (NotExpression negation) = "not " <> show negation
show (ReferenceExpression reference) = '@' : show reference
show (DereferenceExpression dereference) = show dereference <> "^"
show (SumExpression lhs rhs) = concat [show lhs, " + ", show rhs] show (SumExpression lhs rhs) = concat [show lhs, " + ", show rhs]
show (SubtractionExpression lhs rhs) = concat [show lhs, " - ", show rhs] show (SubtractionExpression lhs rhs) = concat [show lhs, " - ", show rhs]
show (ProductExpression lhs rhs) = concat [show lhs, " * ", show rhs] show (ProductExpression lhs rhs) = concat [show lhs, " * ", show rhs]
@ -95,8 +89,8 @@ instance Show Expression
show (GreaterExpression lhs rhs) = concat [show lhs, " > ", show rhs] show (GreaterExpression lhs rhs) = concat [show lhs, " > ", show rhs]
show (LessOrEqualExpression lhs rhs) = concat [show lhs, " <= ", show rhs] show (LessOrEqualExpression lhs rhs) = concat [show lhs, " <= ", show rhs]
show (GreaterOrEqualExpression lhs rhs) = concat [show lhs, " >= ", show rhs] show (GreaterOrEqualExpression lhs rhs) = concat [show lhs, " >= ", show rhs]
show (FieldExpression fieldExpression identifier) = show (ArrayExpression arrayExpression indexExpression) =
show fieldExpression <> "." <> show identifier concat [show arrayExpression, "[", show indexExpression, "]"]
data Statement data Statement
= EmptyStatement = EmptyStatement

View File

@ -4,22 +4,27 @@ module Language.Elna.Parser
) where ) where
import Control.Monad (void) import Control.Monad (void)
import Control.Monad.Combinators.Expr (Operator(..), makeExprParser)
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text as Text import qualified Data.Text as Text
import Data.Void (Void) import Data.Void (Void)
import Language.Elna.AST import Language.Elna.AST
( Declaration(..) ( Declaration(..)
, Expression(..)
, Identifier(..) , Identifier(..)
, Literal(..)
, Parameter(..) , Parameter(..)
, Program(..) , Program(..)
, Statement(..)
, TypeExpression(..) , TypeExpression(..)
, VariableDeclaration(..) , VariableDeclaration(..)
) )
import Text.Megaparsec (Parsec, (<?>), optional, between, sepBy) import Text.Megaparsec (Parsec, (<?>), optional, between, sepBy, choice)
import Text.Megaparsec.Char (alphaNumChar, letterChar, space1) import Text.Megaparsec.Char (alphaNumChar, char, letterChar, space1, asciiChar)
import qualified Text.Megaparsec.Char.Lexer as Lexer import qualified Text.Megaparsec.Char.Lexer as Lexer
import Control.Applicative (Alternative(..)) import Control.Applicative (Alternative(..))
import Data.Maybe (isJust) import Data.Maybe (isJust)
import Data.Functor (($>))
type Parser = Parsec Void Text type Parser = Parsec Void Text
@ -42,11 +47,8 @@ procedureP = void $ symbol "proc"
parensP :: forall a. Parser a -> Parser a parensP :: forall a. Parser a -> Parser a
parensP = between (symbol "(") (symbol ")") parensP = between (symbol "(") (symbol ")")
openBracketP :: Parser () bracketsP :: forall a. Parser a -> Parser a
openBracketP = void $ symbol "[" bracketsP = between (symbol "[") (symbol "]")
closingBracketP :: Parser ()
closingBracketP = void $ symbol "]"
colonP :: Parser () colonP :: Parser ()
colonP = void $ symbol ":" colonP = void $ symbol ":"
@ -65,7 +67,7 @@ typeExpressionP = arrayTypeExpression
<?> "type expression" <?> "type expression"
where where
arrayTypeExpression = flip ArrayType arrayTypeExpression = flip ArrayType
<$> (symbol "array" *> openBracketP *> lexeme Lexer.decimal <* closingBracketP) <$> (symbol "array" *> bracketsP (lexeme Lexer.decimal))
<*> (symbol "of" *> typeExpressionP) <*> (symbol "of" *> typeExpressionP)
typeDefinitionP :: Parser Declaration typeDefinitionP :: Parser Declaration
@ -92,6 +94,67 @@ parameterP = paramCons
parametersP :: Parser [Parameter] parametersP :: Parser [Parameter]
parametersP = parensP $ sepBy parameterP (symbol ",") parametersP = parensP $ sepBy parameterP (symbol ",")
literalP :: Parser Literal
literalP
= HexadecimalLiteral <$> Lexer.hexadecimal
<|> IntegerLiteral <$> Lexer.decimal
<|> CharacterLiteral <$> charP
<|> BooleanLiteral <$> (symbol "true" $> True)
<|> BooleanLiteral <$> (symbol "false" $> False)
where
-- TODO: Escape characters.
charP = fromIntegral . fromEnum
<$> between (char '\'') (char '\'') asciiChar
termP :: Parser Expression
termP = choice
[ parensP expressionP
, VariableExpression <$> identifierP
, LiteralExpression <$> literalP
]
operatorTable :: [[Operator Parser Expression]]
operatorTable =
[ [Postfix (ArrayExpression <$> bracketsP expressionP)]
, unaryOperator
, factoryOperator
, termOperator
, comparisonOperator
]
where
unaryOperator =
[ prefix "-" NegationExpression
, prefix "+" id
]
factoryOperator =
[ binary "*" ProductExpression
, binary "/" DivisionExpression
]
termOperator =
[ binary "+" SumExpression
, binary "-" SubtractionExpression
]
comparisonOperator =
[ binary "<" LessExpression
, binary "<=" LessOrEqualExpression
, binary ">" GreaterExpression
, binary ">=" GreaterOrEqualExpression
, binary "=" EqualExpression
, binary "#" NonEqualExpression
]
prefix name f = Prefix (f <$ symbol name)
binary name f = InfixL (f <$ symbol name)
expressionP :: Parser Expression
expressionP = makeExprParser termP operatorTable
statementP :: Parser Statement
statementP
= EmptyStatement <$ semicolonP
<|> AssignmentStatement <$> expressionP <* symbol ":=" <*> expressionP
<|> CompoundStatement <$> blockP (many statementP)
<?> "statement" -- TODO: further statements
procedureDefinitionP :: Parser Declaration procedureDefinitionP :: Parser Declaration
procedureDefinitionP = ProcedureDefinition procedureDefinitionP = ProcedureDefinition
<$> (procedureP *> identifierP) <$> (procedureP *> identifierP)

View File

@ -1,2 +0,0 @@
begin
end.