Merge pull request #54 from zilch-lang/develop

Stabilize includes from develop

app/Main.hs

@@ -10,65 +10,63 @@
 
 module Main (main) where
 
-import Language.NStar.Syntax (lexFile, parseFile, postProcessAST)
+import Language.NStar.Syntax (Section(IncludeS), Program(Program), parseAST)
 import Language.NStar.Typechecker (typecheck)
 import Language.NStar.CodeGen (SupportedArch(..), compileToElf)
 -- ! Experimental; remove once tested
 import Data.Elf as Elf (compile, Size(..), Endianness(..), writeFile)
 -- ! end
 import Text.Diagnose (printDiagnostic, (<~<), prettyText)
-import System.IO (stderr, stdout)
-import Data.Text (Text)
-import qualified Data.Text as Text (unpack)
-import Data.Text.Encoding (decodeUtf8)
-import System.IO (utf8, hSetEncoding, hGetContents)
+import System.IO (stderr)
 import Console.NStar.Flags
-import Control.Monad (forM_, when)
+import Control.Monad (when)
 import System.Exit (exitFailure, exitSuccess)
-import Data.ByteString (readFile, ByteString)
 import Control.Monad.IO.Class (MonadIO(..))
 import Control.Monad.Except (runExceptT, liftEither)
-import System.Directory (createDirectoryIfMissing, getCurrentDirectory)
+import System.Directory (createDirectoryIfMissing)
 import System.FilePath.Posix (joinPath)
+import Data.IORef
+import Data.Located
+import qualified Data.Text as Text
 
 main :: IO ()
 main = do
   flags <- extractFlags
   -- print flags
 
-  forM_ (files flags) (tryCompile flags)
+  tryCompile flags (files flags)
 
 ------------------------------------------------------------------------------------------------
 
-tryCompile :: Flags -> FilePath -> IO ()
-tryCompile flags file = do
-  content <- readFileUtf8 file
-
+tryCompile :: Flags -> [FilePath] -> IO ()
+tryCompile flags files = do
   let withColor = diagnostic_color (configuration flags)
       dumpAST = dump_ast (debugging flags)
       dumpTypedAST = dump_tast (debugging flags)
 
-  cwd <- getCurrentDirectory
-
   let ?lexerFlags  = LexerFlags {}
   let ?parserFlags = ParserFlags {}
   let ?tcFlags     = TypecheckerFlags {}
 
-  let fileContent = (file, lines $ Text.unpack content)
+  let ?includePath = includePath flags
+
+  allFiles <- newIORef []
+
+  let dummyPos = Position (0, 0) (0, 0) "<command-line>"
+      file = "command-line" :@ dummyPos
+      program = Program [IncludeS ((:@ dummyPos) . Text.pack <$> files) :@ dummyPos]
 
   result <- runExceptT do
-        (tks, lexWarnings)    <- liftEither $ lexFile file content
-        liftIO (printDiagnostic withColor stderr (lexWarnings <~< fileContent))
-        (ast, parseWarnings)  <- liftEither $ parseFile file tks
-        liftIO (printDiagnostic withColor stderr (parseWarnings <~< fileContent))
-        ast                   <- pure $ postProcessAST ast
+        (files, res) <- liftIO (parseAST file program)
+        liftIO $ writeIORef allFiles files
+        ast <- liftEither res
 
         when dumpAST do
           liftIO $ createDirectoryIfMissing True (joinPath [".nsc", "dump"])
           liftIO $ Prelude.writeFile (joinPath [".nsc", "dump", "ast.debug"]) (show $ prettyText ast)
 
         (tast, tcWarnings)    <- liftEither $ typecheck ast
-        liftIO (printDiagnostic withColor stderr (tcWarnings <~< fileContent))
+        liftIO (printDiagnostic withColor stderr (foldl (<~<) tcWarnings files))
 
         when dumpTypedAST do
           liftIO $ createDirectoryIfMissing True (joinPath [".nsc", "dump"])
@@ -77,23 +75,15 @@ tryCompile flags file = do
         pure tast
   case result of
     Left diag    -> do
-      printDiagnostic withColor stderr (diag <~< fileContent)
+      files <- readIORef allFiles
+
+      printDiagnostic withColor stderr (foldl (<~<) diag files)
       exitFailure
     Right p     -> do
       -- ! Experimental codegen
       --   For now, only write ELF output in a file named "test.o".
 
       let elfObject = compileToElf X64 p
-      bytes <- compile @S64 LE elfObject   -- we want little endian as a test
+      bytes <- compile @'S64 LE elfObject   -- we want little endian as a test
       Elf.writeFile (output flags) bytes
       exitSuccess
-
--- | Strictly read a file into a 'ByteString'.
-readFile :: FilePath -> IO ByteString
-readFile = Data.ByteString.readFile
-
--- | Strictly read a file into a 'Text' using a UTF-8 character
--- encoding. In the event of a character encoding error, a Unicode
--- replacement character will be used (a.k.a., @lenientDecode@).
-readFileUtf8 :: FilePath -> IO Text
-readFileUtf8 = fmap decodeUtf8 . Main.readFile

docs/compiler-options.md

@@ -6,6 +6,7 @@
 
 # CLI compiler debugging options
 
-| Option name      | Description                                                                       |
-| `dump-ast`       | Dumps the AST (after post-processing) to the file `.nsc/dump/ast.debug`           |
-| `dump-typed-ast` | Dumps the typed AST (after type-checking) to the file `.nsc/dump/typed-ast.debug` |
+| Option name      | Description                                                                         |
+|------------------|-------------------------------------------------------------------------------------|
+| `dump-ast`       | Dumps the AST (after post-processing) to the file `./.nsc/dump/ast.debug`           |
+| `dump-typed-ast` | Dumps the typed AST (after type-checking) to the file `./.nsc/dump/typed-ast.debug` |

examples/amd64-driver.nst

@@ -0,0 +1,8 @@
+### x86-amd64 code driver
+
+section code {
+  main: forall(s: Ts, e: Tc).{| forall().{ %r0: u64 | s -> e }::s -> 0 }
+      = sld 0, %r5           # move the continuation from the stack to %r5
+      ; sfree                # free the old stack cell which contained the continuation
+      ; call _main<s, e>     # and call our main function
+}

examples/true.nst

@@ -0,0 +1,9 @@
+include {
+    "amd64-driver.nst"
+}
+
+section code {
+    _main: forall(s: Ts, e: Tc).{ %r5: forall().{ %r0: u64 | s -> e } | s -> %r5 }
+         = mv 0, %r0
+         ; ret
+}

lib/elfgen/cbits/elf64/fix.c

@@ -151,24 +151,24 @@ void fix_header_count_and_offsets(elf_object const *obj, Elf64_Object *target)
 
 void fix_header_shstrtab_index(elf_object const *obj, Elf64_Object *target)
 {
-    Elf64_Half shstrtab_index = find_section_index_by_name(obj->sections, obj->sections_len, ".shstrtab");
+    int shstrtab_index = find_section_index_by_name(obj->sections, obj->sections_len, ".shstrtab");
 
     assert(shstrtab_index != -1);
 
-    target->file_header->e_shstrndx = shstrtab_index;
+    target->file_header->e_shstrndx = (Elf64_Half) shstrtab_index;
 }
 
 void fix_symtab_strtab_index(elf_object const *obj, Elf64_Object *target)
 {
-    Elf64_Word strtab_index, symtab_index;
+    int strtab_index, symtab_index;
 
     strtab_index = find_section_index_by_name(obj->sections, obj->sections_len, ".strtab");
     symtab_index = find_section_index_by_name(obj->sections, obj->sections_len, ".symtab");
 
     assert(strtab_index != -1);
     assert(symtab_index != -1);
 
-    target->section_headers[symtab_index]->sh_link = strtab_index;
+    target->section_headers[(size_t) symtab_index]->sh_link = (Elf64_Word) strtab_index;
 }
 
 void fix_section_names(elf_object const *obj, Elf64_Object *target)
