Parse expressions
This commit is contained in:
parent
9d1f038594
commit
947c5aa7ef
@ -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
|
||||||
|
@ -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
|
||||||
|
@ -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)
|
||||||
|
@ -1,2 +0,0 @@
|
|||||||
begin
|
|
||||||
end.
|
|
Loading…
Reference in New Issue
Block a user