Merge pull request #52 from zilch-lang/develop

Stabilize second version of N*

app/Main.hs

@@ -11,8 +11,7 @@
 module Main (main) where
 
 import Language.NStar.Syntax (lexFile, parseFile, postProcessAST)
-import Language.NStar.Typechecker (typecheck, postProcessTypedAST)
-import Language.NStar.Branchchecker (branchcheck)
+import Language.NStar.Typechecker (typecheck)
 import Language.NStar.CodeGen (SupportedArch(..), compileToElf)
 -- ! Experimental; remove once tested
 import Data.Elf as Elf (compile, Size(..), Endianness(..), writeFile)
@@ -70,14 +69,11 @@ tryCompile flags file = do
 
         (tast, tcWarnings)    <- liftEither $ typecheck ast
         liftIO (printDiagnostic withColor stderr (tcWarnings <~< fileContent))
-        tast                  <- pure $ postProcessTypedAST tast
 
         when dumpTypedAST do
           liftIO $ createDirectoryIfMissing True (joinPath [".nsc", "dump"])
           liftIO $ Prelude.writeFile (joinPath [".nsc", "dump", "typed-ast.debug"]) (show $ prettyText tast)
 
-        bcWarnings            <- liftEither $ branchcheck tast
-        liftIO (printDiagnostic withColor stderr (bcWarnings <~< fileContent))
         pure tast
   case result of
     Left diag    -> do

examples/fact.nst

@@ -1,15 +1,29 @@
-fact: forall (s: Ts). { %rsp: sptr *{ %rax: u64, %rsp: sptr s }::s, %rdi: u64 }
-    jz %rdi, fact_if_0<s>   # Jump to "fact_if_0" if %rdi is 0
+section code {
+  fact: forall(s: Ts, e: Tc).{ %r5: forall().{ %r0: u64 | s -> e }, %r1: u64 | s -> %r5 }
+      = jz %r1, fact_0<s, e>, fact_N<s, e>
+      # Jump to fact_0 if %r1 == 0 else jump to fact_N
 
-    mov %rbx, %rdi
-    dec %rdi                # We decrement the argument in the recursive call
-    call fact<s>
-    mul %rax, %rbx          # And we perform the multiplication
-    jmp fact_end<s>
+  fact_0: forall(s: Ts, e: Tc).{ %r5: forall().{ %r0: u64 | s -> e }, %r1: u64 | s -> %r5 }
+        = mv 1, %r0 ;
+        # The neutral element of the product: 1
+          ret
 
-  fact_if_0: forall (s: Ts). { %rsp: sptr *{ %rax: u64, %rsp: sptr s }::s }
-    mov %rax, 1
-    jmp fact_end<s>
-
-  fact_end: forall (s: Ts). { %rax: u64, %rsp: sptr *{ %rax: u64, %rsp: sptr s }::s }
-    ret
+  fact_N: forall(s: Ts, e: Tc).{ %r5: forall().{ %r0: u64 | s -> e }, %r1: u64 | s -> %r5 }
+        = mv %r1, %r2                           ;
+        # Copy parameter `n` in %r1 into %r2
+          dec %r1                               ;
+        # Decrease `n` by 1
+          salloc forall().{ %r0: u64 | s -> e } ;
+          sst %r5, 0                            ;
+        # Put the current continuation on top of the stack
+          mv fact_ret<s, e>, %r5                ;
+          call fact<forall().{ %r0: u64 | s -> e }::s, 0>
+        # Call the factorial with parameter `n - 1`, result will be in %r0
+  fact_ret: forall(s: Ts, e: Tc).{ %r2: u64, %r0: u64 | forall().{ %r0: u64 | s -> e }::s -> 0 }
+          = mul %r2, %r0 ;
+          # Multiply the old `n` with the result of the recursive call (in %r0), and store result in %r0
+            sld 0, %r5   ;
+            sfree        ;
+          # Load the old continuation into a register, and free the top of the stack
+            ret
+}

lib/elfgen/cbits/elf64/fix.c

@@ -261,9 +261,16 @@ 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;
 
