Initial commit
This commit is contained in:
202
src/Language/Elna/AST.hs
Normal file
202
src/Language/Elna/AST.hs
Normal file
@ -0,0 +1,202 @@
|
||||
module Language.Elna.AST
|
||||
( ConstantDefinition(..)
|
||||
, Expression(..)
|
||||
, Identifier(..)
|
||||
, Literal(..)
|
||||
, ProcedureDeclaration(..)
|
||||
, Program(..)
|
||||
, Statement(..)
|
||||
, VariableDeclaration(..)
|
||||
, TypeName(..)
|
||||
) where
|
||||
|
||||
import Data.Int (Int32)
|
||||
import Data.List (intercalate)
|
||||
import Data.Word (Word8)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as Text
|
||||
import Data.Char (chr)
|
||||
|
||||
newtype Identifier = Identifier { unIdentifier :: Text }
|
||||
deriving Eq
|
||||
|
||||
instance Show Identifier
|
||||
where
|
||||
show (Identifier identifier) = Text.unpack identifier
|
||||
|
||||
data TypeName
|
||||
= NamedType Identifier
|
||||
| PointerType TypeName
|
||||
| ArrayType TypeName Int32
|
||||
| ProcedureType [Parameter]
|
||||
deriving Eq
|
||||
|
||||
instance Show TypeName
|
||||
where
|
||||
show (NamedType typeName) = show typeName
|
||||
show (PointerType typeName) = '^' : show typeName
|
||||
show (ArrayType typeName elementCount) = concat
|
||||
[show typeName, "[", show elementCount, "]"]
|
||||
show (ProcedureType parameters) = "proc" <> showParameters parameters
|
||||
|
||||
data Literal
|
||||
= StringLiteral Text
|
||||
| IntegerLiteral Int32
|
||||
| CharacterLiteral Word8
|
||||
| BooleanLiteral Bool
|
||||
deriving Eq
|
||||
|
||||
instance Show Literal
|
||||
where
|
||||
show (StringLiteral string) = Text.unpack
|
||||
$ "\"" <> string <> "\""
|
||||
show (IntegerLiteral integer) = show integer
|
||||
show (CharacterLiteral character) =
|
||||
'\'' : chr (fromEnum character) : ['\'']
|
||||
show (BooleanLiteral boolean)
|
||||
| boolean = "true"
|
||||
| otherwise = "false"
|
||||
|
||||
data Expression
|
||||
= VariableExpression Identifier
|
||||
| LiteralExpression Literal
|
||||
| NegationExpression Expression
|
||||
| NotExpression Expression
|
||||
| ReferenceExpression Expression
|
||||
| DereferenceExpression Expression
|
||||
| SumExpression Expression Expression
|
||||
| SubtractionExpression Expression Expression
|
||||
| ProductExpression Expression Expression
|
||||
| DivisionExpression Expression Expression
|
||||
| EqualExpression Expression Expression
|
||||
| NonEqualExpression Expression Expression
|
||||
| LessExpression Expression Expression
|
||||
| GreaterExpression Expression Expression
|
||||
| LessOrEqualExpression Expression Expression
|
||||
| GreaterOrEqualExpression Expression Expression
|
||||
| IfExpression Expression Statement Statement
|
||||
| LoopExpression Expression Statement
|
||||
| FieldExpression Expression Identifier
|
||||
deriving Eq
|
||||
|
||||
instance Show Expression
|
||||
where
|
||||
show (VariableExpression variable) = show variable
|
||||
show (LiteralExpression literal) = show literal
|
||||
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 (SubtractionExpression lhs rhs) = concat [show lhs, " - ", show rhs]
|
||||
show (ProductExpression lhs rhs) = concat [show lhs, " * ", show rhs]
|
||||
show (DivisionExpression lhs rhs) = concat [show lhs, " / ", show rhs]
|
||||
show (EqualExpression lhs rhs) = concat [show lhs, " = ", show rhs]
|
||||
show (NonEqualExpression lhs rhs) = concat [show lhs, " /= ", show rhs]
|
||||
show (LessExpression 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 (GreaterOrEqualExpression lhs rhs) = concat [show lhs, " >= ", show rhs]
|
||||
show (IfExpression condition if' else') = concat
|
||||
[ "if ", show condition
|
||||
, " then " <> show if'
|
||||
, " else " <> show else'
|
||||
]
|
||||
show (LoopExpression accumulator iteration) = concat
|
||||
["loop ", show accumulator, " do ", show iteration]
|
||||
show (FieldExpression fieldExpression identifier) =
|
||||
show fieldExpression <> "." <> show identifier
|
||||
|
||||
data Statement
|
||||
= LetStatement Identifier TypeName Expression
|
||||
| CompoundStatement [Statement]
|
||||
| CallStatement Identifier [Expression]
|
||||
| ExpressionStatement Expression
|
||||
| BreakStatement Expression
|
||||
| ContinueStatement Expression
|
||||
deriving Eq
|
||||
|
||||
instance Show Statement
|
||||
where
|
||||
show (LetStatement identifier typeName definition) = concat
|
||||
["let ", show identifier, ": ", show typeName, " := ", show definition]
|
||||
show (CompoundStatement statements) = "begin "
|
||||
<> intercalate "; " (show <$> statements) <> " end"
|
||||
show (CallStatement name parameters) = show name <> "("
|
||||
<> intercalate ", " (show <$> parameters) <> ")"
|
||||
show (ExpressionStatement expression) = show expression
|
||||
show (BreakStatement break') = "break " <> show break'
|
||||
show (ContinueStatement continue') = "continue " <> show continue'
|
||||
|
||||
data ConstantDefinition =
|
||||
ConstantDefinition Identifier TypeName Literal
|
||||
deriving Eq
|
||||
|
||||
instance Show ConstantDefinition
|
||||
where
|
||||
show (ConstantDefinition identifier typeName definition) = concat
|
||||
[show identifier, ": ", show typeName, " := ", show definition, ";"]
|
||||
|
||||
data Parameter = Parameter Identifier TypeName
|
||||
deriving Eq
|
||||
|
||||
instance Show Parameter
|
||||
where
|
||||
show (Parameter identifier typeName) =
|
||||
show identifier <> ": " <> show typeName
|
||||
|
||||
data ProcedureDeclaration
|
||||
= ProcedureDeclaration Identifier [Parameter]
|
||||
| ProcedureDefinition Identifier [Parameter] Bool [ConstantDefinition] Statement
|
||||
deriving Eq
|
||||
|
||||
instance Show ProcedureDeclaration
|
||||
where
|
||||
show (ProcedureDeclaration procedureName parameters) =
|
||||
"proc " <> show procedureName <> showParameters parameters <> "; extern;"
|
||||
show (ProcedureDefinition procedureName parameters exports constants body)
|
||||
= "proc " <> show procedureName <> showParameters parameters <> ";"
|
||||
<> showAttributes exports
|
||||
<> showConstants constants
|
||||
<> show body <> ";"
|
||||
|
||||
data VariableDeclaration
|
||||
= VariableDeclaration Identifier TypeName
|
||||
| VariableDefinition Identifier TypeName (Maybe Literal) Bool
|
||||
deriving Eq
|
||||
|
||||
instance Show VariableDeclaration
|
||||
where
|
||||
show (VariableDeclaration identifier typeName)
|
||||
= show identifier <> ": " <> show typeName <> "; extern;"
|
||||
show (VariableDefinition identifier typeName initialValue exports)
|
||||
= show identifier <> ": " <> show typeName
|
||||
<> maybe "" ((" = " <>) . show) initialValue <> ";"
|
||||
<> showAttributes exports
|
||||
|
||||
data Program = Program [ConstantDefinition] [VariableDeclaration] [ProcedureDeclaration] Statement
|
||||
deriving Eq
|
||||
|
||||
instance Show Program
|
||||
where
|
||||
show (Program constants globals procedures body)
|
||||
= showConstants constants <> showVariables globals
|
||||
<> unlines (show <$> procedures) <> show body <> "."
|
||||
|
||||
showAttributes :: Bool -> String
|
||||
showAttributes True = " export;"
|
||||
showAttributes False = ""
|
||||
|
||||
showParameters :: [Parameter] -> String
|
||||
showParameters parameters =
|
||||
"(" <> intercalate ", " (show <$> parameters) <> ")"
|
||||
|
||||
showConstants :: [ConstantDefinition] -> String
|
||||
showConstants constants
|
||||
| null constants = ""
|
||||
| otherwise = " const " <> unwords (show <$> constants) <> "\n"
|
||||
|
||||
showVariables :: [VariableDeclaration] -> String
|
||||
showVariables variables
|
||||
| null variables = ""
|
||||
| otherwise = " var " <> unwords (show <$> variables) <> "\n"
|
||||
37
src/Language/Elna/Parser.hs
Normal file
37
src/Language/Elna/Parser.hs
Normal file
@ -0,0 +1,37 @@
|
||||
module Language.Elna.Parser
|
||||
( Parser
|
||||
, programP
|
||||
) where
|
||||
|
||||
import Control.Monad (void)
|
||||
import Data.Text (Text)
|
||||
import Data.Void (Void)
|
||||
import Language.Elna.AST
|
||||
( Statement(..)
|
||||
, Program(..)
|
||||
)
|
||||
import Text.Megaparsec (Parsec)
|
||||
import Text.Megaparsec.Char (space1)
|
||||
import qualified Text.Megaparsec.Char.Lexer as Lexer
|
||||
|
||||
type Parser = Parsec Void Text
|
||||
|
||||
space :: Parser ()
|
||||
space = Lexer.space space1 (Lexer.skipLineComment "//")
|
||||
$ Lexer.skipBlockComment "{" "}"
|
||||
|
||||
lexeme :: forall a. Parser a -> Parser a
|
||||
lexeme = Lexer.lexeme space
|
||||
|
||||
symbol :: Text -> Parser Text
|
||||
symbol = Lexer.symbol space
|
||||
|
||||
beginP :: Parser ()
|
||||
beginP = void $ symbol "begin"
|
||||
|
||||
endP :: Parser ()
|
||||
endP = void $ symbol "end"
|
||||
|
||||
programP :: Parser Program
|
||||
programP = beginP >> endP >> symbol "."
|
||||
>> pure (Program mempty mempty mempty $ CompoundStatement mempty)
|
||||
13
src/Main.hs
Normal file
13
src/Main.hs
Normal file
@ -0,0 +1,13 @@
|
||||
module Main where
|
||||
|
||||
import Language.Elna.Parser (programP)
|
||||
import Text.Megaparsec (runParser, errorBundlePretty)
|
||||
import qualified Data.Text.IO as Text
|
||||
|
||||
main :: IO ()
|
||||
main = Text.getContents
|
||||
>>= withParseResult . runParser programP ""
|
||||
where
|
||||
withParseResult (Right _) = pure ()
|
||||
withParseResult (Left errorBundle) =
|
||||
putStr $ errorBundlePretty errorBundle
|
||||
Reference in New Issue
Block a user