From 66e419efa6837b1689d7f3ace246638e3955323e Mon Sep 17 00:00:00 2001
From: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date: Tue, 28 Mar 2023 11:53:25 +0200
Subject: [PATCH] Fixed the unnamed temporary bugs.

---
 src/Codegen/Codegen.hs             | 14 +++++++++++---
 src/Monomorphizer/Monomorphizer.hs |  9 +++++----
 2 files changed, 16 insertions(+), 7 deletions(-)

diff --git a/src/Codegen/Codegen.hs b/src/Codegen/Codegen.hs
index f7c4185..f1db64f 100644
--- a/src/Codegen/Codegen.hs
+++ b/src/Codegen/Codegen.hs
@@ -51,7 +51,9 @@ emit l = modify $ \t -> t{instructions = Auxiliary.snoc l $ instructions t}
 
 -- | Increases the variable counter in the CodeGenerator state
 increaseVarCount :: CompilerState ()
-increaseVarCount = (emit $ Comment "increase") >> (modify $ \t -> t{variableCount = variableCount t + 1})
+increaseVarCount = do
+    gets variableCount >>= \s -> emit.Comment $ "increase: " <> show (s + 1)
+    modify $ \t -> t{variableCount = variableCount t + 1}
 
 -- | Returns the variable count from the CodeGenerator state
 getVarCount :: CompilerState Integer
@@ -333,8 +335,8 @@ emitECased t e cases = do
     stackPtr <- getNewVar
     emit $ SetVariable stackPtr (Alloca ty)
     mapM_ (emitCases rt ty label stackPtr vs) cs
-    crashLbl <- TIR.Ident . ("crash_" <>) . show <$> getNewLabel
-    emit $ Label crashLbl
+    -- crashLbl <- TIR.Ident . ("crash_" <>) . show <$> getNewLabel
+    -- emit $ Label crashLbl
     emit . UnsafeRaw $ "call i32 (ptr, ...) @printf(ptr noundef @.non_exhaustive_patterns, i64 noundef 6, i64 noundef 6)\n"
     emit . UnsafeRaw $ "call i32 @exit(i32 noundef 1)\n"
     mapM_ (const increaseVarCount) [0..1]
@@ -419,16 +421,22 @@ emitECased t e cases = do
         val <- exprToValue exp
         emit $ Store ty val Ptr stackPtr
         emit $ Br label
+        lbl_failPos <- (\x -> TIR.Ident $ "failed_" <> show x) <$> getNewLabel
+        emit $ Label lbl_failPos
     emitCases rt ty label stackPtr vs (Branch (MIR.PEnum id, _) exp) = do
         emit $ Comment "Penum"
         val <- exprToValue exp
         emit $ Store ty val Ptr stackPtr
         emit $ Br label
+        lbl_failPos <- (\x -> TIR.Ident $ "failed_" <> show x) <$> getNewLabel
+        emit $ Label lbl_failPos
     emitCases _ ty label stackPtr _ (Branch (MIR.PCatch, _) exp) = do
         emit $ Comment "Pcatch"
         val <- exprToValue exp
         emit $ Store ty val Ptr stackPtr
         emit $ Br label
+        lbl_failPos <- (\x -> TIR.Ident $ "failed_" <> show x) <$> getNewLabel
+        emit $ Label lbl_failPos
 
 --emitLet :: Bind -> Exp -> CompilerState ()
 emitLet xs e = do
diff --git a/src/Monomorphizer/Monomorphizer.hs b/src/Monomorphizer/Monomorphizer.hs
index 8d3808c..01cc4a4 100644
--- a/src/Monomorphizer/Monomorphizer.hs
+++ b/src/Monomorphizer/Monomorphizer.hs
@@ -17,26 +17,27 @@ monoDefs = map monoDef
 
 monoDef :: T.Def -> M.Def
 monoDef (T.DBind bind) = M.DBind $ monoBind bind
---monoDef (T.DData d)    = M.DData $ monoData 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 (Ident id) cs) = M.Data (M.TLit (M.Ident id)) (map monoConstructor cs)
+monoData :: T.Data -> M.Data
+monoData (T.Data id cs) = M.Data (monoType id) (map monoConstructor cs)
 
 monoConstructor :: T.Inj -> M.Inj
 monoConstructor (T.Inj (Ident i) t) = M.Inj (T.Ident i) (monoType t)
 
 monoExpr :: T.Exp -> M.Exp
 monoExpr = \case
-    T.EVar (Ident i)   -> M.EVar (T.Ident i)
+    T.EVar i           -> M.EVar i
     T.ELit lit         -> M.ELit $ monoLit lit
     T.ELet bind expt   -> M.ELet (monoBind bind) (monoexpt expt)
     T.EApp expt1 expt2 -> M.EApp (monoexpt expt1) (monoexpt expt2)
     T.EAdd expt1 expt2 -> M.EAdd (monoexpt expt1) (monoexpt expt2)
     T.EAbs _i _expt    -> error "BUG"
     T.ECase expt injs  -> M.ECase (monoexpt expt) (monoInjs injs)
+    T.EInj i           -> M.EVar i
 
 monoAbsType :: T.Type -> M.Type
 monoAbsType (T.TLit u)     = M.TLit (coerce u)