Added some missing functionality to the dummy monomorphizer.
This commit is contained in:
parent
fc60112877
commit
30a79f34af
2 changed files with 18 additions and 2 deletions
|
|
@ -5,6 +5,7 @@ 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
|
||||
|
||||
|
|
@ -22,7 +23,7 @@ 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)
|
||||
monoData (T.Data (Indexed n _) cons) = M.Constructor n (map (\(Constructor n t) -> (n, monoAbsType t)) cons)
|
||||
|
||||
monoExpr :: T.Exp -> M.Exp
|
||||
monoExpr = \case
|
||||
|
|
@ -31,14 +32,24 @@ monoExpr = \case
|
|||
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.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) = 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)
|
||||
|
||||
|
||||
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) = M.TLit i
|
||||
monoType (T.TFun t1 t2) = M.TFun (monoType t1) (monoType t2)
|
||||
monoType (T.TIndexed _) = error "Not sure what this is"
|
||||
|
||||
monoexpt :: T.ExpT -> M.ExpT
|
||||
monoexpt (e, t) = (monoExpr e, monoType t)
|
||||
|
|
@ -58,3 +69,4 @@ monoInj (T.Inj (init, t) expt) = M.Injection (monoInit init, monoType t) (monoex
|
|||
|
||||
monoInit :: T.Init -> M.Init
|
||||
monoInit = id
|
||||
|
||||
|
|
|
|||
|
|
@ -40,3 +40,7 @@ data Lit
|
|||
|
||||
data Type = TLit Ident | TFun Type Type
|
||||
deriving (Show, Ord, Eq)
|
||||
|
||||
flattenType :: Type -> [Type]
|
||||
flattenType (TFun t1 t2) = t1 : flattenType t2
|
||||
flattenType x = [x]
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue