Parse call statements

TODO

@@ -1,15 +1,17 @@
 # Intermediate code generation
 
-- Put symbol table in the reader monad and it to the stack
+- Traverse the AST and generate IR.
-  or use the state monad for everything.
-- Add errors handling to the monad stack.
 
 # 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.

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]
+    | CompoundStatement [Statement]-}
-    | CallStatement Identifier [Expression]-}
+    | 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
+newtype Literal
-  where
-    show (VariableDeclaration identifier typeExpression) =
-        concat ["var ", show identifier, ": " <> show typeExpression, ";"]
-{-
-import Data.Int (Int32)
-import Data.Char (chr)
-import Numeric (showHex)
-
-data 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

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")

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 =
+checkSymbol globalTable identifier
-    let undefinedSymbolError = NameAnalysis
+    = unless (SymbolTable.member identifier globalTable)
-            $ lift
+    $ NameAnalysis $ throwE
-            $ throwE
+    $ UndefinedSymbolError identifier
-            $ UndefinedSymbolError identifier
-        isDefined = SymbolTable.member identifier globalTable
-     in NameAnalysis (asks (SymbolTable.member identifier))
-        >>= (flip unless undefinedSymbolError . (isDefined ||))
 
 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)

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 whileP -}
-    <|> try callP -}
+    <|> try callP
     <?> "statement"
-  {-where
+  where
-    ifElseP = IfStatement
+    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 ":="

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) = 
+            (encoded, updatedRelocations, symbols, definitions) = 
-                encodeAsm textTabIndex (mempty, Vector.empty, initialHeaders) code
+                encodeAsm textTabIndex (mempty, Vector.empty, initialHeaders, HashSet.empty) code
-            symbolResult = encodeEmptyDefinitions symbols
+
+            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) =
+    encodeEmptyDefinitions (ElfHeaderResult names entries) definition =
-        let printEntry = Elf32_Sym
+        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")
+         in ElfHeaderResult (names <> definition <> "\0")
-            $ Vector.snoc entries printEntry 
+            $ Vector.snoc entries nextEntry
-    encodeAsm shndx (encoded, relocations, ElfHeaderResult names symbols) instructions
+    encodeAsm shndx (encoded, relocations, ElfHeaderResult names symbols, definitions) instructions
         | Just (instruction, rest) <- Vector.uncons instructions =
             case instruction of
                 Instruction _ ->
-                    let (encoded', relocations', rest') =
+                    let (encoded', relocations', rest', definitions') =
-                            encodeInstructions (encoded, relocations, instructions)
+                            encodeInstructions (encoded, relocations, instructions, definitions)
-                     in encodeAsm shndx (encoded', relocations', ElfHeaderResult names symbols) rest'
+                     in encodeAsm shndx (encoded', relocations', ElfHeaderResult names symbols, definitions') rest'
                 JumpLabel labelName _ ->
-                    let (encoded', relocations', rest') =
+                    let (encoded', relocations', rest', definitions') =
-                            encodeInstructions (encoded, relocations, rest)
+                            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)
+        | otherwise = (encoded, relocations, ElfHeaderResult names symbols, definitions)
-    encodeInstructions (encoded, relocations, instructions)
+    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

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)
     ]
 

tests/vm/print0.elna

@@ -1,2 +1,3 @@
 proc main() {
+  printi(0);
 }

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