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

14
src/Monomorphizer/MonomorphizerIr.hs
View file

@ -1,16 +1,18 @@
module Monomorphizer.MonomorphizerIr (module Monomorphizer.MonomorphizerIr, module RE, module GA) where
import Grammar.Abs (Ident (..), Init (..), UIdent)
import qualified Grammar.Abs as GA (Ident (..), Init (..))
import qualified TypeChecker.TypeCheckerIr as RE (Indexed)
import TypeChecker.TypeCheckerIr (Indexed)
import Grammar.Abs (Ident (..), Init (..), UIdent)
import Grammar.Abs qualified as GA (Ident (..), Init (..))
import TypeChecker.TypeCheckerIr qualified as RE
type Id = (Ident, Type)
newtype Program = Program [Def]
deriving (Show, Ord, Eq)
data Def = DBind Bind | DData Constructor
data Def = DBind Bind | DData Data
deriving (Show, Ord, Eq)
data Data = Data Type Constructor
deriving (Show, Ord, Eq)
data Bind = Bind Id [Id] ExpT
@ -43,4 +45,4 @@ data Type = TLit Ident | TFun Type Type
flattenType :: Type -> [Type]
flattenType (TFun t1 t2) = t1 : flattenType t2
flattenType x = [x]
flattenType x = [x]