Various codegen fixes

This commit is contained in:
Samuel Hammersberg 2023-05-01 22:50:22 +02:00
parent 45578a79b1
commit 22dcbc6a13
7 changed files with 99 additions and 77 deletions

View file

@ -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;

18
sample-programs/loop.crf Normal file
View file

@ -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;

View file

@ -1,42 +1,39 @@
module Codegen.CompilerState where
import Auxiliary (snoc)
import Codegen.Auxillary (type2LlvmType, typeByteSize)
import Codegen.LlvmIr as LIR (LLVMIr (UnsafeRaw), LLVMType)
import Control.Monad.State (
StateT,
gets,
modify,
)
import Data.Map (Map)
import Data.Map qualified as Map
import Grammar.ErrM (Err)
import Monomorphizer.MonomorphizerIr as MIR
import TypeChecker.TypeCheckerIr qualified as TIR
import Auxiliary (snoc)
import Codegen.Auxillary (type2LlvmType, typeByteSize)
import Codegen.LlvmIr as LIR (LLVMIr (UnsafeRaw),
LLVMType)
import Control.Monad.State (StateT, gets, modify)
import Data.Map (Map)
import qualified Data.Map as Map
import Grammar.ErrM (Err)
import Monomorphizer.MonomorphizerIr as MIR
import qualified TypeChecker.TypeCheckerIr as TIR
-- | The record used as the code generator state
data CodeGenerator = CodeGenerator
{ instructions :: [LLVMIr]
, functions :: Map MIR.Id FunctionInfo
, customTypes :: Map LLVMType Integer
, constructors :: Map TIR.Ident ConstructorInfo
{ instructions :: [LLVMIr]
, functions :: Map MIR.Id FunctionInfo
, customTypes :: Map LLVMType Integer
, constructors :: Map TIR.Ident ConstructorInfo
, variableCount :: Integer
, labelCount :: Integer
, gcEnabled :: Bool
, labelCount :: Integer
, 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
, argumentsCI :: [Id]
, numCI :: Integer
{ numArgsCI :: Int
, argumentsCI :: [Id]
, 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"
]

View file

@ -1,25 +1,22 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Codegen.Emits where
import Codegen.Auxillary
import Codegen.CompilerState
import Codegen.LlvmIr as LIR
import Control.Applicative ((<|>))
import Control.Monad (when)
import Control.Monad.State (
gets,
modify,
)
import Data.Bifunctor qualified as BI
import Data.Char (ord)
import Data.Coerce (coerce)
import Data.Map qualified as Map
import Data.Maybe (fromJust, fromMaybe)
import Data.Tuple.Extra (dupe, first, second)
import Monomorphizer.MonomorphizerIr as MIR
import TypeChecker.TypeCheckerIr qualified as TIR
import Codegen.Auxillary
import Codegen.CompilerState
import Codegen.LlvmIr as LIR
import Control.Applicative ((<|>))
import Control.Monad (when)
import Control.Monad.State (gets, modify)
import qualified Data.Bifunctor as BI
import Data.Char (ord)
import Data.Coerce (coerce)
import qualified Data.Map as Map
import Data.Maybe (fromJust, fromMaybe)
import Data.Tuple.Extra (dupe, first, second)
import Monomorphizer.MonomorphizerIr as MIR
import qualified TypeChecker.TypeCheckerIr 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.EAdd e1 e2, t) = emitAdd t e1 e2
compileExp (MIR.EVar name, _t) = emitIdent name
compileExp (MIR.EApp e1 e2, t) = emitApp t e1 e2
compileExp (MIR.ELit lit, _t) = emitLit lit
compileExp (MIR.EAdd e1 e2, t) = emitAdd t e1 e2
compileExp (MIR.EVar name, _t) = emitIdent name
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

View file

@ -1,9 +1,6 @@
module Compiler (compile) where
import System.Process.Extra (
readCreateProcess,
shell,
)
import System.Process.Extra (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"

View file

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

View file

@ -7,8 +7,8 @@
#include "chunk.hpp"
#include "profiler.hpp"
#define HEAP_SIZE 65536
#define FREE_THRESH (uint) 100
#define HEAP_SIZE 240240240
#define FREE_THRESH (uint)100
#define HEAP_DEBUG
namespace GC
@ -16,14 +16,15 @@ namespace GC
/**
* Flags for the collect overlead for conditional
* collection (mark/sweep/free/all).
*/
enum CollectOption {
MARK = 1 << 0,
SWEEP = 1 << 1,
MARK_SWEEP = 1 << 2,
FREE = 1 << 3,
COLLECT_ALL = 0b1111 // all flags above
};
*/
enum CollectOption
{
MARK = 1 << 0,
SWEEP = 1 << 1,
MARK_SWEEP = 1 << 2,
FREE = 1 << 3,
COLLECT_ALL = 0b1111 // all flags above
};
/**
* The heap class to represent the heap for the
@ -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};
char *m_heap_top {nullptr};
size_t m_size{0};
char *m_heap_top{nullptr};
// static Heap *m_instance {nullptr};
uintptr_t *m_stack_top {nullptr};
bool m_profiler_enable {false};
uintptr_t *m_stack_top{nullptr};
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& operator=(Heap const&) = delete;
Heap(Heap const &) = delete;
Heap &operator=(Heap const &) = delete;
#ifdef HEAP_DEBUG
void collect(CollectOption flags); // conditional collection
void check_init(); // print dummy things
void print_contents(); // print dummy things
void collect(CollectOption flags); // conditional collection
void check_init(); // 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