Rakarake/churf
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Various codegen fixes

Browse source
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
Download patch file Download diff file Expand all files Collapse all files

46
src/Codegen/CompilerState.hs
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"
]

50
src/Codegen/Emits.hs
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