@@ -260,18 +260,22 @@ void fix_section_offsets(elf_object const *obj, Elf64_Object *target)
 void fix_symtab_offset_and_shinfo(elf_object const *obj, Elf64_Object *target)
 {
     int symtab_index = find_section_index_by_name(obj->sections, obj->sections_len, ".symtab");
-    Elf64_Word number_of_symbols = obj->sections[symtab_index]->data.s_symtab.symbols_len;
-    elf_symbol **symbols = obj->sections[symtab_index]->data.s_symtab.symbols;
-    Elf64_Shdr *symtab = target->section_headers[symtab_index];
-    Elf64_Word number_of_local_symbols = 0;
 
-    while ((*symbols++)->binding == SB_LOCAL)
+    if (symtab_index != -1)
     {
-        number_of_local_symbols++;
-    }
+        Elf64_Word number_of_symbols = obj->sections[symtab_index]->data.s_symtab.symbols_len;
+        elf_symbol **symbols = obj->sections[symtab_index]->data.s_symtab.symbols;
+        Elf64_Shdr *symtab = target->section_headers[symtab_index];
+        Elf64_Word number_of_local_symbols = 0;
 
-    symtab->sh_info = number_of_local_symbols;
-    symtab->sh_offset = data_end;
+        while (number_of_local_symbols < number_of_symbols && (*symbols++)->binding == SB_LOCAL)
+        {
+            number_of_local_symbols++;
+        }
+
+        symtab->sh_info = number_of_local_symbols;
+        symtab->sh_offset = data_end;
+    }
 }
 
 void fix_symbol_names_and_sections(elf_object const *obj, Elf64_Object *target)
@@ -286,13 +290,13 @@ void fix_symbol_names_and_sections(elf_object const *obj, Elf64_Object *target)
     if (text_index == -1) text_index = STN_UNDEF;
     if (data_index == -1) data_index = STN_UNDEF;
 
-    int number_of_strings = 0;
-    for (int i = 0; i < strtab->data.s_strtab.strings_len; ++i) number_of_strings += (strtab->data.s_strtab.strings[i] == '\0');
+    size_t number_of_strings = 0;
+    for (size_t i = 0; i < strtab->data.s_strtab.strings_len; ++i) number_of_strings += (strtab->data.s_strtab.strings[i] == '\0');
     char const **strings = malloc(sizeof(char const *) * ++number_of_strings);
     assert(strings != NULL);
 
     strings[0] = strtab->data.s_strtab.strings;
-    for (int i = 1, j = 0; i < number_of_strings && j < strtab->data.s_strtab.strings_len; ++j)
+    for (size_t i = 1, j = 0; i < number_of_strings && j < strtab->data.s_strtab.strings_len; ++j)
     {
         if (strtab->data.s_strtab.strings[j] == '\0') strings[i++] = strtab->data.s_strtab.strings + j + 1;
     }
@@ -302,7 +306,7 @@ void fix_symbol_names_and_sections(elf_object const *obj, Elf64_Object *target)
         elf_symbol const *s = symtab->data.s_symtab.symbols[i];
         Elf64_Sym *sym = target->symbols[i];
         int string_index = -1;
-        for (int i = 0; i < number_of_strings && string_index == -1; ++i)
+        for (size_t i = 0; i < number_of_strings && string_index == -1; ++i)
         {
             if (strcmp(strings[i], s->name) == 0) string_index = strings[i] - strtab->data.s_strtab.strings;
         }
@@ -349,8 +353,8 @@ void fix_symbol_values(elf_object const *obj, Elf64_Object *target)
     //              => we then have a correct way of identifying which symbol appeared first in the section
     //              => which means we can implement the strategy above
 