-    symtab->sh_info = number_of_symbols;
+    while ((*symbols++)->binding == SB_LOCAL)
+    {
+        number_of_local_symbols++;
+    }
+
+    symtab->sh_info = number_of_local_symbols;
     symtab->sh_offset = data_end;
 }
 
@@ -279,12 +286,26 @@ 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');
+    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)
+    {
+        if (strtab->data.s_strtab.strings[j] == '\0') strings[i++] = strtab->data.s_strtab.strings + j + 1;
+    }
+
     for (unsigned int i = 0; i < target->symbols_len; ++i)
     {
         elf_symbol const *s = symtab->data.s_symtab.symbols[i];
         Elf64_Sym *sym = target->symbols[i];
-        int string_index = mempos(strtab->data.s_strtab.strings, strtab->data.s_strtab.strings_len,
-                                  s->name, strlen(s->name));
+        int string_index = -1;
+        for (int 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;
+        }
 
         sym->st_name = string_index != -1 ? string_index : 0x0;
 
@@ -307,6 +328,8 @@ void fix_symbol_names_and_sections(elf_object const *obj, Elf64_Object *target)
                 sym->st_shndx = STN_UNDEF;
         }
     }
+
+    free(strings);
 }
 
 void fix_symbol_values(elf_object const *obj, Elf64_Object *target)
@@ -383,7 +406,7 @@ void fix_symbol_values(elf_object const *obj, Elf64_Object *target)
             Elf64_Sym *current_symbol = target->symbols[current_symbol_index];
 
             current_symbol->st_size = current_symbol_size;
-            current_symbol->st_value = current_offset_in_section;
+            current_symbol->st_value = current_symbol_offset;
 
             current_offset_in_section += current_symbol_size;
         }
@@ -395,7 +418,7 @@ void fix_symbol_values(elf_object const *obj, Elf64_Object *target)
             Elf64_Sym *current_symbol = target->symbols[current_symbol_index];
 
             current_symbol->st_size = current_symbol_size;
-            current_symbol->st_value = current_offset_in_section;
+            current_symbol->st_value = current_symbol_offset;
         }
     }
 
@@ -414,7 +437,7 @@ void fix_symbol_values(elf_object const *obj, Elf64_Object *target)
             Elf64_Sym *current_symbol = target->symbols[current_symbol_index];
 
             current_symbol->st_size = current_symbol_size;
-            current_symbol->st_value = current_offset_in_section;
+            current_symbol->st_value = current_symbol_offset;
 
             current_offset_in_section += current_symbol_size;
         }
@@ -426,7 +449,7 @@ void fix_symbol_values(elf_object const *obj, Elf64_Object *target)
             Elf64_Sym *current_symbol = target->symbols[current_symbol_index];
 
             current_symbol->st_size = current_symbol_size;
-            current_symbol->st_value = current_offset_in_section;
+            current_symbol->st_value = current_symbol_offset;
         }
     }
 

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

