Added some toplevel comments.

This commit is contained in:
Samuel Hammersberg 2023-05-20 19:03:06 +02:00
parent bb40cbba2a
commit 1dc1b8f92e
3 changed files with 31 additions and 2 deletions

View file

@ -5,6 +5,7 @@ import Control.Monad (foldM_)
import Monomorphizer.MonomorphizerIr as MIR (Exp, T, Type (..)) import Monomorphizer.MonomorphizerIr as MIR (Exp, T, Type (..))
import qualified TypeChecker.TypeCheckerIr as TIR import qualified TypeChecker.TypeCheckerIr as TIR
-- | Converts a normal type into a fitting LLVM IR type
type2LlvmType :: MIR.Type -> LLVMType type2LlvmType :: MIR.Type -> LLVMType
type2LlvmType (MIR.TLit id@(TIR.Ident name)) = case name of type2LlvmType (MIR.TLit id@(TIR.Ident name)) = case name of
"Int" -> I64 "Int" -> I64
@ -20,9 +21,11 @@ type2LlvmType (MIR.TFun t xs) = do
function2LLVMType (TFun t xs) s = function2LLVMType xs (type2LlvmType t : s) function2LLVMType (TFun t xs) s = function2LLVMType xs (type2LlvmType t : s)
function2LLVMType x s = (type2LlvmType x, s) function2LLVMType x s = (type2LlvmType x, s)
-- | Extracts the type from a typed expression
getType :: T Exp -> LLVMType getType :: T Exp -> LLVMType
getType (_, t) = type2LlvmType t getType (_, t) = type2LlvmType t
-- | Extracts the type ident from a normal type
extractTypeName :: MIR.Type -> TIR.Ident extractTypeName :: MIR.Type -> TIR.Ident
extractTypeName (MIR.TLit id) = id extractTypeName (MIR.TLit id) = id
extractTypeName (MIR.TFun t xs) = extractTypeName (MIR.TFun t xs) =
@ -30,6 +33,7 @@ extractTypeName (MIR.TFun t xs) =
(TIR.Ident is) = extractTypeName xs (TIR.Ident is) = extractTypeName xs
in TIR.Ident $ i <> "_$_" <> is in TIR.Ident $ i <> "_$_" <> is
-- | Get the type from a LLVM IR value
valueGetType :: LLVMValue -> LLVMType valueGetType :: LLVMValue -> LLVMType
valueGetType (VInteger _) = I64 valueGetType (VInteger _) = I64
valueGetType (VChar _) = I8 valueGetType (VChar _) = I8
@ -37,6 +41,9 @@ valueGetType (VIdent _ t) = t
valueGetType (VConstant s) = Array (fromIntegral $ length s) I8 valueGetType (VConstant s) = Array (fromIntegral $ length s) I8
valueGetType (VFunction _ _ t) = t valueGetType (VFunction _ _ t) = t
-- | Returns the byte size of a LLVM IR type.
-- TO accomodate for memory padding,
-- most of these have been set to 8 bytes
typeByteSize :: LLVMType -> Integer typeByteSize :: LLVMType -> Integer
typeByteSize Void = 0 typeByteSize Void = 0
typeByteSize I1 = 8 -- 1, 8 due to memory padding typeByteSize I1 = 8 -- 1, 8 due to memory padding

View file

@ -20,7 +20,7 @@ import Monomorphizer.MonomorphizerIr as MIR (Bind (..), Data (..),
Type (TLit)) Type (TLit))
import TypeChecker.TypeCheckerIr (Ident (..)) import TypeChecker.TypeCheckerIr (Ident (..))
{- | Compiles an AST and produces a LLVM Ir string. {- | Compiles an AST and produces a LLVM IR string.
An easy way to actually "compile" this output is to An easy way to actually "compile" this output is to
Simply pipe it to LLI Simply pipe it to LLI
-} -}
@ -36,6 +36,8 @@ generateCode (MIR.Program scs) addGc = do
++ map inst (Map.elems state.structTypes) ++ map inst (Map.elems state.structTypes)
++ state.instructions ++ state.instructions
-- | Detects certain types and functions.
-- Used to filter out and replace definitions with LLVM equivelents
detectPrelude :: Def -> Bool detectPrelude :: Def -> Bool
detectPrelude (DData (Data (TLit (Ident "Bool")) _)) = True detectPrelude (DData (Data (TLit (Ident "Bool")) _)) = True
detectPrelude (DData (Data (TLit (Ident "Unit")) _)) = True detectPrelude (DData (Data (TLit (Ident "Unit")) _)) = True