-    int data_sym_count = 0;
-    int text_sym_count = 0;
+    size_t data_sym_count = 0;
+    size_t text_sym_count = 0;
 
     for (unsigned int i = 0; i < target->symbols_len; ++i)
     {

lib/elfgen/cbits/elf64/internal_fix.c

@@ -35,12 +35,11 @@ char const *get_section_name(elf_section_header const *section)
 int find_section_index_by_name(elf_section_header const **sections, unsigned int size, char const *name)
 {
     int index = -1;
-    int i = 0;
 
-    for (int i = 0; index == -1 && i < size; ++i)
+    for (size_t i = 0; index == -1 && i < size; ++i)
     {
         char const *section_name = get_section_name(sections[i]);
-        if (strcmp(section_name, name) == 0) index = i;
+        if (strcmp(section_name, name) == 0) index = (int) i;
     }
 
     return index;
@@ -50,9 +49,9 @@ int find_section_symbol_by_index(Elf64_Sym **symtab, unsigned int size, int sect
 {
     int index = -1;
 
-    for (int i = 0; index == -1 && i < size; ++i)
+    for (size_t i = 0; index == -1 && i < size; ++i)
     {
-        if (ELF64_ST_TYPE(symtab[i]->st_info) == STT_SECTION && symtab[i]->st_shndx == section_index) index = i;
+        if (ELF64_ST_TYPE(symtab[i]->st_info) == STT_SECTION && symtab[i]->st_shndx == section_index) index = (int) i;
     }
 
     return index;

lib/elfgen/elfgen.cabal

@@ -41,7 +41,8 @@ library
       src
       cbits
   default-extensions: LambdaCase BinaryLiterals BlockArguments TypeApplications DataKinds FlexibleInstances MultiParamTypeClasses ScopedTypeVariables TypeFamilies FlexibleContexts UndecidableInstances StandaloneDeriving AllowAmbiguousTypes
-  cpp-options: -Wall -Wextra
+  ghc-options: -Wall -Wextra -Wno-name-shadowing -Wno-unused-matches
+  cc-options: -Wall -Wextra
   include-dirs:
       cbits/include
   c-sources:
@@ -60,5 +61,6 @@ library
     , some
     , text
   if flag(debug)
-    cpp-options: -g
+    ghc-options: -g3
+    cc-options: -g3
   default-language: Haskell2010

lib/elfgen/package.yaml

@@ -13,14 +13,21 @@ library:
   - cbits/elf64/fix.c
   - cbits/elf64/internal_fix.c
   - cbits/strings.c
-  cpp-options:
+  cc-options:
   - -Wall
   - -Wextra
+  ghc-options:
+  - -Wall
+  - -Wextra
+  - -Wno-name-shadowing
+  - -Wno-unused-matches
 
   when:
   - condition: flag(debug)
-    cpp-options:
-    - -g
+    ghc-options:
+    - -g3
+    cc-options:
+    - -g3
 
 default-extensions:
 - LambdaCase

lib/elfgen/src/Data/Elf.hs

@@ -32,6 +32,5 @@ import Data.Elf.FileHeader
 import Data.Elf.SectionHeader
 import Data.Elf.ProgramHeader
 import Data.Elf.Object
-import Data.ByteString (ByteString)
 import Data.Elf.CompileToBytes
 import Data.Elf.Symbol

lib/elfgen/src/Data/Elf/CompileToBytes.hs

@@ -17,15 +17,7 @@ import Data.Elf.Object (ElfObject)
 import Data.ByteString.Lazy (ByteString, writeFile)
 import Data.Elf.Internal.Compile (unabstract, CompileFor)
 import Data.Elf.Internal.Object (Object)
-import Data.Elf.Internal.FileHeader (Elf_Ehdr)
-import Data.Elf.Internal.ProgramHeader (Elf_Phdr)
-import Data.Elf.Internal.SectionHeader (Elf_Shdr)
 import Data.Elf.Types (ReifySize)
-import Data.Elf.FileHeader (ElfHeader)
-import Data.Elf.ProgramHeader (ProgramHeader)
-import Data.Elf.SectionHeader (SectionHeader)
-import Data.Elf.Symbol (RelocationSymbol, ElfSymbol)
-import Data.Elf.Internal.Symbol (Elf_Rela, Elf_Sym)
 
 -- | Completely compiles an abstract ELF file down to a 'ByteString' ready to be written to a file.
 --

lib/elfgen/src/Data/Elf/FileHeader.chs

@@ -17,7 +17,6 @@ module Data.Elf.FileHeader
 , peekFileHeader, newFileHeader, freeFileHeader
 ) where
 
-import Data.Elf.Types
 import Data.Elf.FileHeader.Flags
 import Data.Elf.Internal.BusSize (Size)
 import Data.Word (Word8, Word32)

lib/elfgen/src/Data/Elf/FileHeader/Flags.chs

@@ -25,7 +25,7 @@ module Data.Elf.FileHeader.Flags
 #include <elf.h>
 
 import Data.Elf.Types
-import Data.Bits (Bits, (.&.))
+import Data.Bits (Bits)
 import Data.Elf.Internal.BusSize
 import GHC.Generics (Generic)