Stub the implementation for all phases
This commit is contained in:
parent
a625bbff50
commit
1cbbef19af
@ -37,8 +37,9 @@ library elna-internal
|
||||
exposed-modules:
|
||||
Language.Elna.Architecture.RiscV
|
||||
Language.Elna.AST
|
||||
Language.Elna.CommandLine
|
||||
Language.Elna.CodeGenerator
|
||||
Language.Elna.CommandLine
|
||||
Language.Elna.PrinterWriter
|
||||
Language.Elna.Intermediate
|
||||
Language.Elna.Location
|
||||
Language.Elna.NameAnalysis
|
||||
|
@ -1,17 +1,19 @@
|
||||
module Language.Elna.AST
|
||||
( VariableAccess(..)
|
||||
( Program(..)
|
||||
{-, VariableAccess(..)
|
||||
, Condition(..)
|
||||
, Declaration(..)
|
||||
, Expression(..)
|
||||
, Identifier(..)
|
||||
, Literal(..)
|
||||
, Parameter(..)
|
||||
, Program(..)
|
||||
, Statement(..)
|
||||
, VariableDeclaration(..)
|
||||
, TypeExpression(..)
|
||||
, TypeExpression(..)-}
|
||||
) where
|
||||
|
||||
data Program = Program
|
||||
{-
|
||||
import Data.Int (Int32)
|
||||
import Data.List (intercalate)
|
||||
import Data.Word (Word16, Word32)
|
||||
@ -165,3 +167,4 @@ instance Show Program
|
||||
showParameters :: [Parameter] -> String
|
||||
showParameters parameters =
|
||||
"(" <> intercalate ", " (show <$> parameters) <> ")"
|
||||
-}
|
||||
|
@ -136,6 +136,7 @@ data Type
|
||||
| R XRegister Funct3 XRegister XRegister Funct7
|
||||
| U XRegister Word32
|
||||
| J XRegister Word32
|
||||
| Type XRegister Funct3 XRegister Funct12 -- Privileged.
|
||||
|
||||
data Instruction = Instruction BaseOpcode Type
|
||||
|
||||
@ -278,6 +279,11 @@ type' (J rd immediate)
|
||||
.|. ((immediate .&. 0x800) `shiftL` 9)
|
||||
.|. ((immediate .&. 0x7fe) `shiftL` 20)
|
||||
.|. ((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 base instructionType)
|
||||
|
@ -1,3 +1,16 @@
|
||||
module Language.Elna.CodeGenerator
|
||||
(
|
||||
( generateCode
|
||||
) 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
|
||||
]
|
||||
|
@ -1,11 +1,28 @@
|
||||
module Language.Elna.Intermediate
|
||||
( Label(..)
|
||||
( Quadruple(..)
|
||||
{- , Label(..)
|
||||
, Operand(..)
|
||||
, Quadruple(..)
|
||||
, Variable(..)
|
||||
, Variable(..) -}
|
||||
, intermediate
|
||||
) 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 Data.Bifunctor (Bifunctor(..))
|
||||
import Data.Int (Int32)
|
||||
@ -13,11 +30,7 @@ import Data.HashMap.Strict (HashMap)
|
||||
import qualified Data.HashMap.Strict as HashMap
|
||||
import Data.Text (Text)
|
||||
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.SymbolTable (SymbolTable, Info(..))
|
||||
import qualified Language.Elna.SymbolTable as SymbolTable
|
||||
import Data.Foldable (Foldable(..), foldrM)
|
||||
import GHC.Records (HasField(..))
|
||||
@ -129,13 +142,6 @@ createTemporary = do
|
||||
{ temporaryCounter = getField @"temporaryCounter" generator + 1
|
||||
}
|
||||
|
||||
intermediate :: SymbolTable -> AST.Program -> HashMap AST.Identifier (Vector Quadruple)
|
||||
intermediate globalTable
|
||||
= fst
|
||||
. flip runState mempty
|
||||
. runIntermediate
|
||||
. program globalTable
|
||||
|
||||
program
|
||||
:: SymbolTable
|
||||
-> AST.Program
|
||||
@ -326,3 +332,4 @@ literal (AST.CharacterLiteral character) = IntOperand $ fromIntegral character
|
||||
literal (AST.BooleanLiteral boolean)
|
||||
| boolean = IntOperand 1
|
||||
| otherwise = IntOperand 0
|
||||
-}
|
||||
|
@ -1,8 +1,22 @@
|
||||
module Language.Elna.NameAnalysis
|
||||
( Error(..)
|
||||
, nameAnalysis
|
||||
( nameAnalysis
|
||||
-- , Error(..)
|
||||
) 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.Reader
|
||||
( ReaderT(..)
|
||||
@ -12,14 +26,7 @@ import Control.Monad.Trans.Reader
|
||||
, withReaderT
|
||||
)
|
||||
import Data.Functor ((<&>))
|
||||
import qualified Language.Elna.AST as AST
|
||||
import Language.Elna.Location (Identifier(..))
|
||||
import Language.Elna.SymbolTable
|
||||
( Info(..)
|
||||
, ParameterInfo(..)
|
||||
, SymbolTable
|
||||
, builtInSymbolTable
|
||||
)
|
||||
import qualified Language.Elna.SymbolTable as SymbolTable
|
||||
import Language.Elna.Types (Type(..))
|
||||
import Control.Monad.Trans.Class (MonadTrans(..))
|
||||
@ -53,12 +60,6 @@ instance Monad NameAnalysis
|
||||
where
|
||||
(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 declarations)
|
||||
= NameAnalysis ask
|
||||
@ -206,3 +207,4 @@ dataType (AST.NamedType baseType) = do
|
||||
_ -> NameAnalysis $ lift $ throwE $ UndefinedTypeError baseType
|
||||
dataType (AST.ArrayType arraySize baseType) =
|
||||
dataType baseType <&> ArrayType arraySize
|
||||
-}
|
||||
|
@ -33,6 +33,7 @@ module Language.Elna.Object.Elf
|
||||
, elfHeaderSize
|
||||
, elfIdentification
|
||||
, elfObject
|
||||
, elfSectionsSize
|
||||
, rInfo
|
||||
, stInfo
|
||||
) where
|
||||
@ -469,11 +470,23 @@ instance Exception ElfEncodingError
|
||||
fromIntegralEnum :: (Enum a, Num b) => a -> b
|
||||
fromIntegralEnum = fromIntegral . fromEnum
|
||||
|
||||
-- * Object file generation.
|
||||
|
||||
-- | ELF header size.
|
||||
elfHeaderSize :: Elf32_Off
|
||||
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.
|
||||
-- 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 outFile header putContents = withFile outFile WriteMode withObjectFile
|
||||
where
|
||||
@ -484,7 +497,9 @@ elfObject outFile header putContents = withFile outFile WriteMode withObjectFile
|
||||
afterContents objectHandle headers =
|
||||
let headerEncodingResult = elf32Ehdr
|
||||
$ 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
|
||||
>> either throwIO (putHeaders objectHandle) headerEncodingResult
|
||||
|
@ -3,34 +3,34 @@ module Language.Elna.Parser
|
||||
, programP
|
||||
) where
|
||||
|
||||
import Control.Monad (void)
|
||||
import Control.Monad.Combinators.Expr (Operator(..), makeExprParser)
|
||||
-- import Control.Monad (void)
|
||||
-- import Control.Monad.Combinators.Expr (Operator(..), makeExprParser)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as Text
|
||||
-- import qualified Data.Text as Text
|
||||
import Data.Void (Void)
|
||||
import Language.Elna.AST
|
||||
( VariableAccess(..)
|
||||
( Program(..)
|
||||
{-, VariableAccess(..)
|
||||
, Condition(..)
|
||||
, Declaration(..)
|
||||
, Expression(..)
|
||||
, Identifier(..)
|
||||
, Literal(..)
|
||||
, Parameter(..)
|
||||
, Program(..)
|
||||
, Statement(..)
|
||||
, TypeExpression(..)
|
||||
, VariableDeclaration(..)
|
||||
, VariableDeclaration(..)-}
|
||||
)
|
||||
import Text.Megaparsec
|
||||
( Parsec
|
||||
, MonadParsec(..)
|
||||
{-, MonadParsec(..)
|
||||
, (<?>)
|
||||
, optional
|
||||
, between
|
||||
, sepBy
|
||||
, choice
|
||||
, choice -}
|
||||
)
|
||||
import Text.Megaparsec.Char
|
||||
{- import Text.Megaparsec.Char
|
||||
( alphaNumChar
|
||||
, char
|
||||
, letterChar
|
||||
@ -41,9 +41,9 @@ import qualified Text.Megaparsec.Char.Lexer as Lexer
|
||||
import Control.Applicative (Alternative(..))
|
||||
import Data.Maybe (isJust)
|
||||
import Data.Functor (($>))
|
||||
|
||||
-}
|
||||
type Parser = Parsec Void Text
|
||||
|
||||
{-
|
||||
space :: Parser ()
|
||||
space = Lexer.space space1 (Lexer.skipLineComment "//")
|
||||
$ Lexer.skipBlockComment "/*" "*/"
|
||||
@ -214,6 +214,6 @@ procedureDefinitionP = procedureCons
|
||||
|
||||
declarationP :: Parser Declaration
|
||||
declarationP = typeDefinitionP <|> procedureDefinitionP
|
||||
|
||||
-}
|
||||
programP :: Parser Program
|
||||
programP = Program <$> many declarationP
|
||||
programP = pure Program -- <$> many declarationP
|
||||
|
172
lib/Language/Elna/PrinterWriter.hs
Normal file
172
lib/Language/Elna/PrinterWriter.hs
Normal 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
|
||||
}
|
@ -1,15 +1,22 @@
|
||||
module Language.Elna.SymbolTable
|
||||
( Info(..)
|
||||
, ParameterInfo(..)
|
||||
, SymbolTable
|
||||
, builtInSymbolTable
|
||||
( SymbolTable
|
||||
, empty
|
||||
{-, Info(..)
|
||||
, ParameterInfo(..)
|
||||
, builtInSymbolTable
|
||||
, enter
|
||||
, fromList
|
||||
, lookup
|
||||
, member
|
||||
, member -}
|
||||
) where
|
||||
|
||||
data SymbolTable = SymbolTable -- (HashMap Identifier Info)
|
||||
deriving (Eq, Show)
|
||||
|
||||
empty :: SymbolTable
|
||||
empty = SymbolTable -- HashMap.empty
|
||||
|
||||
{-
|
||||
import Data.HashMap.Strict (HashMap)
|
||||
import qualified Data.HashMap.Strict as HashMap
|
||||
import Data.List (sort)
|
||||
@ -20,9 +27,6 @@ import Language.Elna.Location (Identifier(..))
|
||||
import Language.Elna.Types (Type(..), intType, booleanType)
|
||||
import Prelude hiding (lookup)
|
||||
|
||||
newtype SymbolTable = SymbolTable (HashMap Identifier Info)
|
||||
deriving (Eq, Show)
|
||||
|
||||
instance Semigroup SymbolTable
|
||||
where
|
||||
(SymbolTable lhs) <> (SymbolTable rhs) = SymbolTable $ rhs <> lhs
|
||||
@ -37,9 +41,6 @@ builtInSymbolTable = SymbolTable $ HashMap.fromList
|
||||
, ("int", TypeInfo intType)
|
||||
]
|
||||
|
||||
empty :: SymbolTable
|
||||
empty = SymbolTable HashMap.empty
|
||||
|
||||
enter :: Identifier -> Info -> SymbolTable -> Maybe SymbolTable
|
||||
enter identifier info table@(SymbolTable hashTable)
|
||||
| member identifier table = Nothing
|
||||
@ -76,3 +77,4 @@ data Info
|
||||
| VariableInfo Bool Type
|
||||
| ProcedureInfo SymbolTable (Vector ParameterInfo)
|
||||
deriving (Eq, Show)
|
||||
-}
|
||||
|
@ -1,15 +1,24 @@
|
||||
module Language.Elna.TypeAnalysis
|
||||
( Error(..)
|
||||
, typeAnalysis
|
||||
( typeAnalysis
|
||||
, -- Error(..)
|
||||
) 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.Monad.Trans.Except (Except, runExcept, throwE)
|
||||
import Control.Monad.Trans.Reader (ReaderT, asks, runReaderT, withReaderT, ask)
|
||||
import qualified Data.Vector as Vector
|
||||
import qualified Language.Elna.AST as AST
|
||||
import Language.Elna.Location (Identifier(..))
|
||||
import Language.Elna.SymbolTable (Info(..), ParameterInfo(..), SymbolTable)
|
||||
import qualified Language.Elna.SymbolTable as SymbolTable
|
||||
import Language.Elna.Types (Type(..), booleanType, intType)
|
||||
import Control.Monad.Trans.Class (MonadTrans(..))
|
||||
@ -48,13 +57,6 @@ instance Monad TypeAnalysis
|
||||
where
|
||||
(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 declarations) = traverse_ declaration declarations
|
||||
|
||||
@ -181,3 +183,4 @@ literal (AST.IntegerLiteral _) = pure intType
|
||||
literal (AST.HexadecimalLiteral _) = pure intType
|
||||
literal (AST.CharacterLiteral _) = pure intType
|
||||
literal (AST.BooleanLiteral _) = pure booleanType
|
||||
-}
|
||||
|
@ -46,7 +46,8 @@ namespace :test do
|
||||
file init => [root_directory] do |task|
|
||||
cp (TMP + 'tools/init'), task.name
|
||||
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|
|
||||
root_files = task.prerequisites
|
||||
|
91
src/Main.hs
91
src/Main.hs
@ -3,78 +3,33 @@ module Main
|
||||
) where
|
||||
|
||||
import Language.Elna.CommandLine (CommandLine(..), commandLine, execParser)
|
||||
import Language.Elna.Object.Elf
|
||||
( Elf32_Ehdr(..)
|
||||
, ElfMachine(..)
|
||||
, ElfType(..)
|
||||
, ElfVersion(..)
|
||||
, ElfIdentification(..)
|
||||
, ElfClass(..)
|
||||
, ElfData(..)
|
||||
, Elf32_Shdr(..)
|
||||
, ElfSectionType(..)
|
||||
, elfHeaderSize
|
||||
, elfObject
|
||||
)
|
||||
import qualified Data.ByteString as ByteString
|
||||
import Data.Vector (Vector)
|
||||
import qualified Data.Vector as Vector
|
||||
import Language.Elna.PrinterWriter (riscv32Elf, riscv32Header)
|
||||
import Language.Elna.Object.Elf (elfObject)
|
||||
import Language.Elna.Parser (programP)
|
||||
import Language.Elna.NameAnalysis (nameAnalysis)
|
||||
import Language.Elna.TypeAnalysis (typeAnalysis)
|
||||
import Language.Elna.Intermediate (intermediate)
|
||||
import Language.Elna.CodeGenerator (generateCode)
|
||||
import Data.Maybe (fromMaybe)
|
||||
import System.IO (Handle)
|
||||
import System.FilePath (replaceExtension, takeFileName)
|
||||
|
||||
riscv32Elf :: Handle -> IO (Vector Elf32_Shdr)
|
||||
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
|
||||
}
|
||||
import Text.Megaparsec (runParser, errorBundlePretty)
|
||||
import qualified Data.Text.IO as Text
|
||||
|
||||
main :: IO ()
|
||||
main = execParser commandLine >>= withCommandLine
|
||||
where
|
||||
withCommandLine CommandLine{..} =
|
||||
let defaultOutput = replaceExtension (takeFileName input) "o"
|
||||
in elfObject (fromMaybe defaultOutput output) riscv32Header riscv32Elf
|
||||
let defaultOutput = flip fromMaybe output
|
||||
$ 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
|
||||
|
Loading…
Reference in New Issue
Block a user