Fixed chars.

This commit is contained in:
Samuel Hammersberg 2023-03-28 16:54:11 +02:00
parent ba832ba288
commit 4809cad1cb
2 changed files with 18 additions and 36 deletions

View file

@ -6,9 +6,11 @@ module Codegen.Codegen (generateCode) where
import Auxiliary (snoc) import Auxiliary (snoc)
import Codegen.LlvmIr as LIR import Codegen.LlvmIr as LIR
import Control.Applicative ((<|>)) import Control.Applicative ((<|>))
import Control.Monad (when)
import Control.Monad.State (StateT, execStateT, foldM_, import Control.Monad.State (StateT, execStateT, foldM_,
gets, modify) gets, modify)
import qualified Data.Bifunctor as BI import qualified Data.Bifunctor as BI
import Data.Char (ord)
import Data.Coerce (coerce) import Data.Coerce (coerce)
import Data.Map (Map) import Data.Map (Map)
import qualified Data.Map as Map import qualified Data.Map as Map
@ -243,9 +245,10 @@ compileScs (MIR.DBind (MIR.Bind (name, _t) args exp) : xs) = do
emit . Comment $ show name <> ": " <> show exp emit . Comment $ show name <> ": " <> show exp
let args' = map (second type2LlvmType) args let args' = map (second type2LlvmType) args
emit $ Define FastCC I64 {-(type2LlvmType t_return)-} name args' emit $ Define FastCC I64 {-(type2LlvmType t_return)-} name args'
when (name == "main") (mapM_ emit firstMainContent)
functionBody <- exprToValue exp functionBody <- exprToValue exp
if name == "main" if name == "main"
then mapM_ emit $ mainContent functionBody then mapM_ emit $ lastMainContent functionBody
else emit $ Ret I64 functionBody else emit $ Ret I64 functionBody
emit DefineEnd emit DefineEnd
modify $ \s -> s{variableCount = 0} modify $ \s -> s{variableCount = 0}
@ -262,39 +265,15 @@ compileScs (MIR.DData (MIR.Data typ ts) : xs) = do
ts ts
compileScs xs compileScs xs
mainContent :: LLVMValue -> [LLVMIr] firstMainContent :: [LLVMIr]
mainContent var = firstMainContent =
[ UnsafeRaw "call void @_ZN2GC4Heap4initEv()\n"
]
lastMainContent :: LLVMValue -> [LLVMIr]
lastMainContent var =
[ UnsafeRaw $ [ UnsafeRaw $
-- "%2 = alloca %Craig\n" <>
-- " store %Craig %1, ptr %2\n" <>
-- " %3 = bitcast %Craig* %2 to i72*\n" <>
-- " %4 = load i72, ptr %3\n" <>
-- " call i32 (ptr, ...) @printf(ptr noundef @.str, i72 noundef %4)\n"
-- "%2 = alloca %Craig\n" <>
-- " store %Craig %1, ptr %2\n" <>
-- " %3 = bitcast %Craig* %2 to i72*\n" <>
-- " %4 = load i72, ptr %3\n" <>
-- " call i32 (ptr, ...) @printf(ptr noundef @.str, i72 noundef %4)\n"
-- "%2 = alloca %Craig\n" <>
-- " store %Craig %1, ptr %2\n" <>
-- " %3 = bitcast %Craig* %2 to i72*\n" <>
-- " %4 = load i72, ptr %3\n" <>
-- " call i32 (ptr, ...) @printf(ptr noundef @.str, i72 noundef %4)\n"
"call i32 (ptr, ...) @printf(ptr noundef @.str, i64 noundef " <> toIr var <> ")\n" "call i32 (ptr, ...) @printf(ptr noundef @.str, i64 noundef " <> toIr var <> ")\n"
, -- , SetVariable (TIR.Ident "p") (Icmp LLEq I64 (VInteger 2) (VInteger 2)) , Ret I64 (VInteger 0)
-- , BrCond (VIdent (TIR.Ident "p")) (TIR.Ident "b_1") (TIR.Ident "b_2")
-- , Label (TIR.Ident "b_1")
-- , UnsafeRaw
-- "call i32 (ptr, ...) @printf(ptr noundef @.str, i64 noundef 1)\n"
-- , Br (TIR.Ident "end")
-- , Label (TIR.Ident "b_2")
-- , UnsafeRaw
-- "call i32 (ptr, ...) @printf(ptr noundef @.str, i64 noundef 2)\n"
-- , Br (TIR.Ident "end")
-- , Label (TIR.Ident "end")
Ret I64 (VInteger 0)
] ]
defaultStart :: [LLVMIr] defaultStart :: [LLVMIr]
@ -305,6 +284,9 @@ defaultStart =
, UnsafeRaw "@.non_exhaustive_patterns = private unnamed_addr constant [41 x i8] c\"Non-exhaustive patterns in case at %i:%i\n\"\n" , UnsafeRaw "@.non_exhaustive_patterns = private unnamed_addr constant [41 x i8] c\"Non-exhaustive patterns in case at %i:%i\n\"\n"
, UnsafeRaw "declare i32 @printf(ptr noalias nocapture, ...)\n" , UnsafeRaw "declare i32 @printf(ptr noalias nocapture, ...)\n"
, UnsafeRaw "declare i32 @exit(i32 noundef)\n" , UnsafeRaw "declare i32 @exit(i32 noundef)\n"
, UnsafeRaw "declare i32 @_ZN2GC4Heap4initEv()\n"
, UnsafeRaw "declare i32 @_ZN2GC4Heap5allocEm()\n"
, UnsafeRaw "declare i32 @_ZN2GC4Heap7disposeEv()\n"
] ]
compileExp :: ExpT -> CompilerState () compileExp :: ExpT -> CompilerState ()
@ -398,7 +380,7 @@ emitECased t e cases = do
emit $ Comment "Plit" emit $ Comment "Plit"
let i' = case i of let i' = case i of
(MIR.LInt i, _) -> VInteger i (MIR.LInt i, _) -> VInteger i
(MIR.LChar i, _) -> VChar i (MIR.LChar i, _) -> VChar (ord i)
ns <- getNewVar ns <- getNewVar
lbl_failPos <- (\x -> TIR.Ident $ "failed_" <> show x) <$> getNewLabel lbl_failPos <- (\x -> TIR.Ident $ "failed_" <> show x) <$> getNewLabel
lbl_succPos <- (\x -> TIR.Ident $ "success_" <> show x) <$> getNewLabel lbl_succPos <- (\x -> TIR.Ident $ "success_" <> show x) <$> getNewLabel
@ -485,7 +467,7 @@ emitLit i = do
-- !!this should never happen!! -- !!this should never happen!!
let (i', t) = case i of let (i', t) = case i of
(MIR.LInt i'') -> (VInteger i'', I64) (MIR.LInt i'') -> (VInteger i'', I64)
(MIR.LChar i'') -> (VChar i'', I8) (MIR.LChar i'') -> (VChar $ ord i'', I8)
varCount <- getNewVar varCount <- getNewVar
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))
@ -508,7 +490,7 @@ exprToValue :: ExpT -> CompilerState LLVMValue
exprToValue = \case exprToValue = \case
(MIR.ELit i, t) -> pure $ case i of (MIR.ELit i, t) -> pure $ case i of
(MIR.LInt i) -> VInteger i (MIR.LInt i) -> VInteger i
(MIR.LChar i) -> VChar i (MIR.LChar i) -> VChar $ ord i
(MIR.EVar name, t) -> do (MIR.EVar name, t) -> do
funcs <- gets functions funcs <- gets functions
cons <- gets constructors cons <- gets constructors

View file

@ -88,7 +88,7 @@ or a string contstant
-} -}
data LLVMValue data LLVMValue
= VInteger Integer = VInteger Integer
| VChar Char | VChar Int
| VIdent Ident LLVMType | VIdent Ident LLVMType
| VConstant String | VConstant String
| VFunction Ident Visibility LLVMType | VFunction Ident Visibility LLVMType