@@ -1,4 +1,5 @@
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DeriveGeneric #-}
 
 {-# OPTIONS -Wno-duplicate-exports #-}
 
@@ -24,6 +25,7 @@ import Foreign.Storable (Storable(..))
 import Foreign.Ptr (Ptr)
 import Foreign.C.Types (CInt)
 import Foreign.Marshal.Alloc (malloc, free)
+import GHC.Generics (Generic)
 
 #include "file_header.h"
 
@@ -37,19 +39,20 @@ data ElfHeader (n :: Size)
       !Arch          -- ^ Architecture
       !Version       -- ^ Object file version (@'ev_current'@ or @'ev_none'@)
       !(EFlags n)    -- ^ Processor-specific flags
+  deriving (Generic)
 
 -- | ELF class
-{#enum elf_class as Class {C_NONE as C_None, C_32 as C_32, C_64 as C_64}#}
+{#enum elf_class as Class {C_NONE as C_None, C_32 as C_32, C_64 as C_64} deriving (Generic)#}
 -- | Data encoding
-{#enum elf_encoding as Encoding {D_NONE as D_None, D_2LSB as D_2LSB, D_2MSB as D_2MSB}#}
+{#enum elf_encoding as Encoding {D_NONE as D_None, D_2LSB as D_2LSB, D_2MSB as D_2MSB} deriving (Generic)#}
 -- | OS ABI identification
-{#enum elf_osabi as OSABI {OSABI_NONE as OSABI_None, OSABI_SYSV as OSABI_SysV}#}
+{#enum elf_osabi as OSABI {OSABI_NONE as OSABI_None, OSABI_SYSV as OSABI_SysV} deriving (Generic)#}
 -- | Legal values for @'e_type'@
-{#enum elf_file_type as ObjFileType {OFT_NONE as ET_None, OFT_REL as ET_Rel, OFT_EXEC as ET_Exec, OFT_DYN as ET_Dyn, OFT_CORE as ET_Core}#}
+{#enum elf_file_type as ObjFileType {OFT_NONE as ET_None, OFT_REL as ET_Rel, OFT_EXEC as ET_Exec, OFT_DYN as ET_Dyn, OFT_CORE as ET_Core} deriving (Generic)#}
 -- | Legal values for @'e_machine'@
-{#enum elf_arch as Arch {MA_NONE as EM_None, MA_SPARC as EM_sparc, MA_X86_64 as EM_x86_64, MA_ARM as EM_arm}#}
+{#enum elf_arch as Arch {MA_NONE as EM_None, MA_SPARC as EM_sparc, MA_X86_64 as EM_x86_64, MA_ARM as EM_arm} deriving (Generic)#}
 -- | File version
-{#enum elf_version as Version {VER_NONE as EV_None, VER_CURRENT as EV_Current}#}
+{#enum elf_version as Version {VER_NONE as EV_None, VER_CURRENT as EV_Current} deriving (Generic)#}
 
 ---------------------------------------------------------------------------------------------------------------
 

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

@@ -1,4 +1,5 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DeriveGeneric #-}
 
 module Data.Elf.FileHeader.Flags
 ( EFlags
@@ -26,10 +27,12 @@ module Data.Elf.FileHeader.Flags
 import Data.Elf.Types
 import Data.Bits (Bits, (.&.))
 import Data.Elf.Internal.BusSize
+import GHC.Generics (Generic)
 
 type EFlags = Flag
 -- | Processor specific flags
 newtype Flag (n :: Size) = Flag (Elf_Word n)
+  deriving (Generic)
 --  deriving (Show, Eq, Ord, Num, Bits, Integral, Real, Enum)
 deriving instance Show (Flag n)
 deriving instance Eq (Flag n)

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

@@ -1,18 +1,21 @@
 {-# LANGUAGE BangPatterns #-}
 {-# LANGUAGE RecordWildCards #-}
+{-# LANGUAGE DeriveGeneric #-}
 
 module Data.Elf.Object where
 
 import Data.Elf.Types
 import Data.Elf.FileHeader (ElfHeader, C_ElfFileHeader, peekFileHeader, newFileHeader, freeFileHeader)
-import Data.Elf.SectionHeader (SectionHeader, C_ElfSectionHeader, peekSectionHeader, newSectionHeader, freeSectionHeader)
+import Data.Elf.SectionHeader (SectionHeader(SSymTab), C_ElfSectionHeader, peekSectionHeader, newSectionHeader, freeSectionHeader)
 import Data.Elf.ProgramHeader (ProgramHeader, C_ElfProgramHeader, peekProgramHeader, newProgramHeader, freeProgramHeader)
 import Data.Elf.Internal.BusSize (Size)
 import Foreign.Ptr (Ptr, castPtr)
 import Foreign.C.Types (CULong)
 import Foreign.Storable (Storable(..))
 import Foreign.Marshal.Array (peekArray, newArray)
 import Foreign.Marshal.Alloc (malloc, free)
+import GHC.Generics (Generic)
+import Data.List (sort)
 
 #include "object.h"
 
@@ -23,6 +26,7 @@ data ElfObject n
   , segments      :: [ProgramHeader n]     -- ^ Program headers
   , sections      :: [SectionHeader n]     -- ^ Section headers
   }
+  deriving (Generic)
 
 data C_ElfObject (n :: Size)
   = C_ElfObject
@@ -65,11 +69,16 @@ newObject ElfObject{..} = do
 
   fh <- newFileHeader fileHeader
   phs <- newArray =<< traverse newProgramHeader segments
-  shs <- newArray =<< traverse newSectionHeader sections
+  shs <- newArray =<< traverse newSectionHeader (sortIfNeeded <$> sections)
 
   poke ptr $ C_ElfObject fh phs shs segmentsLen sectionsLen
 
   pure ptr
+  where
+    -- | We need this function because symbols in the symbol table must be sort
+    --   according to their binding (LOCAL < GLOBAL < WEAK).
+    sortIfNeeded (SSymTab n syms) = SSymTab n (sort syms)
+    sortIfNeeded s                = s
 
 freeObject :: Ptr (C_ElfObject n) -> IO ()
 freeObject ptr = do

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

@@ -1,4 +1,5 @@
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DeriveGeneric #-}
 
 module Data.Elf.ProgramHeader
 ( ProgramHeader(..)
@@ -19,6 +20,7 @@ import Foreign.C.Types (CChar)
 import Foreign.C.String (CString, peekCString, newCString)
 import Foreign.Marshal.Array (peekArray, newArray)
 import Foreign.Marshal.Alloc (malloc, free)
+import GHC.Generics (Generic)
 
 #include "segment_header.h"
 
@@ -36,6 +38,7 @@ data ProgramHeader (n :: Size)
   | PInterp
       String     -- ^ Path to the dynamic interpreter
       (PFlags n)
+  deriving (Generic)
 deriving instance Eq (ProgramHeader n)
 deriving instance Ord (ProgramHeader n)
 

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

@@ -1,4 +1,5 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE DeriveGeneric #-}
 
 module Data.Elf.ProgramHeader.Flags
 ( PFlags
@@ -12,10 +13,12 @@ module Data.Elf.ProgramHeader.Flags
 import Data.Bits (Bits, shiftL)
 import Data.Elf.Types
 import Data.Elf.Internal.BusSize
+import GHC.Generics (Generic)
 
 type PFlags = Flag
 
 newtype Flag (n :: Size) = Flag (Elf_Word n)
+  deriving (Generic)
 --  deriving (Show, Eq, Ord, Bits, Num, Integral, Real, Enum)
 deriving instance Show (Flag n)
 deriving instance Eq (Flag n)

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

@@ -1,4 +1,5 @@
 {-# LANGUAGE BangPatterns #-}
+{-# LANGUAGE DeriveGeneric #-}
 
 module Data.Elf.SectionHeader
 ( SectionHeader(..)
@@ -21,6 +22,7 @@ import Foreign.Ptr (Ptr, castPtr)
 import Data.List (intercalate)
 import Foreign.Marshal.Alloc (malloc, free)
 import Debug.Trace
+import GHC.Generics (Generic)
 
 #include "section_header.h"
 
@@ -50,7 +52,7 @@ data SectionHeader (n :: Size)
   | SStrTab
       String
       [String]
-
+  deriving (Generic)
 deriving instance Eq (SectionHeader n)
 deriving instance Ord (SectionHeader n)
 

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

@@ -1,5 +1,6 @@
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE DeriveGeneric #-}
 
 module Data.Elf.SectionHeader.Flags
 ( SFlags
@@ -12,12 +13,14 @@ module Data.Elf.SectionHeader.Flags
 import Data.Bits (Bits, shiftL)
 import Data.Elf.Types (Elf_Xword)
 import Data.Elf.Internal.BusSize
+import GHC.Generics (Generic)
 
 #include <elf.h>
 
 type SFlags = Flag
 -- | Section flags
 newtype Flag (n :: Size) = Flag (Elf_Xword n)
+  deriving (Generic)
 --  deriving (Show, Eq, Ord, Num, Bits, Integral, Real, Enum)
 deriving instance Show (Flag n)
 deriving instance Eq (Flag n)