From 30a79f34afc46fb31927354059496e8d0ca2c52d Mon Sep 17 00:00:00 2001
From: Samuel Hammersberg <samuel.hammersberg@gmail.com>
Date: Fri, 24 Mar 2023 10:57:21 +0100
Subject: [PATCH] Added some missing functionality to the dummy monomorphizer.

---
 src/Monomorphizer/Monomorphizer.hs   | 16 ++++++++++++++--
 src/Monomorphizer/MonomorphizerIr.hs |  4 ++++
 2 files changed, 18 insertions(+), 2 deletions(-)

diff --git a/src/Monomorphizer/Monomorphizer.hs b/src/Monomorphizer/Monomorphizer.hs
index c7506cb..6af43b4 100644
--- a/src/Monomorphizer/Monomorphizer.hs
+++ b/src/Monomorphizer/Monomorphizer.hs
@@ -5,6 +5,7 @@ module Monomorphizer.Monomorphizer (monomorphize) where
 import           Data.Coerce                   (coerce)
 import           Grammar.Abs                   (Constructor (..), Ident (..),
                                                 Indexed (..))
+import qualified Grammar.Abs                   as GA
 import qualified Monomorphizer.MonomorphizerIr as M
 import qualified TypeChecker.TypeCheckerIr     as T
 
@@ -22,7 +23,7 @@ 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.Constructor
-monoData (T.Data (Indexed n _) cons) = undefined-- M.Constructor n (map (\(Constructor n t) -> (n, monoType t)) cons)
+monoData (T.Data (Indexed n _) cons) =  M.Constructor n (map (\(Constructor n t) -> (n, monoAbsType t)) cons)
 
 monoExpr :: T.Exp -> M.Exp
 monoExpr = \case
@@ -31,14 +32,24 @@ monoExpr = \case
     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.EAbs _i _expt -> error "BUG"
     T.ECase expt injs -> M.ECase (monoexpt expt) (monoInjs injs)
 
+monoAbsType :: GA.Type -> M.Type
+monoAbsType (GA.TLit u)      = M.TLit (coerce u)
+monoAbsType (GA.TVar _v)     = error "NOT POLYMORHPIC TYPES"
+monoAbsType (GA.TAll _v _t)  = error "NOT ALL TYPES"
+monoAbsType (GA.TIndexed _i) = error "NOT INDEXED TYPES"
+monoAbsType (GA.TEVar _v)    = error "I DONT KNOW WHAT THIS IS"
+monoAbsType (GA.TFun t1 t2)  = M.TFun (monoAbsType t1) (monoAbsType t2)
+
+
 monoType :: T.Type -> M.Type
 monoType (T.TAll _ t)          = monoType t
 monoType (T.TVar (T.MkTVar i)) = error "NOT POLYMORPHIC TYPES"
 monoType (T.TLit i)            = M.TLit i
 monoType (T.TFun t1 t2)        = M.TFun (monoType t1) (monoType t2)
+monoType (T.TIndexed _)        = error "Not sure what this is"
 
 monoexpt :: T.ExpT -> M.ExpT
 monoexpt (e, t) = (monoExpr e, monoType t)
@@ -58,3 +69,4 @@ monoInj (T.Inj (init, t) expt) = M.Injection (monoInit init, monoType t) (monoex
 
 monoInit :: T.Init -> M.Init
 monoInit = id
+
diff --git a/src/Monomorphizer/MonomorphizerIr.hs b/src/Monomorphizer/MonomorphizerIr.hs
index 18f29ed..f24bab5 100644
--- a/src/Monomorphizer/MonomorphizerIr.hs
+++ b/src/Monomorphizer/MonomorphizerIr.hs
@@ -40,3 +40,7 @@ data Lit
 
 data Type = TLit Ident | TFun Type Type
     deriving (Show, Ord, Eq)
+
+flattenType :: Type -> [Type]
+flattenType (TFun t1 t2) = t1 : flattenType t2
+flattenType x            = [x]