Stub the implementation for all phases

This commit is contained in:
Eugen Wissner 2024-09-08 02:08:13 +02:00
parent a625bbff50
commit 1cbbef19af
Signed by: belka
GPG Key ID: A27FDC1E8EE902C0
13 changed files with 319 additions and 139 deletions

View File

@ -37,8 +37,9 @@ library elna-internal
exposed-modules: exposed-modules:
Language.Elna.Architecture.RiscV Language.Elna.Architecture.RiscV
Language.Elna.AST Language.Elna.AST
Language.Elna.CommandLine
Language.Elna.CodeGenerator Language.Elna.CodeGenerator
Language.Elna.CommandLine
Language.Elna.PrinterWriter
Language.Elna.Intermediate Language.Elna.Intermediate
Language.Elna.Location Language.Elna.Location
Language.Elna.NameAnalysis Language.Elna.NameAnalysis

View File

@ -1,17 +1,19 @@
module Language.Elna.AST module Language.Elna.AST
( VariableAccess(..) ( Program(..)
{-, VariableAccess(..)
, Condition(..) , Condition(..)
, Declaration(..) , Declaration(..)
, Expression(..) , Expression(..)
, Identifier(..) , Identifier(..)
, Literal(..) , Literal(..)
, Parameter(..) , Parameter(..)
, Program(..)
, Statement(..) , Statement(..)
, VariableDeclaration(..) , VariableDeclaration(..)
, TypeExpression(..) , TypeExpression(..)-}
) where ) where
data Program = Program
{-
import Data.Int (Int32) import Data.Int (Int32)
import Data.List (intercalate) import Data.List (intercalate)
import Data.Word (Word16, Word32) import Data.Word (Word16, Word32)
@ -165,3 +167,4 @@ instance Show Program
showParameters :: [Parameter] -> String showParameters :: [Parameter] -> String
showParameters parameters = showParameters parameters =
"(" <> intercalate ", " (show <$> parameters) <> ")" "(" <> intercalate ", " (show <$> parameters) <> ")"
-}

View File

