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

Fixed a segfault.

Browse source
This commit is contained in:
Samuel Hammersberg 2023-03-24 19:57:49 +01:00
parent f531afb3ab
commit 7e246a94e5
5 changed files with 82 additions and 76 deletions
Download patch file Download diff file Expand all files Collapse all files

43
src/Monomorphizer/Monomorphizer.hs
View file

@ -1,15 +1,14 @@
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
module Monomorphizer.Monomorphizer (monomorphize) where
import Data.Coerce (coerce)
import Grammar.Abs (Constructor (..), Ident (..))
import Unsafe.Coerce (unsafeCoerce)
import Data.Coerce (coerce)
import Grammar.Abs (Constructor (..), Ident (..))
import Grammar.Abs qualified as GA
import Monomorphizer.MonomorphizerIr qualified as M
import TypeChecker.TypeCheckerIr qualified as T
import qualified Grammar.Abs as GA
import qualified Monomorphizer.MonomorphizerIr as M
import qualified TypeChecker.TypeCheckerIr as T
monomorphize :: T.Program -> M.Program
monomorphize (T.Program ds) = M.Program $ monoDefs ds
@ -19,11 +18,14 @@ monoDefs = map monoDef
monoDef :: T.Def -> M.Def
monoDef (T.DBind bind) = M.DBind $ monoBind bind
monoDef (T.DData d) = M.DData $ unsafeCoerce d
monoDef (T.DData d) = M.DData $ monoData 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.Data
monoData (T.Data (T.Ident id) cs) = M.Data (M.TLit (Ident id)) []
monoExpr :: T.Exp -> M.Exp
monoExpr = \case
T.EId (T.Ident i) -> M.EId (Ident i)
@ -35,18 +37,18 @@ 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) = M.TLit "Int"
monoAbsType (GA.TLit u) = M.TLit (coerce u)
monoAbsType (GA.TVar _v) = M.TLit "Int"
monoAbsType (GA.TAll _v _t) = error "NOT ALL TYPES"
monoAbsType (GA.TEVar _v) = error "I DONT KNOW WHAT THIS IS"
monoAbsType (GA.TEVar _v) = error "I DONT KNOW WHAT THIS IS"
monoAbsType (GA.TFun t1 t2) = M.TFun (monoAbsType t1) (monoAbsType t2)
monoAbsType (GA.TData _ _) = error "NOT INDEXED TYPES"
monoAbsType (GA.TData _ _) = error "NOT INDEXED TYPES"
monoType :: T.Type -> M.Type
monoType (T.TAll _ t) = monoType t
monoType (T.TVar (T.MkTVar i)) = M.TLit "Int"
monoType (T.TLit (T.Ident i)) = M.TLit (Ident i)
monoType (T.TFun t1 t2) = M.TFun (monoType t1) (monoType t2)
monoType (T.TAll _ t) = monoType t
monoType (T.TVar (T.MkTVar i)) = M.TLit "Int"
monoType (T.TLit (T.Ident i)) = M.TLit (Ident i)
monoType (T.TFun t1 t2) = M.TFun (monoType t1) (monoType t2)
monoType (T.TData (T.Ident n) t) = M.TLit (Ident (n ++ concatMap show t))
monoexpt :: T.ExpT -> M.ExpT
@ -56,7 +58,7 @@ monoId :: T.Id -> M.Id
monoId (n, t) = (coerce 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.Branch] -> [M.Branch]
@ -66,7 +68,8 @@ monoInj :: T.Branch -> M.Branch
monoInj (T.Branch (init, t) expt) = M.Branch (monoInit init, monoType t) (monoexpt expt)
monoInit :: T.Pattern -> M.Pattern
monoInit (T.PVar (id, t)) = M.PVar (coerce id, monoType t)
monoInit (T.PVar (id, t)) = M.PVar (coerce id, monoType t)
monoInit (T.PLit (lit, t)) = M.PLit (monoLit lit, monoType t)
monoInit (T.PInj id ps) = M.PInj (coerce id) (monoInit <$> ps)
monoInit T.PCatch = M.PCatch
monoInit (T.PInj id ps) = M.PInj (coerce id) (monoInit <$> ps)
monoInit (T.PEnum id) = undefined
monoInit T.PCatch = M.PCatch

2
src/Monomorphizer/MonomorphizerIr.hs
View file

@ -35,7 +35,7 @@ data Branch = Branch (Pattern, Type) ExpT
type ExpT = (Exp, Type)
data Constructor = Constructor UIdent [(UIdent, Type)]
data Constructor = Constructor Ident [(Ident, Type)]
deriving (Show, Ord, Eq)
data Lit