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

Fixed a segfault.

Browse source
This commit is contained in:
Samuel Hammersberg 2023-03-24 19:57:49 +01:00
parent f531afb3ab
commit 7e246a94e5
5 changed files with 82 additions and 76 deletions
Download patch file Download diff file Expand all files Collapse all files

15
sample-programs/basic-1
View file

@ -1,8 +1,9 @@
add : Int ;
add = 4;
main : Int ;
main = case add of {
5 => 0;
_ => 1;
data True() where {
True: True()
};
main: Int;
main =
case True of {
True => 1;
_ => 0;
};

41
src/Codegen/Codegen.hs
View file

@ -102,7 +102,7 @@ getConstructors bs = Map.fromList $ go bs
let (GA.Ident n) = extractTypeName t
fst
( foldl
( \(acc, i) (Constructor (GA.UIdent id) xs) ->
( \(acc, i) (Constructor (GA.Ident id) xs) ->
( ( (GA.Ident (n <> "_" <> id), MIR.TLit (coerce n))
, ConstructorInfo
{ numArgsCI = length xs
@ -215,6 +215,7 @@ compileScs [] = do
-- emit $ UnsafeRaw "\n"
-- warning this segfaults!!
enumerateOneM_
( \i (GA.Ident arg_n, arg_t) -> do
let arg_t' = type2LlvmType arg_t
@ -262,10 +263,10 @@ compileScs (MIR.DBind (MIR.Bind (name, _t) args exp) : xs) = do
compileScs xs
compileScs (MIR.DData (MIR.Data typ ts) : xs) = do
let (Ident outer_id) = extractTypeName typ
let biggestVariant = maximum $ sum <$> (\(Constructor _ t) -> typeByteSize . type2LlvmType . snd <$> t) <$> ts
emit $ LIR.Type (coerce outer_id) [I8, Array biggestVariant I8]
let biggestVariant = 1--maximum (sum . (\(Constructor _ t) -> typeByteSize . type2LlvmType . snd <$> t) <$> ts)
emit $ LIR.Type (Ident outer_id) [I8, Array biggestVariant I8]
mapM_
( \(Constructor (GA.UIdent inner_id) fi) -> do
( \(Constructor (GA.Ident inner_id) fi) -> do
emit $ LIR.Type (GA.Ident $ outer_id <> "_" <> inner_id) (I8 : map type2LlvmType (snd <$> fi))
)
ts
@ -274,6 +275,18 @@ compileScs (MIR.DData (MIR.Data typ ts) : xs) = do
mainContent :: LLVMValue -> [LLVMIr]
mainContent var =
[ 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" <>
@ -394,16 +407,16 @@ emitECased t e cases = do
emit $ Store ty val Ptr stackPtr
emit $ Br label
emit $ Label lbl_failPos
-- emitCases rt ty label stackPtr vs (Injection (MIR.CIdent id) exp) = do
-- -- //TODO this is pretty disgusting and would heavily benefit from a rewrite
-- valPtr <- getNewVar
-- emit $ SetVariable valPtr (Alloca rt)
-- emit $ Store rt vs Ptr valPtr
-- emit $ SetVariable id (Load rt Ptr valPtr)
-- increaseVarCount
-- val <- exprToValue (fst exp)
-- emit $ Store ty val Ptr stackPtr
-- emit $ Br label
emitCases rt ty label stackPtr vs (Branch (MIR.PVar (id,_), _) exp) = do
-- //TODO this is pretty disgusting and would heavily benefit from a rewrite
valPtr <- getNewVar
emit $ SetVariable valPtr (Alloca rt)
emit $ Store rt vs Ptr valPtr
emit $ SetVariable id (Load rt Ptr valPtr)
increaseVarCount
val <- exprToValue exp
emit $ Store ty val Ptr stackPtr
emit $ Br label
emitCases _ ty label stackPtr _ (Branch (MIR.PCatch, _) exp) = do
val <- exprToValue exp
emit $ Store ty val Ptr stackPtr

25
src/Main.hs
View file

@ -16,26 +16,16 @@ import Data.List.Extra (isSuffixOf)
import Compiler (compile)
import Renamer.Renamer (rename)
import System.Directory (
createDirectory,
doesPathExist,
import System.Directory (createDirectory, doesPathExist,
getDirectoryContents,
removeDirectoryRecursive,
setCurrentDirectory,
)
setCurrentDirectory)
import System.Environment (getArgs)
import System.Exit (
ExitCode,
exitFailure,
exitSuccess,
)
import System.Exit (ExitCode, exitFailure,
exitSuccess)
import System.IO (stderr)
import System.Process.Extra (
readCreateProcess,
shell,
spawnCommand,
waitForProcess,
)
import System.Process.Extra (readCreateProcess, shell,
spawnCommand, waitForProcess)
import TypeChecker.TypeChecker (typecheck)
main :: IO ()
@ -67,8 +57,7 @@ main' debug s = do
--
printToErr "\n -- Compiler --"
generatedCode <- fromCompilerErr $ generateCode (monomorphize typechecked)
putStrLn "Generation of code successful"
-- putStrLn generatedCode
putStrLn generatedCode
check <- doesPathExist "output"
when check (removeDirectoryRecursive "output")

13
src/Monomorphizer/Monomorphizer.hs
View file

@ -5,11 +5,10 @@ module Monomorphizer.Monomorphizer (monomorphize) where
import Data.Coerce (coerce)
import Grammar.Abs (Constructor (..), Ident (..))
import Unsafe.Coerce (unsafeCoerce)
import Grammar.Abs qualified as GA
import Monomorphizer.MonomorphizerIr qualified as M
import TypeChecker.TypeCheckerIr qualified as T
import qualified Grammar.Abs as GA
import qualified Monomorphizer.MonomorphizerIr as M
import qualified TypeChecker.TypeCheckerIr as T
monomorphize :: T.Program -> M.Program
monomorphize (T.Program ds) = M.Program $ monoDefs ds
@ -19,11 +18,14 @@ monoDefs = map monoDef
monoDef :: T.Def -> M.Def
monoDef (T.DBind bind) = M.DBind $ monoBind bind
monoDef (T.DData d) = M.DData $ unsafeCoerce d
monoDef (T.DData d) = M.DData $ monoData d
monoBind :: T.Bind -> M.Bind
monoBind (T.Bind name args (e, t)) = M.Bind (monoId name) (map monoId args) (monoExpr e, monoType t)
monoData :: T.Data -> M.Data
monoData (T.Data (T.Ident id) cs) = M.Data (M.TLit (Ident id)) []
monoExpr :: T.Exp -> M.Exp
monoExpr = \case
T.EId (T.Ident i) -> M.EId (Ident i)
@ -69,4 +71,5 @@ monoInit :: T.Pattern -> M.Pattern
monoInit (T.PVar (id, t)) = M.PVar (coerce id, monoType t)
monoInit (T.PLit (lit, t)) = M.PLit (monoLit lit, monoType t)
monoInit (T.PInj id ps) = M.PInj (coerce id) (monoInit <$> ps)
monoInit (T.PEnum id) = undefined
monoInit T.PCatch = M.PCatch

2
src/Monomorphizer/MonomorphizerIr.hs
View file

@ -35,7 +35,7 @@ data Branch = Branch (Pattern, Type) ExpT
type ExpT = (Exp, Type)
data Constructor = Constructor UIdent [(UIdent, Type)]
data Constructor = Constructor Ident [(Ident, Type)]
deriving (Show, Ord, Eq)
data Lit