Various codegen fixes

sample-programs/insertion-sort.chrf

@@ -16,8 +16,15 @@ insertionSort xs = case xs of
         Nil => xs
     Nil => Nil
 
-main = head (insertionSort (Cons 5 (Cons 4 (Cons 3 (Cons 2 (Cons 1 Nil))))))
+main = head (insertionSort (revRange 1250))
 
 head xs = case xs of
     Cons x _ => x
 
+revRange x = case x of 
+    0 => Cons x Nil
+    x => Cons x (revRange (x + minusOne))
+
+-- represents minus one :)
+minusOne : Int ;
+minusOne = 9223372036854775807 + 9223372036854775807 + 1;

sample-programs/loop.crf

@@ -0,0 +1,18 @@
+main = for 0 1000
+
+for x n = case n of 
+    0 => 0
+    n => for (revRange 1000) (n + minusOne)
+
+data List (a) where
+    Nil : List (a)
+    Cons : a -> List (a) -> List (a)
+
+-- create a list of x to 0
+revRange x = case x of 
+    0 => Cons x Nil
+    x => Cons x (revRange (x + minusOne))
+
+-- represents minus one :)
+minusOne : Int ;
+minusOne = 9223372036854775807 + 9223372036854775807 + 1;

src/Codegen/CompilerState.hs

@@ -1,42 +1,39 @@
 module Codegen.CompilerState where
 
-import Auxiliary (snoc)
+import           Auxiliary                     (snoc)
-import Codegen.Auxillary (type2LlvmType, typeByteSize)
+import           Codegen.Auxillary             (type2LlvmType, typeByteSize)
-import Codegen.LlvmIr as LIR (LLVMIr (UnsafeRaw), LLVMType)
+import           Codegen.LlvmIr                as LIR (LLVMIr (UnsafeRaw),
-import Control.Monad.State (
+                                                       LLVMType)
-    StateT,
+import           Control.Monad.State           (StateT, gets, modify)
-    gets,
+import           Data.Map                      (Map)
-    modify,
+import qualified Data.Map                      as Map
- )
+import           Grammar.ErrM                  (Err)
-import Data.Map (Map)
+import           Monomorphizer.MonomorphizerIr as MIR
-import Data.Map qualified as Map
+import qualified TypeChecker.TypeCheckerIr     as TIR
-import Grammar.ErrM (Err)
-import Monomorphizer.MonomorphizerIr as MIR
-import TypeChecker.TypeCheckerIr qualified as TIR
 
 -- | The record used as the code generator state
 data CodeGenerator = CodeGenerator
