Fixed a segfault.

sample-programs/basic-1

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

src/Codegen/Codegen.hs

@@ -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
+    let biggestVariant = 1--maximum (sum . (\(Constructor _ t) -> typeByteSize . type2LlvmType . snd <$> t) <$> ts)
-    emit $ LIR.Type (coerce outer_id) [I8, Array biggestVariant I8]
+    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
+    emitCases rt ty label stackPtr vs (Branch (MIR.PVar (id,_), _) exp) = do
---         -- //TODO this is pretty disgusting and would heavily benefit from a rewrite
+        -- //TODO this is pretty disgusting and would heavily benefit from a rewrite
---         valPtr <- getNewVar
+        valPtr <- getNewVar
---         emit $ SetVariable valPtr (Alloca rt)
+        emit $ SetVariable valPtr (Alloca rt)
---         emit $ Store rt vs Ptr valPtr
+        emit $ Store rt vs Ptr valPtr
---         emit $ SetVariable id (Load rt Ptr valPtr)
+        emit $ SetVariable id (Load rt Ptr valPtr)
---         increaseVarCount
+        increaseVarCount
---         val <- exprToValue (fst exp)
+        val <- exprToValue  exp
---         emit $ Store ty val Ptr stackPtr
+        emit $ Store ty val Ptr stackPtr
---         emit $ Br label
+        emit $ Br label
     emitCases _ ty label stackPtr _ (Branch (MIR.PCatch, _) exp) = do
         val <- exprToValue exp
         emit $ Store ty val Ptr stackPtr

src/Main.hs

@@ -16,26 +16,16 @@ import Data.List.Extra (isSuffixOf)
 
 import           Compiler                    (compile)
 import           Renamer.Renamer             (rename)
-import System.Directory (
+import           System.Directory            (createDirectory, doesPathExist,
-    createDirectory,
-    doesPathExist,
                                               getDirectoryContents,
                                               removeDirectoryRecursive,
-    setCurrentDirectory,
+                                              setCurrentDirectory)
- )
 import           System.Environment          (getArgs)
-import System.Exit (
+import           System.Exit                 (ExitCode, exitFailure,
-    ExitCode,
+                                              exitSuccess)
-    exitFailure,
-    exitSuccess,
- )
 import           System.IO                   (stderr)
-import System.Process.Extra (
+import           System.Process.Extra        (readCreateProcess, shell,
-    readCreateProcess,
+                                              spawnCommand, waitForProcess)
-    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")

src/Monomorphizer/Monomorphizer.hs

@@ -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 qualified Grammar.Abs                   as GA
-import Monomorphizer.MonomorphizerIr qualified as M
+import qualified Monomorphizer.MonomorphizerIr as M
-import TypeChecker.TypeCheckerIr qualified as T
+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

src/Monomorphizer/MonomorphizerIr.hs

@@ -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