diff --git a/TODO b/TODO index a3dbb9e..5f1d82f 100644 --- a/TODO +++ b/TODO @@ -1,15 +1,17 @@ # Intermediate code generation -- Put symbol table in the reader monad and it to the stack - or use the state monad for everything. -- Add errors handling to the monad stack. +- Traverse the AST and generate IR. # ELF generation - Don't ignore relocations where the symbol is not defined in the symbol table. Report an error about an undefined symbol. -- Don't hardcode symbols in symbolEntry. # Name analysis - Format error messages. +- Return non-zero error code on errors. + +# Built-in + +Printi should be able to print numbers with multiple digits. diff --git a/lib/Language/Elna/AST.hs b/lib/Language/Elna/AST.hs index 8f66bdc..087c2fd 100644 --- a/lib/Language/Elna/AST.hs +++ b/lib/Language/Elna/AST.hs @@ -7,11 +7,12 @@ module Language.Elna.AST , TypeExpression(..) , VariableDeclaration(..) {-, VariableAccess(..) - , Condition(..) + , Condition(..)-} , Expression(..) - , Literal(..)-} + , Literal(..) ) where +import Data.Int (Int32) import Data.List (intercalate) import Data.Word ({-Word16, -}Word32) import Language.Elna.Location (Identifier(..), showArrayType) @@ -67,8 +68,8 @@ data Statement {-| AssignmentStatement VariableAccess Expression | IfStatement Condition Statement (Maybe Statement) | WhileStatement Condition Statement - | CompoundStatement [Statement] - | CallStatement Identifier [Expression]-} + | CompoundStatement [Statement]-} + | CallStatement Identifier [Expression] deriving Eq instance Show Statement @@ -84,39 +85,58 @@ instance Show Statement show (WhileStatement expression statement) = concat ["while (", show expression, ") ", show statement, ";"] show (CompoundStatement statements) = - concat ["{\n", unlines (show <$> statements), " }"] + concat ["{\n", unlines (show <$> statements), " }"]-} show (CallStatement name parameters) = show name <> "(" - <> intercalate ", " (show <$> parameters) <> ")"-} + <> intercalate ", " (show <$> parameters) <> ")" data VariableDeclaration = VariableDeclaration Identifier TypeExpression deriving Eq -instance Show VariableDeclaration - where - show (VariableDeclaration identifier typeExpression) = - concat ["var ", show identifier, ": " <> show typeExpression, ";"] -{- -import Data.Int (Int32) -import Data.Char (chr) -import Numeric (showHex) - -data Literal +newtype Literal = IntegerLiteral Int32 - | HexadecimalLiteral Int32 + {- | HexadecimalLiteral Int32 | CharacterLiteral Word16 - | BooleanLiteral Bool + | BooleanLiteral Bool -} deriving Eq instance Show Literal where show (IntegerLiteral integer) = show integer - show (HexadecimalLiteral integer) = '0' : 'x' : showHex integer "" + {- show (HexadecimalLiteral integer) = '0' : 'x' : showHex integer "" show (CharacterLiteral character) = '\'' : chr (fromEnum character) : ['\''] show (BooleanLiteral boolean) | boolean = "true" - | otherwise = "false" + | otherwise = "false" -} + +instance Show VariableDeclaration + where + show (VariableDeclaration identifier typeExpression) = + concat ["var ", show identifier, ": " <> show typeExpression, ";"] + +newtype Expression + = LiteralExpression Literal +{- | VariableExpression VariableAccess + | NegationExpression Expression + | SumExpression Expression Expression + | SubtractionExpression Expression Expression + | ProductExpression Expression Expression + | DivisionExpression Expression Expression -} + deriving Eq + +instance Show Expression + where + show (LiteralExpression literal) = show literal + {- show (VariableExpression variable) = show variable + show (NegationExpression negation) = '-' : show negation + 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] -} +{- +import Data.Char (chr) +import Numeric (showHex) data VariableAccess = VariableAccess Identifier @@ -129,26 +149,6 @@ instance Show VariableAccess show (ArrayAccess arrayAccess elementIndex) = concat [show arrayAccess, "[", show elementIndex, "]"] -data Expression - = VariableExpression VariableAccess - | LiteralExpression Literal - | NegationExpression Expression - | SumExpression Expression Expression - | SubtractionExpression Expression Expression - | ProductExpression Expression Expression - | DivisionExpression Expression Expression - deriving Eq - -instance Show Expression - where - show (VariableExpression variable) = show variable - show (LiteralExpression literal) = show literal - show (NegationExpression negation) = '-' : show negation - 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] - data Condition = EqualCondition Expression Expression | NonEqualCondition Expression Expression diff --git a/lib/Language/Elna/CodeGenerator.hs b/lib/Language/Elna/CodeGenerator.hs index e61e274..832917f 100644 --- a/lib/Language/Elna/CodeGenerator.hs +++ b/lib/Language/Elna/CodeGenerator.hs @@ -1,5 +1,5 @@ module Language.Elna.CodeGenerator - ( Asm(..) + ( Statement(..) , generateCode ) where @@ -15,12 +15,12 @@ data Directive | FunctionDirective deriving (Eq, Show) -data Asm +data Statement = Instruction RiscV.Instruction | JumpLabel ByteString [Directive] deriving Eq -generateCode :: SymbolTable -> Vector Quadruple -> Vector Asm +generateCode :: SymbolTable -> Vector Quadruple -> Vector Statement generateCode _ _ = Vector.fromList [ JumpLabel "main" [GlobalDirective, FunctionDirective] , Instruction (RiscV.CallInstruction "printi") diff --git a/lib/Language/Elna/NameAnalysis.hs b/lib/Language/Elna/NameAnalysis.hs index c4b7391..6cb2f5c 100644 --- a/lib/Language/Elna/NameAnalysis.hs +++ b/lib/Language/Elna/NameAnalysis.hs @@ -17,7 +17,7 @@ import Data.Functor ((<&>)) import Language.Elna.Location (Identifier(..)) import Language.Elna.Types (Type(..)) import Data.Foldable (traverse_) -import Control.Monad (foldM) +import Control.Monad (foldM, unless) data Error = UndefinedTypeError Identifier @@ -128,38 +128,16 @@ dataType environmentSymbolTable (AST.NamedType baseType) = do dataType environmentSymbolTable (AST.ArrayType arraySize baseType) = dataType environmentSymbolTable baseType <&> ArrayType arraySize -statement :: SymbolTable -> AST.Statement -> NameAnalysis () -statement _ AST.EmptyStatement = pure () -{- statement globalTable (AST.AssignmentStatement lvalue rvalue) - = variableAccess globalTable lvalue - >> expression globalTable rvalue -statement globalTable (AST.IfStatement ifCondition ifStatement elseStatement) - = condition globalTable ifCondition - >> statement globalTable ifStatement - >> maybe (pure ()) (statement globalTable) elseStatement -statement globalTable (AST.WhileStatement whileCondition loop) - = condition globalTable whileCondition - >> statement globalTable loop -statement globalTable (AST.CompoundStatement statements) = - traverse_ (statement globalTable) statements -statement globalTable (AST.CallStatement name arguments) - = checkSymbol globalTable name - >> traverse_ (expression globalTable) arguments - checkSymbol :: SymbolTable -> Identifier -> NameAnalysis () -checkSymbol globalTable identifier = - let undefinedSymbolError = NameAnalysis - $ lift - $ throwE - $ UndefinedSymbolError identifier - isDefined = SymbolTable.member identifier globalTable - in NameAnalysis (asks (SymbolTable.member identifier)) - >>= (flip unless undefinedSymbolError . (isDefined ||)) +checkSymbol globalTable identifier + = unless (SymbolTable.member identifier globalTable) + $ NameAnalysis $ throwE + $ UndefinedSymbolError identifier expression :: SymbolTable -> AST.Expression -> NameAnalysis () -expression globalTable (AST.VariableExpression variableExpression) = - variableAccess globalTable variableExpression expression _ (AST.LiteralExpression _) = pure () +{- expression globalTable (AST.VariableExpression variableExpression) = + variableAccess globalTable variableExpression expression globalTable (AST.NegationExpression negation) = expression globalTable negation expression globalTable (AST.SumExpression lhs rhs) @@ -174,6 +152,24 @@ expression globalTable (AST.ProductExpression lhs rhs) expression globalTable (AST.DivisionExpression lhs rhs) = expression globalTable lhs >> expression globalTable rhs +-} +statement :: SymbolTable -> AST.Statement -> NameAnalysis () +statement _ AST.EmptyStatement = pure () +statement globalTable (AST.CallStatement name arguments) + = checkSymbol globalTable name + >> traverse_ (expression globalTable) arguments +{- statement globalTable (AST.AssignmentStatement lvalue rvalue) + = variableAccess globalTable lvalue + >> expression globalTable rvalue +statement globalTable (AST.IfStatement ifCondition ifStatement elseStatement) + = condition globalTable ifCondition + >> statement globalTable ifStatement + >> maybe (pure ()) (statement globalTable) elseStatement +statement globalTable (AST.WhileStatement whileCondition loop) + = condition globalTable whileCondition + >> statement globalTable loop +statement globalTable (AST.CompoundStatement statements) = + traverse_ (statement globalTable) statements variableAccess :: SymbolTable -> AST.VariableAccess -> NameAnalysis () variableAccess globalTable (AST.ArrayAccess arrayExpression indexExpression) diff --git a/lib/Language/Elna/Parser.hs b/lib/Language/Elna/Parser.hs index 57ebb1b..5583601 100644 --- a/lib/Language/Elna/Parser.hs +++ b/lib/Language/Elna/Parser.hs @@ -4,7 +4,7 @@ module Language.Elna.Parser ) where import Control.Monad (void) --- import Control.Monad.Combinators.Expr (Operator(..), makeExprParser) +import Control.Monad.Combinators.Expr ({-Operator(..), -} makeExprParser) import Data.Text (Text) import qualified Data.Text as Text import Data.Void (Void) @@ -17,19 +17,19 @@ import Language.Elna.AST , TypeExpression(..) , VariableDeclaration(..) {-, VariableAccess(..) - , Condition(..) + , Condition(..)-} , Expression(..) - , Literal(..)-} + , Literal(..) ) import Text.Megaparsec ( Parsec , () - --, MonadParsec(..) + , MonadParsec(..) , eof , optional , between , sepBy - --, choice + , choice ) import qualified Text.Megaparsec.Char.Lexer as Lexer import Text.Megaparsec.Char @@ -44,6 +44,17 @@ import Data.Maybe (isJust) -- import Data.Functor (($>)) type Parser = Parsec Void Text + +literalP :: Parser Literal +literalP + = {- HexadecimalLiteral <$> (string "0x" *> lexeme Lexer.hexadecimal) + <|> -} IntegerLiteral <$> lexeme Lexer.decimal + {- <|> CharacterLiteral <$> lexeme charP + <|> BooleanLiteral <$> (symbol "true" $> True) + <|> BooleanLiteral <$> (symbol "false" $> False) + where + charP = fromIntegral . fromEnum + <$> between (char '\'') (char '\'') Lexer.charLiteral -} {- typeDefinitionP :: Parser Declaration typeDefinitionP = TypeDefinition @@ -51,25 +62,14 @@ typeDefinitionP = TypeDefinition <*> (symbol "=" *> typeExpressionP) <* semicolonP "type definition" - -literalP :: Parser Literal -literalP - = HexadecimalLiteral <$> (string "0x" *> lexeme Lexer.hexadecimal) - <|> IntegerLiteral <$> lexeme Lexer.decimal - <|> CharacterLiteral <$> lexeme charP - <|> BooleanLiteral <$> (symbol "true" $> True) - <|> BooleanLiteral <$> (symbol "false" $> False) - where - charP = fromIntegral . fromEnum - <$> between (char '\'') (char '\'') Lexer.charLiteral - +-} termP :: Parser Expression termP = choice [ parensP expressionP , LiteralExpression <$> literalP - , VariableExpression <$> variableAccessP + -- , VariableExpression <$> variableAccessP ] - +{- variableAccessP :: Parser VariableAccess variableAccessP = do identifier <- identifierP @@ -97,10 +97,10 @@ operatorTable = ] prefix name f = Prefix (f <$ symbol name) binary name f = InfixL (f <$ symbol name) - +-} expressionP :: Parser Expression -expressionP = makeExprParser termP operatorTable - +expressionP = makeExprParser termP [] -- operatorTable +{- conditionP :: Parser Condition conditionP = do lhs <- expressionP @@ -185,21 +185,21 @@ statementP {-<|> CompoundStatement <$> blockP (many statementP) <|> try assignmentP <|> try ifElseP - <|> try whileP - <|> try callP -} + <|> try whileP -} + <|> try callP "statement" - {-where - ifElseP = IfStatement + where + callP = CallStatement + <$> identifierP + <*> parensP (sepBy expressionP commaP) + <* semicolonP + {-ifElseP = IfStatement <$> (symbol "if" *> parensP conditionP) <*> statementP <*> optional (symbol "else" *> statementP) whileP = WhileStatement <$> (symbol "while" *> parensP conditionP) <*> statementP - callP = CallStatement - <$> identifierP - <*> parensP (sepBy expressionP commaP) - <* semicolonP assignmentP = AssignmentStatement <$> variableAccessP <* symbol ":=" diff --git a/lib/Language/Elna/PrinterWriter.hs b/lib/Language/Elna/PrinterWriter.hs index 8ab1aed..40b60de 100644 --- a/lib/Language/Elna/PrinterWriter.hs +++ b/lib/Language/Elna/PrinterWriter.hs @@ -44,12 +44,14 @@ import qualified Language.Elna.Architecture.RiscV as RiscV import qualified Data.Text.Encoding as Text.Encoding import Control.Monad.IO.Class (MonadIO(..)) import Control.Monad.Trans.State (get) -import Language.Elna.CodeGenerator (Asm(..)) +import Language.Elna.CodeGenerator (Statement(..)) +import qualified Data.HashSet as HashSet +import GHC.Records (HasField(..)) data UnresolvedRelocation = UnresolvedRelocation ByteString Elf32_Addr Word8 data UnresolvedRelocations = UnresolvedRelocations (Vector UnresolvedRelocation) Elf32_Word -riscv32Elf :: Vector Asm -> Handle -> ElfWriter Elf32_Ehdr +riscv32Elf :: Vector Statement -> Handle -> ElfWriter Elf32_Ehdr riscv32Elf code objectHandle = text >>= uncurry symrel >>= strtab @@ -180,9 +182,14 @@ riscv32Elf code objectHandle = text , st_name = 0 , st_info = 0 } - (encoded, updatedRelocations, symbols) = - encodeAsm textTabIndex (mempty, Vector.empty, initialHeaders) code - symbolResult = encodeEmptyDefinitions symbols + (encoded, updatedRelocations, symbols, definitions) = + encodeAsm textTabIndex (mempty, Vector.empty, initialHeaders, HashSet.empty) code + + filterPredicate = not + . (`ByteString.isInfixOf` getField @"sectionNames" symbols) + . ("\0" <>) . (<> "\0") + symbolResult = HashSet.foldl' encodeEmptyDefinitions symbols + $ HashSet.filter filterPredicate definitions size = fromIntegral $ LazyByteString.length encoded newHeader = Elf32_Shdr { sh_type = SHT_PROGBITS @@ -199,8 +206,8 @@ riscv32Elf code objectHandle = text liftIO $ ByteString.hPut objectHandle $ LazyByteString.toStrict encoded addSectionHeader ".text" newHeader pure (symbolResult, UnresolvedRelocations updatedRelocations $ fromIntegral $ Vector.length sectionHeaders) - encodeEmptyDefinitions (ElfHeaderResult names entries) = - let printEntry = Elf32_Sym + encodeEmptyDefinitions (ElfHeaderResult names entries) definition = + let nextEntry = Elf32_Sym { st_value = 0 , st_size = 0 , st_shndx = 0 @@ -208,18 +215,18 @@ riscv32Elf code objectHandle = text , st_name = fromIntegral (ByteString.length names) , st_info = stInfo STB_GLOBAL STT_FUNC } - in ElfHeaderResult (names <> "printi\0") - $ Vector.snoc entries printEntry - encodeAsm shndx (encoded, relocations, ElfHeaderResult names symbols) instructions + in ElfHeaderResult (names <> definition <> "\0") + $ Vector.snoc entries nextEntry + encodeAsm shndx (encoded, relocations, ElfHeaderResult names symbols, definitions) instructions | Just (instruction, rest) <- Vector.uncons instructions = case instruction of Instruction _ -> - let (encoded', relocations', rest') = - encodeInstructions (encoded, relocations, instructions) - in encodeAsm shndx (encoded', relocations', ElfHeaderResult names symbols) rest' + let (encoded', relocations', rest', definitions') = + encodeInstructions (encoded, relocations, instructions, definitions) + in encodeAsm shndx (encoded', relocations', ElfHeaderResult names symbols, definitions') rest' JumpLabel labelName _ -> - let (encoded', relocations', rest') = - encodeInstructions (encoded, relocations, rest) + let (encoded', relocations', rest', definitions') = + encodeInstructions (encoded, relocations, rest, definitions) newEntry = Elf32_Sym { st_value = fromIntegral $ LazyByteString.length encoded , st_size = fromIntegral $ LazyByteString.length encoded' @@ -232,10 +239,11 @@ riscv32Elf code objectHandle = text ( encoded <> encoded' , relocations <> relocations' , ElfHeaderResult (names <> labelName <> "\0") (Vector.snoc symbols newEntry) + , definitions' ) in encodeAsm shndx result rest' - | otherwise = (encoded, relocations, ElfHeaderResult names symbols) - encodeInstructions (encoded, relocations, instructions) + | otherwise = (encoded, relocations, ElfHeaderResult names symbols, definitions) + encodeInstructions (encoded, relocations, instructions, definitions) | Just (Instruction instruction, rest) <- Vector.uncons instructions = let offset = fromIntegral $ LazyByteString.length encoded unresolvedRelocation = case instruction of @@ -259,6 +267,10 @@ riscv32Elf code objectHandle = text ( encoded <> chunk , maybe relocations (Vector.snoc relocations) unresolvedRelocation , rest + , addDefinition unresolvedRelocation definitions ) in encodeInstructions result - | otherwise = (encoded, relocations, Vector.drop 1 instructions) + | otherwise = (encoded, relocations, Vector.drop 1 instructions, definitions) + addDefinition (Just (UnresolvedRelocation symbolName _ _)) = + HashSet.insert symbolName + addDefinition Nothing = id diff --git a/lib/Language/Elna/SymbolTable.hs b/lib/Language/Elna/SymbolTable.hs index 52b8542..97d9621 100644 --- a/lib/Language/Elna/SymbolTable.hs +++ b/lib/Language/Elna/SymbolTable.hs @@ -20,8 +20,9 @@ import Data.List.NonEmpty (NonEmpty) import qualified Data.List.NonEmpty as NonEmpty import Data.Maybe (isJust) import Data.Vector (Vector) +import qualified Data.Vector as Vector import Language.Elna.Location (Identifier(..)) -import Language.Elna.Types (Type(..), intType, booleanType) +import Language.Elna.Types (Type(..), intType) import Prelude hiding (lookup) data SymbolTable = SymbolTable (Maybe SymbolTable) (HashMap Identifier Info) @@ -39,7 +40,7 @@ scope parent (SymbolTable _ mappings) = SymbolTable (Just parent) mappings builtInSymbolTable :: SymbolTable builtInSymbolTable = SymbolTable Nothing $ HashMap.fromList - [ ("boolean", TypeInfo booleanType) + [ ("printi", ProcedureInfo empty Vector.empty) , ("int", TypeInfo intType) ] diff --git a/tests/expectations/empty.txt b/tests/expectations/print0.txt similarity index 100% rename from tests/expectations/empty.txt rename to tests/expectations/print0.txt diff --git a/tests/vm/empty.elna b/tests/vm/print0.elna similarity index 55% rename from tests/vm/empty.elna rename to tests/vm/print0.elna index fffe51f..fcea2e4 100644 --- a/tests/vm/empty.elna +++ b/tests/vm/print0.elna @@ -1,2 +1,3 @@ proc main() { + printi(0); } diff --git a/tools/builtin.s b/tools/builtin.s index 6274b2e..e75aaea 100644 --- a/tools/builtin.s +++ b/tools/builtin.s @@ -1,6 +1,3 @@ -.global main -.type main, @function - .global printi .type printi, @function @@ -35,7 +32,7 @@ printi: ret _start: - call "main" + call main addi a0, zero, 0 addi a7, zero, 93 ecall