Added some toplevel comments.
This commit is contained in:
parent
bb40cbba2a
commit
1dc1b8f92e
3 changed files with 31 additions and 2 deletions
|
|
@ -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
|
||||||
|
|
|
||||||
|
|
@ -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
|
||||||
|
|
|
||||||
|
|
@ -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
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue