Unreachable branhces are removed, fixed a nasty bug in monomorphizer 😸

sample-programs/bubble-sort.chrf

@@ -0,0 +1,11 @@
+data List (a) where
+    Cons : a -> List (a) -> List (a)
+    Nil  : List (a)
+
+bubblesort : List (a) -> List (a)
+bubblesort xs = case xs of
+    Nil    => Nil
+    Cons x => case x of
+        Nil => Cons x Nil
+        Cons y => 
+

sample-programs/insertion-sort.chrf

@@ -0,0 +1,23 @@
+data List (a) where
+    Nil : List (a)
+    Cons : a -> List (a) -> List (a)
+
+insert : Int -> List (Int) -> List (Int)
+insert x xs = case xs of
+    Cons z zs => case (lt x z) of
+        True => Cons x (Cons z zs)
+        False => Cons z (insert x zs)
+    Nil => Cons x Nil
+        
+insertionSort : List (Int) -> List (Int)
+insertionSort xs = case xs of
+    Cons y ys => case ys of
+        _ => insert y (insertionSort ys)
+        Nil => xs
+    Nil => Nil
+
+main = head (insertionSort (Cons 5 (Cons 4 (Cons 3 (Cons 2 (Cons 1 Nil))))))
+
+head xs = case xs of
+    Cons x _ => x
+

sample-programs/mono-2.crf

@@ -5,6 +5,9 @@ data Either(a b) where
 unwrapLeft x = case x of
     Left y => y
 
+unwrapRight x = case x of
+    Right y => y
+
 wow = Left 5
 
 main = unwrapLeft wow

src/Monomorphizer/Monomorphizer.hs

@@ -46,7 +46,7 @@ import Control.Monad.State (
  )
 import Data.Coerce (coerce)
 import Data.Map qualified as Map
-import Data.Maybe (fromJust)
+import Data.Maybe (fromJust, catMaybes)
 import Data.Set qualified as Set
 import Debug.Trace
 import Grammar.Print (printTree)
@@ -102,6 +102,10 @@ markBind ident = modify (Map.insert ident Marked)
 isBindMarked :: Ident -> EnvM Bool
 isBindMarked ident = gets (Map.member ident)
 
+-- | Checks if constructor is outputted.
+isConsMarked :: Ident -> EnvM Bool
+isConsMarked ident = gets (Map.member ident)
+
 -- | Finds main bind.
 getMain :: EnvM T.Bind
 getMain = asks (\env -> case Map.lookup (T.Ident "main") (input env) of
@@ -228,7 +232,7 @@ morphExp expectedType exp = case exp of
         t' <- getMonoFromPoly t
         bs' <- mapM morphBranch bs
         exp' <- morphExp t' exp
-        return $ M.ECase (exp', t') bs'
+        return $ M.ECase (exp', t') (catMaybes bs')
     T.EVar ident -> do
         isLocal <- localExists ident
         if isLocal
@@ -248,28 +252,39 @@ morphExp expectedType exp = case exp of
     T.ELet (T.Bind{}) _ -> error "lets not possible yet"
 
 -- | Monomorphizes case-of branches.
-morphBranch :: T.Branch -> EnvM M.Branch
+morphBranch :: T.Branch -> EnvM (Maybe M.Branch)
 morphBranch (T.Branch (p, pt) (e, et)) = do
   pt' <- getMonoFromPoly pt
   et' <- getMonoFromPoly et
   env <- ask
-  (p', newLocals)  <- morphPattern p pt'
-  local (const env { locals = Set.union (locals env) newLocals }) $ do
-    e' <- morphExp et' e
-    return $ M.Branch (p', pt') (e', et')
+  maybeMorphedPattern <- morphPattern p pt'
+  case maybeMorphedPattern of
+    Nothing -> return Nothing
+    Just (p', newLocals) -> 
+      local (const env { locals = Set.union (locals env) newLocals }) $ do
+        e' <- morphExp et' e
+        return $ Just (M.Branch (p', pt') (e', et'))
 
-morphPattern :: T.Pattern -> M.Type -> EnvM (M.Pattern, Set.Set Ident)
+morphPattern :: T.Pattern -> M.Type -> EnvM (Maybe (M.Pattern, Set.Set Ident))
 morphPattern p expectedType = case p of
-  T.PVar ident     -> return (M.PVar (ident, expectedType), Set.singleton ident)
-  T.PLit lit       -> return (M.PLit (convertLit lit, expectedType), Set.empty)
-  T.PCatch         -> return (M.PCatch, Set.empty)
+  T.PVar ident     -> return $ Just (M.PVar (ident, expectedType), Set.singleton ident)
+  T.PLit lit       -> return $ Just (M.PLit (convertLit lit, expectedType), Set.empty)
+  T.PCatch         -> return $ Just (M.PCatch, Set.empty)
   T.PEnum ident    -> do --morphCons expectedType ident
-                         return (M.PEnum ident, Set.empty)
+                         return $ Just (M.PEnum ident, Set.empty)
   T.PInj ident pts -> do --morphCons expectedType ident
-                         ts' <- mapM (getMonoFromPoly . snd) pts
-                         let pts' = zip (map fst pts) ts'
-                         psSets <- mapM (uncurry morphPattern) pts'
-                         return (M.PInj ident (map fst psSets), Set.unions $ map snd psSets)
+                         isMarked <- isConsMarked ident
+                         if isMarked
+                            then do
+                              ts' <- mapM (getMonoFromPoly . snd) pts
+                              let pts' = zip (map fst pts) ts'
+                              psSets <- mapM (uncurry morphPattern) pts'
+                              let maybePsSets = sequence psSets
+                              case maybePsSets of
+                                Nothing      -> return Nothing
+                                Just psSets' -> return $ Just 
+                                  (M.PInj ident (map fst psSets'), Set.unions $ map snd psSets')
+                            else return Nothing
 
 -- | Creates a new identifier for a function with an assigned type.
 newFuncName :: M.Type -> T.Bind -> Ident