created dummy monomorphizer

This commit is contained in:
sebastianselander 2023-03-23 18:15:25 +01:00
parent c19f821892
commit c6e8305215
3 changed files with 57 additions and 15 deletions

View file

@ -1,5 +1,8 @@
{-# LANGUAGE LambdaCase #-}
module Monomorphizer.Monomorphizer (monomorphize) where module Monomorphizer.Monomorphizer (monomorphize) where
import Grammar.Abs (Ident (..))
import Monomorphizer.MonomorphizerIr import Monomorphizer.MonomorphizerIr
import TypeChecker.TypeCheckerIr qualified as T import TypeChecker.TypeCheckerIr qualified as T
@ -14,4 +17,37 @@ monoDef (T.DBind bind) = DBind $ monoBind bind
monoDef (T.DData d) = DData d monoDef (T.DData d) = DData d
monoBind :: T.Bind -> Bind monoBind :: T.Bind -> Bind
monoBind (T.Bind name args e) = Bind name args e monoBind (T.Bind name args (e, t)) = Bind name args (e, t)
monoExpr :: T.Exp -> 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.EAbs i expt -> error "BUG"
T.ECase expt injs -> ECase (monoexpt expt) (monoInjs injs)
monoType :: T.Type -> 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)
monoexpt :: T.ExpT -> ExpT
monoexpt (e, t) = (e, t)
monoId :: T.Id -> Id
monoId = id
monoLit :: T.Lit -> Lit
monoLit (T.LInt i) = LInt i
monoLit (T.LChar c) = LChar c
monoInjs = map monoInj
monoInj (T.Inj (init, t) expt) = Injection (monoInit init, monoType t) (monoexpt expt)
monoInit :: T.Init -> Init
monoInit = id

View file

@ -1,12 +1,9 @@
module Monomorphizer.MonomorphizerIr (module Monomorphizer.MonomorphizerIr, module RE1, module RE2) where module Monomorphizer.MonomorphizerIr (module Monomorphizer.MonomorphizerIr, module RE, module GA) where
import qualified Grammar.Abs as RE1 (Data (..), Ident (..), import Grammar.Abs (Data, Ident, Init)
Init (..)) import Grammar.Abs qualified as GA (Data, Ident, Init)
import qualified TypeChecker.TypeCheckerIr as RE2 (ExpT, Id, Indexed)
import Grammar.Abs (Data (..), Ident (..), Init (..))
import TypeChecker.TypeCheckerIr (ExpT, Id, Indexed) import TypeChecker.TypeCheckerIr (ExpT, Id, Indexed)
import TypeChecker.TypeCheckerIr qualified as RE (ExpT, Id, Indexed)
newtype Program = Program [Def] newtype Program = Program [Def]
deriving (Show, Ord, Eq) deriving (Show, Ord, Eq)
@ -20,10 +17,10 @@ data Bind = Bind Id [Id] ExpT
data Exp data Exp
= EId Ident = EId Ident
| ELit Lit | ELit Lit
| ELet Id ExpT ExpT | ELet Bind ExpT
| EApp Type ExpT ExpT | EApp ExpT ExpT
| EAdd Type ExpT ExpT | EAdd ExpT ExpT
| ECase Type ExpT [Injection] | ECase ExpT [Injection]
deriving (Show, Ord, Eq) deriving (Show, Ord, Eq)
data Injection = Injection (Init, Type) ExpT data Injection = Injection (Init, Type) ExpT
@ -37,5 +34,5 @@ data Lit
| LChar Char | LChar Char
deriving (Show, Ord, Eq) deriving (Show, Ord, Eq)
newtype Type = Type Ident data Type = TLit Ident | TFun Type Type
deriving (Show, Ord, Eq) deriving (Show, Ord, Eq)

View file

@ -1,6 +1,9 @@
{-# LANGUAGE LambdaCase #-} {-# LANGUAGE LambdaCase #-}
module TypeChecker.TypeCheckerIr where module TypeChecker.TypeCheckerIr (
module TypeChecker.TypeCheckerIr,
module GA,
) where
import Control.Monad.Except import Control.Monad.Except
import Control.Monad.Reader import Control.Monad.Reader
@ -13,6 +16,12 @@ import Grammar.Abs (
Init (..), Init (..),
Lit (..), Lit (..),
) )
import Grammar.Abs qualified as GA (
Data (..),
Ident (..),
Init (..),
Lit (..),
)
import Grammar.Print import Grammar.Print
import Prelude import Prelude
import Prelude qualified as C (Eq, Ord, Read, Show) import Prelude qualified as C (Eq, Ord, Read, Show)