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

Fixed some more stuff.

Browse source
This commit is contained in:
Samuel Hammersberg 2023-03-23 22:01:40 +01:00
parent 75fa232e21
commit 0012efabb7
3 changed files with 40 additions and 35 deletions
Download patch file Download diff file Expand all files Collapse all files

56
src/Monomorphizer/Monomorphizer.hs
View file

@ -2,53 +2,59 @@
module Monomorphizer.Monomorphizer (monomorphize) where
import Grammar.Abs (Ident (..))
import Monomorphizer.MonomorphizerIr
import Data.Coerce (coerce)
import Grammar.Abs (Constructor (..), Ident (..),
Indexed (..))
import qualified Monomorphizer.MonomorphizerIr as M
import qualified TypeChecker.TypeCheckerIr as T
monomorphize :: T.Program -> Program
monomorphize (T.Program ds) = Program $ monoDefs ds
monomorphize :: T.Program -> M.Program
monomorphize (T.Program ds) = M.Program $ monoDefs ds
monoDefs :: [T.Def] -> [Def]
monoDefs :: [T.Def] -> [M.Def]
monoDefs = map monoDef
monoDef :: T.Def -> Def
monoDef (T.DBind bind) = DBind $ monoBind bind
monoDef (T.DData d) = DData d
monoDef :: T.Def -> M.Def
monoDef (T.DBind bind) = M.DBind $ monoBind bind
monoDef (T.DData d) = M.DData $ monoData d
monoBind :: T.Bind -> Bind
monoBind (T.Bind name args (e, t)) = Bind (monoId name) (map monoId args) (monoExpr e, monoType t)
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)
monoExpr :: T.Exp -> M.Exp
monoExpr = \case
T.EId (Ident i) -> EId (Ident i)
T.ELit lit -> ELit $ monoLit lit
T.ELet bind expt -> ELet (monoBind bind) (monoexpt expt)
T.EApp expt1 expt2 -> EApp (monoexpt expt1) (monoexpt expt2)
T.EAdd expt1 expt2 -> EAdd (monoexpt expt1) (monoexpt expt2)
T.EId (Ident i) -> M.EId (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)
T.EAdd expt1 expt2 -> M.EAdd (monoexpt expt1) (monoexpt expt2)
T.EAbs i expt -> error "BUG"
T.ECase expt injs -> ECase (monoexpt expt) (monoInjs injs)
T.ECase expt injs -> M.ECase (monoexpt expt) (monoInjs injs)
monoType :: T.Type -> Type
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) = TLit i
monoType (T.TFun t1 t2) = TFun (monoType t1) (monoType t2)
monoType (T.TLit i) = M.TLit i
monoType (T.TFun t1 t2) = M.TFun (monoType t1) (monoType t2)
monoexpt :: T.ExpT -> M.ExpT
monoexpt (e, t) = (monoExpr e, monoType t)
monoId :: T.Id -> Id
monoId :: T.Id -> M.Id
monoId (n,t) = (n, monoType t)
monoLit :: T.Lit -> Lit
monoLit (T.LInt i) = LInt i
monoLit (T.LChar c) = LChar c
monoLit :: T.Lit -> M.Lit
monoLit (T.LInt i) = M.LInt i
monoLit (T.LChar c) = M.LChar c
monoInjs :: [T.Inj] -> [M.Injection]
monoInjs = map monoInj
monoInj (T.Inj (init, t) expt) = Injection (monoInit init, monoType t) (monoexpt expt)
monoInj :: T.Inj -> M.Injection
monoInj (T.Inj (init, t) expt) = M.Injection (monoInit init, monoType t) (monoexpt expt)
monoInit :: T.Init -> Init
monoInit :: T.Init -> M.Init
monoInit = id