Fixed the unnamed temporary bugs.

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
+    -- crashLbl <- TIR.Ident . ("crash_" <>) . show <$> getNewLabel
-    emit $ Label crashLbl
+    -- 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

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 -> M.Data
---monoData (T.Data (Ident id) cs) = M.Data (M.TLit (M.Ident id)) (map monoConstructor cs)
+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)