View file

@ -26,6 +26,8 @@ import Grammar.Print (printTree)
import Monomorphizer.MonomorphizerIr import Monomorphizer.MonomorphizerIr
-- | Compiles the AST into LLVM IR code.§
-- Uses the State monad to store state
compileScs :: [Def] -> CompilerState () compileScs :: [Def] -> CompilerState ()
compileScs [] = do compileScs [] = do
emit $ UnsafeRaw "\n" emit $ UnsafeRaw "\n"
@ -196,6 +198,7 @@ compileScs (DData (Data typ ts) : xs) = do
ts ts
compileScs xs compileScs xs
-- | The first content of the main function
firstMainContent :: Bool -> [LLVMIr] firstMainContent :: Bool -> [LLVMIr]
firstMainContent True = firstMainContent True =
[ -- UnsafeRaw "%prof = call ptr @cheap_the()\n" [ -- UnsafeRaw "%prof = call ptr @cheap_the()\n"
@ -205,10 +208,12 @@ firstMainContent True =
] ]
firstMainContent False = [] firstMainContent False = []
-- | The last content of the main function
lastMainContent :: Bool -> [LLVMIr] lastMainContent :: Bool -> [LLVMIr]
lastMainContent True = [UnsafeRaw "call void @cheap_dispose()\n"] lastMainContent True = [UnsafeRaw "call void @cheap_dispose()\n"]
lastMainContent False =[] lastMainContent False =[]
-- | Simply compiles and creates LLVM IR code for an expression
compileExp :: T Exp -> CompilerState () compileExp :: T Exp -> CompilerState ()
compileExp (ELit lit, _t) = emitLit lit compileExp (ELit lit, _t) = emitLit lit
compileExp (EAdd e1 e2, t) = emitAdd t e1 e2 compileExp (EAdd e1 e2, t) = emitAdd t e1 e2
@ -217,6 +222,7 @@ compileExp (EApp e1 e2, t) = emitApp t e1 e2
compileExp (ELet bind e, _) = emitLet bind e compileExp (ELet bind e, _) = emitLet bind e
compileExp (ECase e cs, t) = emitECased t e (map (t,) cs) compileExp (ECase e cs, t) = emitECased t e (map (t,) cs)
-- | Emits a let bind.
emitLet :: Bind -> T Exp -> CompilerState () emitLet :: Bind -> T Exp -> CompilerState ()
emitLet (Bind id [] innerExp) e = do emitLet (Bind id [] innerExp) e = do
evaled <- exprToValue innerExp evaled <- exprToValue innerExp
@ -228,6 +234,8 @@ emitLet (Bind id [] innerExp) e = do
compileExp e compileExp e
emitLet b _ = error $ "Non empty argument list in let-bind " <> show b emitLet b _ = error $ "Non empty argument list in let-bind " <> show b
-- | Emits a case expression.
-- WARNING: Does not support nested pattern matches at the moment.
emitECased :: Type -> T Exp -> [(Type, Branch)] -> CompilerState () emitECased :: Type -> T Exp -> [(Type, Branch)] -> CompilerState ()
emitECased t e cases = do emitECased t e cases = do
let cs = snd <$> cases let cs = snd <$> cases
@ -365,6 +373,7 @@ emitECased t e cases = do
lbl_failPos <- (\x -> Ident $ "failed_" <> show x) <$> getNewLabel lbl_failPos <- (\x -> Ident $ "failed_" <> show x) <$> getNewLabel
emit $ Label lbl_failPos emit $ Label lbl_failPos
-- | Some prelude functions which get replaced with their LLVM IR equivelents.
preludeFuns :: LLVMIr -> Ident -> LLVMValue -> LLVMValue -> CompilerState LLVMIr preludeFuns :: LLVMIr -> Ident -> LLVMValue -> LLVMValue -> CompilerState LLVMIr
preludeFuns def xs arg1 arg2 = case xs of preludeFuns def xs arg1 arg2 = case xs of
"$langle$$langle$" -> pure $ Icmp LLSlt I8 arg1 arg2 -- FIXME "$langle$$langle$" -> pure $ Icmp LLSlt I8 arg1 arg2 -- FIXME
@ -374,6 +383,8 @@ preludeFuns def xs arg1 arg2 = case xs of
"printChar$Char_Unit" -> pure . UnsafeRaw $ "add i16 0,0\n call void (ptr, ...) @printf(ptr noundef @.char_print_no_nl, i8 noundef " <> toIr arg1 <> ")\n" "printChar$Char_Unit" -> pure . UnsafeRaw $ "add i16 0,0\n call void (ptr, ...) @printf(ptr noundef @.char_print_no_nl, i8 noundef " <> toIr arg1 <> ")\n"
_ -> pure def _ -> pure def
-- | Emits a function call.
-- Uncurries the EApp chain.
emitApp :: Type -> T Exp -> T Exp -> CompilerState () emitApp :: Type -> T Exp -> T Exp -> CompilerState ()
emitApp rt e1 e2 = do emitApp rt e1 e2 = do
((EVar name, t), args) <- go (EApp e1 e2, rt) ((EVar name, t), args) <- go (EApp e1 e2, rt)
@ -414,6 +425,8 @@ emitApp rt e1 e2 = do
TFun _ _ -> Ptr TFun _ _ -> Ptr
t -> type2LlvmType t t -> type2LlvmType t
-- | Emits an ident.
-- This should ideally never have to happen.
emitIdent :: Ident -> CompilerState () emitIdent :: Ident -> CompilerState ()
emitIdent id = do emitIdent id = do
-- !!this should never happen!! -- !!this should never happen!!
@ -421,6 +434,8 @@ emitIdent id = do
emit $ Variable id emit $ Variable id
emit $ UnsafeRaw "\n" emit $ UnsafeRaw "\n"
-- | Emits a literal.
-- This should ideally never have to happen.
emitLit :: Lit -> CompilerState () emitLit :: Lit -> CompilerState ()
emitLit i = do emitLit i = do
-- !!this should never happen!! -- !!this should never happen!!
@ -431,6 +446,8 @@ emitLit i = do
emit $ Comment "This should not have happened!" emit $ Comment "This should not have happened!"
emit $ SetVariable varCount (Add t i' (VInteger 0)) emit $ SetVariable varCount (Add t i' (VInteger 0))
-- | Genereates LLVM IR code for adding the result
-- of two expressions together
emitAdd :: Type -> T Exp -> T Exp -> CompilerState () emitAdd :: Type -> T Exp -> T Exp -> CompilerState ()
emitAdd t e1 e2 = do emitAdd t e1 e2 = do
v1 <- exprToValue e1 v1 <- exprToValue e1
@ -438,7 +455,10 @@ emitAdd t e1 e2 = do
v <- getNewVar v <- getNewVar
emit $ SetVariable v (Add (type2LlvmType t) v1 v2) emit $ SetVariable v (Add (type2LlvmType t) v1 v2)
-- | Generates LLVM IR code for a typed expression.
-- This function returns a LLVM IR value,
-- which can either be a literal or a variable,
-- to be used in other expressions.
exprToValue :: T Exp -> CompilerState LLVMValue exprToValue :: T Exp -> CompilerState LLVMValue
exprToValue et@(e, t) = case e of exprToValue et@(e, t) = case e of
ELit (LInt i) -> pure $ VInteger i ELit (LInt i) -> pure $ VInteger i