-    { instructions :: [LLVMIr]
+    { instructions  :: [LLVMIr]
-    , functions :: Map MIR.Id FunctionInfo
+    , functions     :: Map MIR.Id FunctionInfo
-    , customTypes :: Map LLVMType Integer
+    , customTypes   :: Map LLVMType Integer
-    , constructors :: Map TIR.Ident ConstructorInfo
+    , constructors  :: Map TIR.Ident ConstructorInfo
     , variableCount :: Integer
-    , labelCount :: Integer
+    , labelCount    :: Integer
-    , gcEnabled :: Bool
+    , gcEnabled     :: Bool
     }
 
 -- | A state type synonym
 type CompilerState a = StateT CodeGenerator Err a
 
 data FunctionInfo = FunctionInfo
-    { numArgs :: Int
+    { numArgs   :: Int
     , arguments :: [Id]
     }
     deriving (Show)
 data ConstructorInfo = ConstructorInfo
-    { numArgsCI :: Int
+    { numArgsCI    :: Int
-    , argumentsCI :: [Id]
+    , argumentsCI  :: [Id]
-    , numCI :: Integer
+    , numCI        :: Integer
     , returnTypeCI :: MIR.Type
     }
     deriving (Show)
@@ -146,4 +143,5 @@ gcStart =
     , UnsafeRaw "declare external void @cheap_dispose()\n"
     , UnsafeRaw "declare external ptr @cheap_the()\n"
     , UnsafeRaw "declare external void @cheap_set_profiler(ptr, i1)\n"
+    , UnsafeRaw "declare external void @cheap_profiler_log_options(ptr, i64)\n"
     ]

src/Codegen/Emits.hs

@@ -1,25 +1,22 @@
-{-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE LambdaCase        #-}
 {-# LANGUAGE OverloadedStrings #-}
 
 module Codegen.Emits where
 
-import Codegen.Auxillary
+import           Codegen.Auxillary
-import Codegen.CompilerState
+import           Codegen.CompilerState
-import Codegen.LlvmIr as LIR
+import           Codegen.LlvmIr                as LIR
-import Control.Applicative ((<|>))
+import           Control.Applicative           ((<|>))
-import Control.Monad (when)
+import           Control.Monad                 (when)
-import Control.Monad.State (
+import           Control.Monad.State           (gets, modify)
-    gets,
+import qualified Data.Bifunctor                as BI
-    modify,
+import           Data.Char                     (ord)
- )
+import           Data.Coerce                   (coerce)
-import Data.Bifunctor qualified as BI
+import qualified Data.Map                      as Map
-import Data.Char (ord)
+import           Data.Maybe                    (fromJust, fromMaybe)
-import Data.Coerce (coerce)
+import           Data.Tuple.Extra              (dupe, first, second)
-import Data.Map qualified as Map
+import           Monomorphizer.MonomorphizerIr as MIR
-import Data.Maybe (fromJust, fromMaybe)
+import qualified TypeChecker.TypeCheckerIr     as TIR
-import Data.Tuple.Extra (dupe, first, second)
-import Monomorphizer.MonomorphizerIr as MIR
-import TypeChecker.TypeCheckerIr qualified as TIR
 
 compileScs :: [MIR.Def] -> CompilerState ()
 compileScs [] = do
@@ -132,6 +129,7 @@ firstMainContent :: Bool -> [LLVMIr]
 firstMainContent True =
     [ UnsafeRaw "%prof = call ptr @cheap_the()\n"
     , UnsafeRaw "call void @cheap_set_profiler(ptr %prof, i1 true)\n"
+    , UnsafeRaw "call void @cheap_profiler_log_options(ptr %prof, i64 30)\n"
     , UnsafeRaw "call void @cheap_init()\n"
     ]
 firstMainContent False = []
@@ -150,12 +148,12 @@ lastMainContent False var =
     ]
 
 compileExp :: ExpT -> CompilerState ()
-compileExp (MIR.ELit lit, _t) = emitLit lit
+compileExp (MIR.ELit lit, _t)   = emitLit lit
-compileExp (MIR.EAdd e1 e2, t) = emitAdd t e1 e2
+compileExp (MIR.EAdd e1 e2, t)  = emitAdd t e1 e2
-compileExp (MIR.EVar name, _t) = emitIdent name
+compileExp (MIR.EVar name, _t)  = emitIdent name
-compileExp (MIR.EApp e1 e2, t) = emitApp t e1 e2
+compileExp (MIR.EApp e1 e2, t)  = emitApp t e1 e2
 compileExp (MIR.ELet bind e, _) = emitLet bind e
-compileExp (MIR.ECase e cs, t) = emitECased t e (map (t,) cs)
+compileExp (MIR.ECase e cs, t)  = emitECased t e (map (t,) cs)
 
 emitLet :: MIR.Bind -> ExpT -> CompilerState ()
 emitLet (MIR.Bind id [] innerExp) e = do
@@ -241,7 +239,7 @@ emitECased t e cases = do
     emitCases _rt ty label stackPtr vs (Branch (MIR.PLit (i, ct), t) exp) = do
         emit $ Comment "Plit"
         let i' = case i of
-                MIR.LInt i -> VInteger i
+                MIR.LInt i  -> VInteger i
                 MIR.LChar i -> VChar (ord i)
         ns <- getNewVar
         lbl_failPos <- (\x -> TIR.Ident $ "failed_" <> show x) <$> getNewLabel
@@ -341,7 +339,7 @@ emitLit :: MIR.Lit -> CompilerState ()
 emitLit i = do
     -- !!this should never happen!!
     let (i', t) = case i of
-            (MIR.LInt i'') -> (VInteger i'', I64)
+            (MIR.LInt i'')  -> (VInteger i'', I64)
             (MIR.LChar i'') -> (VChar $ ord i'', I8)
     varCount <- getNewVar
     emit $ Comment "This should not have happened!"
@@ -357,7 +355,7 @@ emitAdd t e1 e2 = do
 exprToValue :: ExpT -> CompilerState LLVMValue
 exprToValue = \case
     (MIR.ELit i, _t) -> pure $ case i of
-        (MIR.LInt i) -> VInteger i
+        (MIR.LInt i)  -> VInteger i
         (MIR.LChar i) -> VChar $ ord i
     (MIR.EVar (TIR.Ident "True"), _t) -> pure $ VInteger 1
     (MIR.EVar (TIR.Ident "False"), _t) -> pure $ VInteger 0

src/Compiler.hs

@@ -1,9 +1,6 @@
 module Compiler (compile) where
 
-import System.Process.Extra (
+import           System.Process.Extra (readCreateProcess, shell)
-    readCreateProcess,
-    shell,
- )
 
 -- spawnWait s = spawnCommand s >>= \s >>= waitForProcess
 
@@ -31,7 +28,9 @@ compileClang True =
             , "src/GC/lib/event.cpp"
             , "src/GC/lib/heap.cpp"
             , "src/GC/lib/profiler.cpp"
-            , "-Wall -Wextra -g -std=gnu++20 -stdlib=libstdc++ -O3"
+            , "-Wall -Wextra -g -std=gnu++20 -stdlib=libstdc++"
+            , "-O3"
+            --, "-tailcallopt"
             , "-Isrc/GC/include"
             , "-x"
             , "ir" -- , "-Lsrc/GC/lib -l:gcoll.a"

src/GC/include/cheap.h

@@ -7,7 +7,7 @@
 extern "C" {
 #endif
 
-#define WRAPPER_DEBUG
+//#define WRAPPER_DEBUG
 
 #ifdef WRAPPER_DEBUG
 typedef struct cheap

src/GC/include/heap.hpp

@@ -7,8 +7,8 @@
 #include "chunk.hpp"
 #include "profiler.hpp"
 
-#define HEAP_SIZE 65536
+#define HEAP_SIZE 240240240
-#define FREE_THRESH (uint) 100
+#define FREE_THRESH (uint)100
 #define HEAP_DEBUG
 
 namespace GC
@@ -16,13 +16,14 @@ namespace GC
 	/**
 	 * Flags for the collect overlead for conditional
 	 * collection (mark/sweep/free/all).
-	*/
+	 */
-	enum CollectOption {
+	enum CollectOption
-		MARK		= 1 << 0,
+	{
-		SWEEP		= 1 << 1,
+		MARK = 1 << 0,
-		MARK_SWEEP 	= 1 << 2,
+		SWEEP = 1 << 1,
-		FREE		= 1 << 3,
+		MARK_SWEEP = 1 << 2,
-		COLLECT_ALL	= 0b1111 // all flags above
+		FREE = 1 << 3,
+		COLLECT_ALL = 0b1111 // all flags above
 	};
 
 	/**
@@ -32,7 +33,7 @@ namespace GC
 	 * inside the heap class. The heap is represented
 	 * by a char array of size 65536 and can enable
 	 * a profiler to track the actions on the heap.
-	*/
+	 */
 	class Heap
 	{
 	private:
@@ -44,11 +45,11 @@ namespace GC
 		}
 
 		char *const m_heap;
-		size_t m_size {0};
+		size_t m_size{0};
-		char *m_heap_top {nullptr};
+		char *m_heap_top{nullptr};
 		// static Heap *m_instance {nullptr};
-		uintptr_t *m_stack_top {nullptr};
+		uintptr_t *m_stack_top{nullptr};
-		bool m_profiler_enable {false};
+		bool m_profiler_enable{false};
 
 		std::vector<Chunk *> m_allocated_chunks;
 		std::vector<Chunk *> m_freed_chunks;
@@ -69,6 +70,7 @@ namespace GC
 		// Temporary
 		Chunk *try_recycle_chunks_new(size_t size);
 		void free_overlap_new(Heap &heap);
+
 	public:
 		/**
 		 * These are the only five functions which are exposed
@@ -86,13 +88,13 @@ namespace GC
 		void set_profiler_log_options(RecordOption flags);
 
 		// Stop the compiler from generating copy-methods
-		Heap(Heap const&) = delete;
+		Heap(Heap const &) = delete;
-		Heap& operator=(Heap const&) = delete;
+		Heap &operator=(Heap const &) = delete;
 
 #ifdef HEAP_DEBUG
-		void collect(CollectOption flags); // conditional collection
+		void collect(CollectOption flags);		 // conditional collection
-		void check_init();		  // print dummy things
+		void check_init();						 // print dummy things
-		void print_contents();	  // print dummy things
+		void print_contents();					 // print dummy things
 		void print_allocated_chunks(Heap *heap); // print the contents in m_allocated_chunks
 		void print_summary();
 #endif