@ -136,6 +136,7 @@ data Type
| R XRegister Funct3 XRegister XRegister Funct7 | R XRegister Funct3 XRegister XRegister Funct7
| U XRegister Word32 | U XRegister Word32
| J XRegister Word32 | J XRegister Word32
| Type XRegister Funct3 XRegister Funct12 -- Privileged.
data Instruction = Instruction BaseOpcode Type data Instruction = Instruction BaseOpcode Type
@ -278,6 +279,11 @@ type' (J rd immediate)
.|. ((immediate .&. 0x800) `shiftL` 9) .|. ((immediate .&. 0x800) `shiftL` 9)
.|. ((immediate .&. 0x7fe) `shiftL` 20) .|. ((immediate .&. 0x7fe) `shiftL` 20)
.|. ((immediate .&. 0x100000) `shiftL` 11); .|. ((immediate .&. 0x100000) `shiftL` 11);
type' (Type rd funct3' rs1 funct12')
= (fromIntegral (xRegister rd) `shiftL` 7)
.|. (fromIntegral (funct3 funct3') `shiftL` 12)
.|. (fromIntegral (xRegister rs1) `shiftL` 15)
.|. (fromIntegral (funct12 funct12') `shiftL` 20);
instruction :: Instruction -> ByteString.Builder.Builder instruction :: Instruction -> ByteString.Builder.Builder
instruction (Instruction base instructionType) instruction (Instruction base instructionType)

View File

@ -1,3 +1,16 @@
module Language.Elna.CodeGenerator module Language.Elna.CodeGenerator
( ( generateCode
) where ) where
import Data.Vector (Vector)
import qualified Data.Vector as Vector
import Language.Elna.Intermediate (Quadruple(..))
import qualified Language.Elna.Architecture.RiscV as RiscV
import Language.Elna.SymbolTable (SymbolTable)
generateCode :: SymbolTable -> Vector Quadruple -> Vector RiscV.Instruction
generateCode _ _ = Vector.fromList
[ RiscV.Instruction RiscV.OpImm $ RiscV.I RiscV.A0 RiscV.ADDI RiscV.Zero 0
, RiscV.Instruction RiscV.OpImm $ RiscV.I RiscV.A7 RiscV.ADDI RiscV.Zero 93
, RiscV.Instruction RiscV.System $ RiscV.Type RiscV.Zero RiscV.PRIV RiscV.Zero RiscV.ECALL
]

View File

@ -1,11 +1,28 @@
module Language.Elna.Intermediate module Language.Elna.Intermediate
( Label(..) ( Quadruple(..)
{- , Label(..)
, Operand(..) , Operand(..)
, Quadruple(..) , Variable(..) -}
, Variable(..)
, intermediate , intermediate
) where ) where
import Data.Vector (Vector)
import qualified Data.Vector as Vector
import qualified Language.Elna.AST as AST
import Language.Elna.SymbolTable (SymbolTable{-, Info(..) -})
data Quadruple
= StartQuadruple
| StopQuadruple
deriving (Eq, Show)
intermediate :: SymbolTable -> AST.Program -> {- HashMap AST.Identifier (-} Vector Quadruple --)
intermediate _globalTable = const $ Vector.fromList [StartQuadruple, StopQuadruple]
{- = fst
. flip runState mempty
. runIntermediate
. program globalTable -}
{-
import Control.Monad.Trans.State (State, runState, gets, modify') import Control.Monad.Trans.State (State, runState, gets, modify')
import Data.Bifunctor (Bifunctor(..)) import Data.Bifunctor (Bifunctor(..))
import Data.Int (Int32) import Data.Int (Int32)
@ -13,11 +30,7 @@ import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap import qualified Data.HashMap.Strict as HashMap
import Data.Text (Text) import Data.Text (Text)
import Data.Word (Word32) import Data.Word (Word32)
import Data.Vector (Vector)
import qualified Data.Vector as Vector
import qualified Language.Elna.AST as AST
import Language.Elna.Types (Type(..)) import Language.Elna.Types (Type(..))
import Language.Elna.SymbolTable (SymbolTable, Info(..))
import qualified Language.Elna.SymbolTable as SymbolTable import qualified Language.Elna.SymbolTable as SymbolTable
import Data.Foldable (Foldable(..), foldrM) import Data.Foldable (Foldable(..), foldrM)
import GHC.Records (HasField(..)) import GHC.Records (HasField(..))
@ -129,13 +142,6 @@ createTemporary = do
{ temporaryCounter = getField @"temporaryCounter" generator + 1 { temporaryCounter = getField @"temporaryCounter" generator + 1
} }
intermediate :: SymbolTable -> AST.Program -> HashMap AST.Identifier (Vector Quadruple)
intermediate globalTable
= fst
. flip runState mempty
. runIntermediate
. program globalTable
program program
:: SymbolTable :: SymbolTable
-> AST.Program -> AST.Program
@ -326,3 +332,4 @@ literal (AST.CharacterLiteral character) = IntOperand $ fromIntegral character
literal (AST.BooleanLiteral boolean) literal (AST.BooleanLiteral boolean)
| boolean = IntOperand 1 | boolean = IntOperand 1
| otherwise = IntOperand 0 | otherwise = IntOperand 0
-}

View File

@ -1,8 +1,22 @@
module Language.Elna.NameAnalysis module Language.Elna.NameAnalysis
( Error(..) ( nameAnalysis
, nameAnalysis -- , Error(..)
) where ) where
import qualified Language.Elna.AST as AST
import Language.Elna.SymbolTable
( SymbolTable
, empty
--, Info(..)
-- , ParameterInfo(..)
)
nameAnalysis :: AST.Program -> SymbolTable -- Either Error SymbolTable
nameAnalysis = const empty {- runExcept
. flip runReaderT builtInSymbolTable
. runNameAnalysis
. program -}
{-
import Control.Monad.Trans.Except (Except, runExcept, throwE) import Control.Monad.Trans.Except (Except, runExcept, throwE)
import Control.Monad.Trans.Reader import Control.Monad.Trans.Reader
( ReaderT(..) ( ReaderT(..)
@ -12,14 +26,7 @@ import Control.Monad.Trans.Reader
, withReaderT , withReaderT
) )
import Data.Functor ((<&>)) import Data.Functor ((<&>))
import qualified Language.Elna.AST as AST
import Language.Elna.Location (Identifier(..)) import Language.Elna.Location (Identifier(..))
import Language.Elna.SymbolTable
( Info(..)
, ParameterInfo(..)
, SymbolTable
, builtInSymbolTable
)
import qualified Language.Elna.SymbolTable as SymbolTable import qualified Language.Elna.SymbolTable as SymbolTable
import Language.Elna.Types (Type(..)) import Language.Elna.Types (Type(..))
import Control.Monad.Trans.Class (MonadTrans(..)) import Control.Monad.Trans.Class (MonadTrans(..))
@ -53,12 +60,6 @@ instance Monad NameAnalysis
where where
(NameAnalysis x) >>= f = NameAnalysis $ x >>= (runNameAnalysis . f) (NameAnalysis x) >>= f = NameAnalysis $ x >>= (runNameAnalysis . f)
nameAnalysis :: AST.Program -> Either Error SymbolTable
nameAnalysis = runExcept
. flip runReaderT builtInSymbolTable
. runNameAnalysis
. program
program :: AST.Program -> NameAnalysis SymbolTable program :: AST.Program -> NameAnalysis SymbolTable
program (AST.Program declarations) program (AST.Program declarations)
= NameAnalysis ask = NameAnalysis ask
@ -206,3 +207,4 @@ dataType (AST.NamedType baseType) = do
_ -> NameAnalysis $ lift $ throwE $ UndefinedTypeError baseType _ -> NameAnalysis $ lift $ throwE $ UndefinedTypeError baseType
dataType (AST.ArrayType arraySize baseType) = dataType (AST.ArrayType arraySize baseType) =
dataType baseType <&> ArrayType arraySize dataType baseType <&> ArrayType arraySize
-}

View File

@ -33,6 +33,7 @@ module Language.Elna.Object.Elf
, elfHeaderSize , elfHeaderSize
, elfIdentification , elfIdentification
, elfObject , elfObject
, elfSectionsSize
, rInfo , rInfo
, stInfo , stInfo
) where ) where
@ -469,11 +470,23 @@ instance Exception ElfEncodingError
fromIntegralEnum :: (Enum a, Num b) => a -> b fromIntegralEnum :: (Enum a, Num b) => a -> b
fromIntegralEnum = fromIntegral . fromEnum fromIntegralEnum = fromIntegral . fromEnum
-- * Object file generation.
-- | ELF header size.
elfHeaderSize :: Elf32_Off elfHeaderSize :: Elf32_Off
elfHeaderSize = 52 elfHeaderSize = 52
-- | Calculates the size of all sections based on the 'sh_size' in the given
-- headers and adds 'elfHeaderSize' to it.
elfSectionsSize :: Vector Elf32_Shdr -> Elf32_Off
elfSectionsSize = (elfHeaderSize +)
. Vector.foldr ((+) . sh_size) 0
-- Writes an ELF object with the given header to the provided file path. -- Writes an ELF object with the given header to the provided file path.
-- The callback writes the sections and returns headers for those sections. -- The callback writes the sections and returns headers for those sections.
--
-- It updates some of the header header according to the given headers and
-- expects .shstrtab be the last header in the list.
elfObject :: FilePath -> Elf32_Ehdr -> (Handle -> IO (Vector Elf32_Shdr)) -> IO () elfObject :: FilePath -> Elf32_Ehdr -> (Handle -> IO (Vector Elf32_Shdr)) -> IO ()
elfObject outFile header putContents = withFile outFile WriteMode withObjectFile elfObject outFile header putContents = withFile outFile WriteMode withObjectFile
where where
@ -484,7 +497,9 @@ elfObject outFile header putContents = withFile outFile WriteMode withObjectFile
afterContents objectHandle headers = afterContents objectHandle headers =
let headerEncodingResult = elf32Ehdr let headerEncodingResult = elf32Ehdr
$ header $ header
{ e_shoff = elfHeaderSize + Vector.foldr ((+) . sh_size) 0 headers { e_shoff = elfSectionsSize headers
, e_shnum = fromIntegral $ Vector.length headers
, e_shstrndx = fromIntegral (Vector.length headers) - 1
} }
in traverse_ (ByteString.Builder.hPutBuilder objectHandle . elf32Shdr LSB) headers in traverse_ (ByteString.Builder.hPutBuilder objectHandle . elf32Shdr LSB) headers
>> either throwIO (putHeaders objectHandle) headerEncodingResult >> either throwIO (putHeaders objectHandle) headerEncodingResult

View File

@ -3,34 +3,34 @@ module Language.Elna.Parser
, programP , programP
) where ) where
import Control.Monad (void) -- import Control.Monad (void)
import Control.Monad.Combinators.Expr (Operator(..), makeExprParser) -- 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
( VariableAccess(..) ( Program(..)
{-, VariableAccess(..)
, Condition(..) , Condition(..)
, Declaration(..) , Declaration(..)
, Expression(..) , Expression(..)
, Identifier(..) , Identifier(..)
, Literal(..) , Literal(..)
, Parameter(..) , Parameter(..)
, Program(..)
, Statement(..) , Statement(..)
, TypeExpression(..) , TypeExpression(..)
, VariableDeclaration(..) , VariableDeclaration(..)-}
) )
import Text.Megaparsec import Text.Megaparsec
( Parsec ( Parsec
, MonadParsec(..) {-, MonadParsec(..)
, (<?>) , (<?>)
, optional , optional
, between , between
, sepBy , sepBy
, choice , choice -}
) )
import Text.Megaparsec.Char {- import Text.Megaparsec.Char
( alphaNumChar ( alphaNumChar
, char , char
, letterChar , letterChar
@ -41,9 +41,9 @@ 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 (($>)) import Data.Functor (($>))
-}
type Parser = Parsec Void Text type Parser = Parsec Void Text
{-
space :: Parser () space :: Parser ()
space = Lexer.space space1 (Lexer.skipLineComment "//") space = Lexer.space space1 (Lexer.skipLineComment "//")
$ Lexer.skipBlockComment "/*" "*/" $ Lexer.skipBlockComment "/*" "*/"
@ -214,6 +214,6 @@ procedureDefinitionP = procedureCons
declarationP :: Parser Declaration declarationP :: Parser Declaration
declarationP = typeDefinitionP <|> procedureDefinitionP declarationP = typeDefinitionP <|> procedureDefinitionP
-}
programP :: Parser Program programP :: Parser Program
programP = Program <$> many declarationP programP = pure Program -- <$> many declarationP

View File

@ -0,0 +1,172 @@
-- | Writer assembler to an object file.
module Language.Elna.PrinterWriter
( riscv32Elf
, riscv32Header
) where
import Data.ByteString (ByteString)
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Builder as ByteString.Builder
import qualified Data.ByteString.Lazy as LazyByteString
import Data.Vector (Vector)
import qualified Data.Vector as Vector
import Language.Elna.Object.Elf
( ByteOrder(..)
, Elf32_Ehdr(..)
, Elf32_Half
, Elf32_Sym(..)
, ElfMachine(..)
, ElfType(..)
, ElfVersion(..)
, ElfIdentification(..)
, ElfClass(..)
, ElfData(..)
, Elf32_Shdr(..)
, ElfSectionType(..)
, ElfSymbolBinding(..)
, ElfSymbolType(..)
, elf32Sym
, elfHeaderSize
, elfSectionsSize
, stInfo
)
import System.IO (Handle)
import qualified Language.Elna.Architecture.RiscV as RiscV
data ElfHeaderResult a = ElfHeaderResult ByteString (Vector a)
riscv32Elf :: Vector RiscV.Instruction -> Handle -> IO (Vector Elf32_Shdr)
riscv32Elf code objectHandle =
let zeroHeader = Elf32_Shdr
{ sh_type = SHT_NULL
, sh_size = 0
, sh_offset = 0
, sh_name = 0
, sh_link = 0
, sh_info = 0
, sh_flags = 0
, sh_entsize = 0
, sh_addralign = 0
, sh_addr = 0
}
in text (ElfHeaderResult "\0" $ Vector.singleton zeroHeader)
>>= shstrtab
>>= finalize
where
finalize (ElfHeaderResult _ headers) = pure headers
shstrtab (ElfHeaderResult names headers) = do
let stringTable = names <> ".shstrtab\0"
nextHeader = Elf32_Shdr
{ sh_type = SHT_STRTAB
, sh_size = fromIntegral $ ByteString.length stringTable
, sh_offset = elfSectionsSize headers
, sh_name = fromIntegral $ ByteString.length names
, sh_link = 0
, sh_info = 0
, sh_flags = 0
, sh_entsize = 0
, sh_addralign = 0
, sh_addr = 0
}
ByteString.hPut objectHandle stringTable
pure $ ElfHeaderResult stringTable
$ Vector.snoc headers nextHeader
strtab stringTable (ElfHeaderResult names headers) = do
let newHeader = Elf32_Shdr
{ sh_type = SHT_STRTAB
, sh_size = fromIntegral $ ByteString.length stringTable
, sh_offset = elfSectionsSize headers
, sh_name = fromIntegral $ ByteString.length names
, sh_link = 0
, sh_info = 0
, sh_flags = 0
, sh_entsize = 0
, sh_addralign = 0
, sh_addr = 0
}
ByteString.hPut objectHandle stringTable
pure $ ElfHeaderResult (names <> ".strtab\0")
$ Vector.snoc headers newHeader
symtab strtabIndex entries (ElfHeaderResult names headers) = do
let encoded = LazyByteString.toStrict
$ ByteString.Builder.toLazyByteString
$ foldMap (elf32Sym LSB) entries
newHeader = Elf32_Shdr
{ sh_type = SHT_SYMTAB
, sh_size = fromIntegral $ ByteString.length encoded
, sh_offset = elfSectionsSize headers
, sh_name = fromIntegral $ ByteString.length names
, sh_link = strtabIndex
, sh_info = 1
, sh_flags = 0
, sh_entsize = 16
, sh_addralign = 0
, sh_addr = 0
}
ByteString.hPut objectHandle encoded
pure $ ElfHeaderResult (names <> ".symtab\0")
$ Vector.snoc headers newHeader
text (ElfHeaderResult names headers) = do
let textTabIndex = fromIntegral $ Vector.length headers
strtabIndex = fromIntegral $ textTabIndex + 2
ElfHeaderResult stringTable entries <- symbolEntry textTabIndex code
$ ElfHeaderResult "\0"
$ Vector.singleton
$ Elf32_Sym
{ st_value = 0
, st_size = 0
, st_shndx = 0
, st_other = 0
, st_name = 0
, st_info = 0
}
let newHeader = Elf32_Shdr
{ sh_type = SHT_PROGBITS
, sh_size = fromIntegral $ foldr ((+) . st_size) 0 entries
, sh_offset = elfSectionsSize headers
, sh_name = fromIntegral $ ByteString.length names
, sh_link = 0
, sh_info = 0
, sh_flags = 0b110
, sh_entsize = 0
, sh_addralign = 0
, sh_addr = 0
}
newResult = ElfHeaderResult (names <> ".text\0")
$ Vector.snoc headers newHeader
symtab strtabIndex entries newResult
>>= strtab stringTable
symbolEntry :: Elf32_Half -> Vector RiscV.Instruction -> ElfHeaderResult Elf32_Sym -> IO (ElfHeaderResult Elf32_Sym)
symbolEntry shndx instructions (ElfHeaderResult names entries) = do
let encoded = LazyByteString.toStrict
$ ByteString.Builder.toLazyByteString
$ foldMap RiscV.instruction instructions
newEntry = Elf32_Sym
{ st_value = 0
, st_size = fromIntegral $ ByteString.length encoded
, st_shndx = shndx
, st_other = 0
, st_name = fromIntegral $ ByteString.length names
, st_info = stInfo STB_GLOBAL STT_FUNC
}
ByteString.hPut objectHandle encoded
pure $ ElfHeaderResult (names <> "_start\0")
$ Vector.snoc entries newEntry
riscv32Header :: Elf32_Ehdr
riscv32Header = Elf32_Ehdr
{ e_version = EV_CURRENT
, e_type = ET_REL
, e_shstrndx = 2 -- String table. SHN_UNDEF
, e_shoff = 0
, e_shnum = 0
, e_shentsize = 40
, e_phoff = 0
, e_phnum = 0
, e_phentsize = 32
, e_machine = EM_RISCV
, e_ident = ElfIdentification ELFCLASS32 ELFDATA2LSB
, e_flags = 0x4 -- EF_RISCV_FLOAT_ABI_DOUBLE
, e_entry = 0
, e_ehsize = fromIntegral elfHeaderSize
}

View File

@ -1,15 +1,22 @@
module Language.Elna.SymbolTable module Language.Elna.SymbolTable
( Info(..) ( SymbolTable
, ParameterInfo(..)
, SymbolTable
, builtInSymbolTable
, empty , empty
{-, Info(..)
, ParameterInfo(..)
, builtInSymbolTable
, enter , enter
, fromList , fromList
, lookup , lookup
, member , member -}
) where ) where
data SymbolTable = SymbolTable -- (HashMap Identifier Info)
deriving (Eq, Show)
empty :: SymbolTable
empty = SymbolTable -- HashMap.empty
{-
import Data.HashMap.Strict (HashMap) import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap import qualified Data.HashMap.Strict as HashMap
import Data.List (sort) import Data.List (sort)
@ -20,9 +27,6 @@ import Language.Elna.Location (Identifier(..))
import Language.Elna.Types (Type(..), intType, booleanType) import Language.Elna.Types (Type(..), intType, booleanType)
import Prelude hiding (lookup) import Prelude hiding (lookup)
newtype SymbolTable = SymbolTable (HashMap Identifier Info)
deriving (Eq, Show)
instance Semigroup SymbolTable instance Semigroup SymbolTable
where where
(SymbolTable lhs) <> (SymbolTable rhs) = SymbolTable $ rhs <> lhs (SymbolTable lhs) <> (SymbolTable rhs) = SymbolTable $ rhs <> lhs
@ -37,9 +41,6 @@ builtInSymbolTable = SymbolTable $ HashMap.fromList
, ("int", TypeInfo intType) , ("int", TypeInfo intType)
] ]
empty :: SymbolTable
empty = SymbolTable HashMap.empty
enter :: Identifier -> Info -> SymbolTable -> Maybe SymbolTable enter :: Identifier -> Info -> SymbolTable -> Maybe SymbolTable
enter identifier info table@(SymbolTable hashTable) enter identifier info table@(SymbolTable hashTable)
| member identifier table = Nothing | member identifier table = Nothing
@ -76,3 +77,4 @@ data Info
| VariableInfo Bool Type | VariableInfo Bool Type
| ProcedureInfo SymbolTable (Vector ParameterInfo) | ProcedureInfo SymbolTable (Vector ParameterInfo)
deriving (Eq, Show) deriving (Eq, Show)
-}

