summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEugen Wissner <belka@caraus.de>2024-09-08 02:08:13 +0200
committerEugen Wissner <belka@caraus.de>2024-09-08 02:08:13 +0200
commit1cbbef19afcf997315431e3aa45f824fe8a8a0e7 (patch)
tree8813df9aab3185a9c2b778499ecb041a6c58cead
parenta625bbff505c912f8a19f62bcb92313a63c60ed4 (diff)
downloadelna-1cbbef19afcf997315431e3aa45f824fe8a8a0e7.tar.gz
Stub the implementation for all phases
-rw-r--r--elna.cabal3
-rw-r--r--lib/Language/Elna/AST.hs9
-rw-r--r--lib/Language/Elna/Architecture/RiscV.hs6
-rw-r--r--lib/Language/Elna/CodeGenerator.hs15
-rw-r--r--lib/Language/Elna/Intermediate.hs35
-rw-r--r--lib/Language/Elna/NameAnalysis.hs32
-rw-r--r--lib/Language/Elna/Object/Elf.hs17
-rw-r--r--lib/Language/Elna/Parser.hs26
-rw-r--r--lib/Language/Elna/PrinterWriter.hs172
-rw-r--r--lib/Language/Elna/SymbolTable.hs22
-rw-r--r--lib/Language/Elna/TypeAnalysis.hs25
-rw-r--r--rakelib/tester.rake3
-rw-r--r--src/Main.hs91
13 files changed, 318 insertions, 138 deletions
diff --git a/elna.cabal b/elna.cabal
index 1d87b2e..2c3fc44 100644
--- a/elna.cabal
+++ b/elna.cabal
@@ -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
diff --git a/lib/Language/Elna/AST.hs b/lib/Language/Elna/AST.hs
index ac86e63..a13798c 100644
--- a/lib/Language/Elna/AST.hs
+++ b/lib/Language/Elna/AST.hs
@@ -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) <> ")"
+-}
diff --git a/lib/Language/Elna/Architecture/RiscV.hs b/lib/Language/Elna/Architecture/RiscV.hs
index 5d8c247..f4c3887 100644
--- a/lib/Language/Elna/Architecture/RiscV.hs
+++ b/lib/Language/Elna/Architecture/RiscV.hs
@@ -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)
diff --git a/lib/Language/Elna/CodeGenerator.hs b/lib/Language/Elna/CodeGenerator.hs
index cdbfc01..6097843 100644
--- a/lib/Language/Elna/CodeGenerator.hs
+++ b/lib/Language/Elna/CodeGenerator.hs
@@ -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
+ ]
diff --git a/lib/Language/Elna/Intermediate.hs b/lib/Language/Elna/Intermediate.hs
index 4e23fd9..d334661 100644
--- a/lib/Language/Elna/Intermediate.hs
+++ b/lib/Language/Elna/Intermediate.hs
@@ -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
+-}
diff --git a/lib/Language/Elna/NameAnalysis.hs b/lib/Language/Elna/NameAnalysis.hs
index 0034628..78b3ce4 100644
--- a/lib/Language/Elna/NameAnalysis.hs
+++ b/lib/Language/Elna/NameAnalysis.hs
@@ -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
+-}
diff --git a/lib/Language/Elna/Object/Elf.hs b/lib/Language/Elna/Object/Elf.hs
index 4328f56..5dbbd78 100644
--- a/lib/Language/Elna/Object/Elf.hs
+++ b/lib/Language/Elna/Object/Elf.hs
@@ -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
diff --git a/lib/Language/Elna/Parser.hs b/lib/Language/Elna/Parser.hs
index aa7c315..4828bf5 100644
--- a/lib/Language/Elna/Parser.hs
+++ b/lib/Language/Elna/Parser.hs
@@ -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
diff --git a/lib/Language/Elna/PrinterWriter.hs b/lib/Language/Elna/PrinterWriter.hs
new file mode 100644
index 0000000..38c3549
--- /dev/null
+++ b/lib/Language/Elna/PrinterWriter.hs
@@ -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
+ }
diff --git a/lib/Language/Elna/SymbolTable.hs b/lib/Language/Elna/SymbolTable.hs
index b56d0c7..c8406fc 100644
--- a/lib/Language/Elna/SymbolTable.hs
+++ b/lib/Language/Elna/SymbolTable.hs
@@ -1,15 +1,22 @@
module Language.Elna.SymbolTable
- ( Info(..)
+ ( SymbolTable
+ , empty
+ {-, Info(..)
, ParameterInfo(..)
- , SymbolTable
, builtInSymbolTable
- , empty
, 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)
+-}
diff --git a/lib/Language/Elna/TypeAnalysis.hs b/lib/Language/Elna/TypeAnalysis.hs
index 0d939e3..ac61b62 100644
--- a/lib/Language/Elna/TypeAnalysis.hs
+++ b/lib/Language/Elna/TypeAnalysis.hs
@@ -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
+-}
diff --git a/rakelib/tester.rake b/rakelib/tester.rake
index ef05556..c348303 100644
--- a/rakelib/tester.rake
+++ b/rakelib/tester.rake
@@ -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
diff --git a/src/Main.hs b/src/Main.hs
index 4d5e406..872cad9 100644
--- a/src/Main.hs
+++ b/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