From c2bf6312f652df2bc6901ac75e804ae8aee39ba3 Mon Sep 17 00:00:00 2001
From: Rakarake <williambodin2001@gmail.com>
Date: Wed, 12 Apr 2023 16:36:22 +0200
Subject: [PATCH] Monomorphizer now outputs constructors that are matched on
 but not created

---
 sample-programs/{mono.crf => mono-1.crf} |  0
 sample-programs/mono-3.crf               | 11 +++++++++++
 src/Monomorphizer/Monomorphizer.hs       | 13 ++++++++-----
 3 files changed, 19 insertions(+), 5 deletions(-)
 rename sample-programs/{mono.crf => mono-1.crf} (100%)
 create mode 100644 sample-programs/mono-3.crf

diff --git a/sample-programs/mono.crf b/sample-programs/mono-1.crf
similarity index 100%
rename from sample-programs/mono.crf
rename to sample-programs/mono-1.crf
diff --git a/sample-programs/mono-3.crf b/sample-programs/mono-3.crf
new file mode 100644
index 0000000..a51df2c
--- /dev/null
+++ b/sample-programs/mono-3.crf
@@ -0,0 +1,11 @@
+data Number() where
+    One: Number ()
+    Two: Number ()
+
+numberToInt : Number () -> Int
+numberToInt n = case n of
+                  One => 1
+                  Two => 2
+
+main = numberToInt One
+
diff --git a/src/Monomorphizer/Monomorphizer.hs b/src/Monomorphizer/Monomorphizer.hs
index 60607ca..50f1bef 100644
--- a/src/Monomorphizer/Monomorphizer.hs
+++ b/src/Monomorphizer/Monomorphizer.hs
@@ -237,22 +237,25 @@ morphBranch (T.Branch (p, pt) (e, et)) = do
   pt' <- getMonoFromPoly pt
   et' <- getMonoFromPoly et
   env <- ask
-  (p', newLocals)  <- morphPattern (locals env) p
+  (p', newLocals)  <- morphPattern pt' (locals env) p
   local (const env { locals = Set.union newLocals (locals env) }) $ do
     e' <- morphExp et' e
     return $ M.Branch (p', pt') (e', et')
 
 -- Morphs pattern (patter -> expression), gives the newly bound local variables.
-morphPattern :: Set.Set Ident -> T.Pattern -> EnvM (M.Pattern, Set.Set Ident)
-morphPattern ls = \case
+morphPattern :: M.Type -> Set.Set Ident -> T.Pattern -> EnvM (M.Pattern, Set.Set Ident)
+morphPattern expectedType ls = \case
   T.PVar (ident, t) -> do t' <- getMonoFromPoly t
                           return (M.PVar (ident, t'), Set.insert ident ls)
   T.PLit (lit, t) ->   do t' <- getMonoFromPoly t
                           return (M.PLit (convertLit lit, t'), ls)
   T.PCatch -> return (M.PCatch, ls)
   -- Constructor ident
-  T.PEnum ident   -> return (M.PEnum ident, ls)
-  T.PInj ident ps -> do pairs <- mapM (morphPattern ls) ps
+  T.PEnum ident   -> do morphCons expectedType ident
+                        return (M.PEnum ident, ls)
+  T.PInj ident ps -> do morphCons expectedType ident
+                        let (M.TData tIdent ts) = expectedType
+                        pairs <- mapM (\(pat, patT) -> morphPattern patT ls pat) (zip ps ts)
                         return (M.PInj ident (map fst pairs), Set.unions (map snd pairs))
 
 -- | Creates a new identifier for a function with an assigned type