View File

@ -1,15 +1,24 @@
module Language.Elna.TypeAnalysis module Language.Elna.TypeAnalysis
( Error(..) ( typeAnalysis
, typeAnalysis , -- Error(..)
) where ) where
import qualified Language.Elna.AST as AST
import Language.Elna.SymbolTable ({-Info(..), ParameterInfo(..), -}SymbolTable)
typeAnalysis :: SymbolTable -> AST.Program -> () -- Maybe Error
typeAnalysis _globalTable = const () {- either Just (const Nothing)
. runExcept
. flip runReaderT globalTable
. runTypeAnalysis
. program -}
{-
import Control.Applicative (Alternative(..)) import Control.Applicative (Alternative(..))
import Control.Monad.Trans.Except (Except, runExcept, throwE) import Control.Monad.Trans.Except (Except, runExcept, throwE)
import Control.Monad.Trans.Reader (ReaderT, asks, runReaderT, withReaderT, ask) import Control.Monad.Trans.Reader (ReaderT, asks, runReaderT, withReaderT, ask)
import qualified Data.Vector as Vector import qualified Data.Vector as Vector
import qualified Language.Elna.AST as AST
import Language.Elna.Location (Identifier(..)) import Language.Elna.Location (Identifier(..))
import Language.Elna.SymbolTable (Info(..), ParameterInfo(..), SymbolTable)
import qualified Language.Elna.SymbolTable as SymbolTable import qualified Language.Elna.SymbolTable as SymbolTable
import Language.Elna.Types (Type(..), booleanType, intType) import Language.Elna.Types (Type(..), booleanType, intType)
import Control.Monad.Trans.Class (MonadTrans(..)) import Control.Monad.Trans.Class (MonadTrans(..))
@ -48,13 +57,6 @@ instance Monad TypeAnalysis
where where
(TypeAnalysis x) >>= f = TypeAnalysis $ x >>= (runTypeAnalysis . f) (TypeAnalysis x) >>= f = TypeAnalysis $ x >>= (runTypeAnalysis . f)
typeAnalysis :: SymbolTable -> AST.Program -> Maybe Error
typeAnalysis globalTable = either Just (const Nothing)
. runExcept
. flip runReaderT globalTable
. runTypeAnalysis
. program
program :: AST.Program -> TypeAnalysis () program :: AST.Program -> TypeAnalysis ()
program (AST.Program declarations) = traverse_ declaration declarations program (AST.Program declarations) = traverse_ declaration declarations
@ -181,3 +183,4 @@ literal (AST.IntegerLiteral _) = pure intType
literal (AST.HexadecimalLiteral _) = pure intType literal (AST.HexadecimalLiteral _) = pure intType
literal (AST.CharacterLiteral _) = pure intType literal (AST.CharacterLiteral _) = pure intType
literal (AST.BooleanLiteral _) = pure booleanType literal (AST.BooleanLiteral _) = pure booleanType
-}

