Rakarake/churf
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

dummy monomorphizer complete

Browse source
This commit is contained in:
sebastian 2023-03-24 22:03:43 +01:00
parent 7e246a94e5
commit accbd4eea6
2 changed files with 33 additions and 32 deletions
Download patch file Download diff file Expand all files Collapse all files

33
src/Monomorphizer/Monomorphizer.hs
View file

@ -4,11 +4,9 @@
module Monomorphizer.Monomorphizer (monomorphize) where
import Data.Coerce (coerce)
import Grammar.Abs (Constructor (..), Ident (..))
import qualified Grammar.Abs as GA
import qualified Monomorphizer.MonomorphizerIr as M
import qualified TypeChecker.TypeCheckerIr as T
import Monomorphizer.MonomorphizerIr qualified as M
import TypeChecker.TypeCheckerIr qualified as T
monomorphize :: T.Program -> M.Program
monomorphize (T.Program ds) = M.Program $ monoDefs ds
@ -24,11 +22,14 @@ 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 (T.Ident id) cs) = M.Data (M.TLit (Ident id)) []
monoData (T.Data (T.Ident id) cs) = M.Data (M.TLit (M.Ident id)) (map monoConstructor cs)
monoConstructor :: T.Constructor -> M.Constructor
monoConstructor (T.Constructor (T.Ident i) t) = M.Constructor (M.Ident i) (monoType t)
monoExpr :: T.Exp -> M.Exp
monoExpr = \case
T.EId (T.Ident i) -> M.EId (Ident i)
T.EId (T.Ident i) -> M.EId (M.Ident 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)
@ -36,20 +37,19 @@ monoExpr = \case
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) = M.TLit "Int"
monoAbsType (GA.TAll _v _t) = error "NOT ALL TYPES"
monoAbsType (GA.TEVar _v) = error "I DONT KNOW WHAT THIS IS"
monoAbsType (GA.TFun t1 t2) = M.TFun (monoAbsType t1) (monoAbsType t2)
monoAbsType (GA.TData _ _) = error "NOT INDEXED TYPES"
monoAbsType :: T.Type -> M.Type
monoAbsType (T.TLit u) = M.TLit (coerce u)
monoAbsType (T.TVar _v) = M.TLit "Int"
monoAbsType (T.TAll _v _t) = error "NOT ALL TYPES"
monoAbsType (T.TFun t1 t2) = M.TFun (monoAbsType t1) (monoAbsType t2)
monoAbsType (T.TData _ _) = error "NOT INDEXED TYPES"
monoType :: T.Type -> M.Type
monoType (T.TAll _ t) = monoType t
monoType (T.TVar (T.MkTVar i)) = M.TLit "Int"
monoType (T.TLit (T.Ident i)) = M.TLit (Ident i)
monoType (T.TLit (T.Ident i)) = M.TLit (M.Ident i)
monoType (T.TFun t1 t2) = M.TFun (monoType t1) (monoType t2)
monoType (T.TData (T.Ident n) t) = M.TLit (Ident (n ++ concatMap show t))
monoType (T.TData (T.Ident n) t) = M.TLit (M.Ident (n ++ concatMap show t))
monoexpt :: T.ExpT -> M.ExpT
monoexpt (e, t) = (monoExpr e, monoType t)
@ -71,5 +71,6 @@ monoInit :: T.Pattern -> M.Pattern
monoInit (T.PVar (id, t)) = M.PVar (coerce id, monoType t)
monoInit (T.PLit (lit, t)) = M.PLit (monoLit lit, monoType t)
monoInit (T.PInj id ps) = M.PInj (coerce id) (monoInit <$> ps)
monoInit (T.PEnum id) = undefined
-- DO NOT DO THIS FOR REAL THOUGH
monoInit (T.PEnum (T.Ident i)) = M.PInj (M.Ident i) []
monoInit T.PCatch = M.PCatch

8
src/Monomorphizer/MonomorphizerIr.hs
View file

@ -1,8 +1,8 @@
module Monomorphizer.MonomorphizerIr (module Monomorphizer.MonomorphizerIr, module RE, module GA) where
import Grammar.Abs (Ident (..), UIdent)
import qualified Grammar.Abs as GA (Ident (..))
import qualified TypeChecker.TypeCheckerIr as RE
import Grammar.Abs qualified as GA (Ident (..))
import TypeChecker.TypeCheckerIr qualified as RE
type Id = (Ident, Type)
@ -27,7 +27,7 @@ data Exp
| ECase ExpT [Branch]
deriving (Show, Ord, Eq)
data Pattern = PVar Id | PLit (Lit, Type) | PInj Ident [Pattern] | PCatch
data Pattern = PVar Id | PLit (Lit, Type) | PInj Ident [Pattern] | PCatch | PEnum Ident
deriving (Eq, Ord, Show)
data Branch = Branch (Pattern, Type) ExpT
@ -35,7 +35,7 @@ data Branch = Branch (Pattern, Type) ExpT
type ExpT = (Exp, Type)
data Constructor = Constructor Ident [(Ident, Type)]
data Constructor = Constructor Ident Type
deriving (Show, Ord, Eq)
data Lit