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

renamed stuff

Browse source
This commit is contained in:
sebastianselander 2023-03-24 12:21:54 +01:00
parent 3f618e77f9
commit ce3971cf75
9 changed files with 414 additions and 409 deletions
Download patch file Download diff file Expand all files Collapse all files

44
src/Monomorphizer/Monomorphizer.hs
View file

@ -2,12 +2,13 @@
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
import Data.Coerce (coerce)
import Grammar.Abs (Constructor (..), Ident (..))
import Unsafe.Coerce (unsafeCoerce)
import Grammar.Abs qualified as GA
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
@ -17,14 +18,11 @@ monoDefs = map monoDef
monoDef :: T.Def -> M.Def
monoDef (T.DBind bind) = M.DBind $ monoBind bind
monoDef (T.DData d) = M.DData $ monoData d
monoDef (T.DData d) = M.DData $ unsafeCoerce d
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) = M.Constructor n (map (\(Constructor n t) -> (n, monoAbsType t)) cons)
monoExpr :: T.Exp -> M.Exp
monoExpr = \case
T.EId (Ident i) -> M.EId (Ident i)
@ -36,29 +34,28 @@ monoExpr = \case
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)
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.TData _ 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.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"
monoType (T.TLit i) = M.TLit i
monoType (T.TFun t1 t2) = M.TFun (monoType t1) (monoType t2)
monoType (T.TData _ _) = error "Not sure what this is"
monoexpt :: T.ExpT -> M.ExpT
monoexpt (e, t) = (monoExpr e, monoType t)
monoId :: T.Id -> M.Id
monoId (n,t) = (n, monoType t)
monoId (n, t) = (n, monoType t)
monoLit :: T.Lit -> M.Lit
monoLit (T.LInt i) = M.LInt i
monoLit (T.LInt i) = M.LInt i
monoLit (T.LChar c) = M.LChar c
monoInjs :: [T.Inj] -> [M.Injection]
@ -69,4 +66,3 @@ monoInj (T.Inj (init, t) expt) = M.Injection (monoInit init, monoType t) (monoex
monoInit :: T.Init -> M.Init
monoInit = id