View File

@ -46,7 +46,8 @@ namespace :test do
file init => [root_directory] do |task| file init => [root_directory] do |task|
cp (TMP + 'tools/init'), task.name cp (TMP + 'tools/init'), task.name
end end
test_files << init << executable_directory << expectation_directory # Directories should come first.
test_files.unshift executable_directory, expectation_directory, init
file (TMP + 'riscv/root.cpio') => test_files do |task| file (TMP + 'riscv/root.cpio') => test_files do |task|
root_files = task.prerequisites root_files = task.prerequisites

View File

@ -3,78 +3,33 @@ module Main
) where ) where
import Language.Elna.CommandLine (CommandLine(..), commandLine, execParser) import Language.Elna.CommandLine (CommandLine(..), commandLine, execParser)
import Language.Elna.Object.Elf import Language.Elna.PrinterWriter (riscv32Elf, riscv32Header)
( Elf32_Ehdr(..) import Language.Elna.Object.Elf (elfObject)
, ElfMachine(..) import Language.Elna.Parser (programP)
, ElfType(..) import Language.Elna.NameAnalysis (nameAnalysis)
, ElfVersion(..) import Language.Elna.TypeAnalysis (typeAnalysis)
, ElfIdentification(..) import Language.Elna.Intermediate (intermediate)
, ElfClass(..) import Language.Elna.CodeGenerator (generateCode)
, ElfData(..)
, Elf32_Shdr(..)
, ElfSectionType(..)
, elfHeaderSize
, elfObject
)
import qualified Data.ByteString as ByteString
import Data.Vector (Vector)
import qualified Data.Vector as Vector
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import System.IO (Handle)
import System.FilePath (replaceExtension, takeFileName) import System.FilePath (replaceExtension, takeFileName)
import Text.Megaparsec (runParser, errorBundlePretty)
riscv32Elf :: Handle -> IO (Vector Elf32_Shdr) import qualified Data.Text.IO as Text
riscv32Elf objectHandle =
let stringTable = "\0shstrtab\0"
written = Vector.fromList
[ Elf32_Shdr
{ sh_type = SHT_NULL
, sh_size = 0
, sh_offset = 0
, sh_name = 0
, sh_link = 0
, sh_info = 0
, sh_flags = 0
, sh_entsize = 0
, sh_addralign = 0
, sh_addr = 0
}
, Elf32_Shdr
{ sh_type = SHT_STRTAB
, sh_size = fromIntegral $ ByteString.length stringTable
, sh_offset = fromIntegral elfHeaderSize
, sh_name = 1
, sh_link = 0
, sh_info = 0
, sh_flags = 0
, sh_entsize = 0
, sh_addralign = 0
, sh_addr = 0
}
]
in ByteString.hPut objectHandle stringTable >> pure written
riscv32Header :: Elf32_Ehdr
riscv32Header = Elf32_Ehdr
{ e_version = EV_CURRENT
, e_type = ET_REL
, e_shstrndx = 1 -- String table. SHN_UNDEF
, e_shoff = 0
, e_shnum = 2
, e_shentsize = 40
, e_phoff = 0
, e_phnum = 0
, e_phentsize = 32
, e_machine = EM_RISCV
, e_ident = ElfIdentification ELFCLASS32 ELFDATA2LSB
, e_flags = 0x4 -- EF_RISCV_FLOAT_ABI_DOUBLE
, e_entry = 0
, e_ehsize = fromIntegral elfHeaderSize
}
main :: IO () main :: IO ()
main = execParser commandLine >>= withCommandLine main = execParser commandLine >>= withCommandLine
where where
withCommandLine CommandLine{..} = withCommandLine CommandLine{..} =
let defaultOutput = replaceExtension (takeFileName input) "o" let defaultOutput = flip fromMaybe output
in elfObject (fromMaybe defaultOutput output) riscv32Header riscv32Elf $ replaceExtension (takeFileName input) "o"
in Text.readFile input
>>= withParsedInput defaultOutput
. runParser programP input
withParsedInput output (Right program) =
let symbolTable = nameAnalysis program
_ = typeAnalysis symbolTable program
intermediate' = intermediate symbolTable program
in elfObject output riscv32Header
$ riscv32Elf
$ generateCode symbolTable intermediate'
withParsedInput _ (Left errorBundle) = putStrLn
$ errorBundlePretty errorBundle