diff --git a/src/Codegen/Codegen.hs b/src/Codegen/Codegen.hs index 4e95102..ec20273 100644 --- a/src/Codegen/Codegen.hs +++ b/src/Codegen/Codegen.hs @@ -317,7 +317,7 @@ compileExp (MIR.ECase e cs,t) = emitECased t e (map (t,) cs) -- go (EMod e1 e2) = emitMod e1 e2 --- aux functions --- -emitECased :: MIR.Type -> ExpT -> [(MIR.Type, Injection)] -> CompilerState () +emitECased :: MIR.Type -> ExpT -> [(MIR.Type, Branch)] -> CompilerState () emitECased t e cases = do let cs = snd <$> cases let ty = type2LlvmType t @@ -332,8 +332,8 @@ emitECased t e cases = do res <- getNewVar emit $ SetVariable res (Load ty Ptr stackPtr) where - emitCases :: LLVMType -> LLVMType -> GA.Ident -> GA.Ident -> LLVMValue -> Injection -> CompilerState () - emitCases rt ty label stackPtr vs (Injection (MIR.InitConstructor consId cs, t) exp) = do + emitCases :: LLVMType -> LLVMType -> GA.Ident -> GA.Ident -> LLVMValue -> Branch -> CompilerState () + emitCases rt ty label stackPtr vs (Branch (MIR.PInj consId cs, t) exp) = do cons <- gets constructors let r = fromJust $ Map.lookup (coerce consId, t) cons @@ -380,10 +380,10 @@ emitECased t e cases = do -- emit $ Store ty val Ptr stackPtr emit $ Br label emit $ Label lbl_failPos - emitCases rt ty label stackPtr vs (Injection (MIR.InitLit i, _) exp) = do + emitCases rt ty label stackPtr vs (Branch (MIR.PLit i, _) exp) = do let i' = case i of - GA.LInt i -> VInteger i - GA.LChar i -> VChar i + (MIR.LInt i, _) -> VInteger i + (MIR.LChar i, _) -> VChar i ns <- getNewVar lbl_failPos <- (\x -> GA.Ident $ "failed_" <> show x) <$> getNewLabel lbl_succPos <- (\x -> GA.Ident $ "success_" <> show x) <$> getNewLabel @@ -404,7 +404,7 @@ emitECased t e cases = do -- val <- exprToValue (fst exp) -- emit $ Store ty val Ptr stackPtr -- emit $ Br label - emitCases _ ty label stackPtr _ (Injection (MIR.InitCatch, _) exp) = do + emitCases _ ty label stackPtr _ (Branch (MIR.PCatch, _) exp) = do val <- exprToValue exp emit $ Store ty val Ptr stackPtr emit $ Br label diff --git a/src/Monomorphizer/Monomorphizer.hs b/src/Monomorphizer/Monomorphizer.hs index a4b92e1..70483ad 100644 --- a/src/Monomorphizer/Monomorphizer.hs +++ b/src/Monomorphizer/Monomorphizer.hs @@ -25,7 +25,7 @@ monoBind (T.Bind name args (e, t)) = M.Bind (monoId name) (map monoId args) (mon monoExpr :: T.Exp -> M.Exp monoExpr = \case - T.EId (Ident i) -> M.EId (Ident i) + T.EId (T.Ident i) -> M.EId (Ident i) T.ELit lit -> M.ELit $ monoLit lit T.ELet bind expt -> M.ELet (monoBind bind) (monoexpt expt) T.EApp expt1 expt2 -> M.EApp (monoexpt expt1) (monoexpt expt2) @@ -44,7 +44,7 @@ monoAbsType (GA.TIndexed _) = error "NOT INDEXED TYPES" 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.TLit (T.Ident i)) = M.TLit (Ident i) monoType (T.TFun t1 t2) = M.TFun (monoType t1) (monoType t2) monoType (T.TData _ _) = error "Not sure what this is" @@ -52,17 +52,20 @@ 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) = (coerce n, monoType t) monoLit :: T.Lit -> M.Lit monoLit (T.LInt i) = M.LInt i monoLit (T.LChar c) = M.LChar c -monoInjs :: [T.Inj] -> [M.Injection] +monoInjs :: [T.Branch] -> [M.Branch] monoInjs = map monoInj -monoInj :: T.Inj -> M.Injection -monoInj (T.Inj (init, t) expt) = M.Injection (monoInit init, monoType t) (monoexpt expt) +monoInj :: T.Branch -> M.Branch +monoInj (T.Branch (init, t) expt) = M.Branch (monoInit init, monoType t) (monoexpt expt) -monoInit :: T.Init -> M.Init -monoInit = id +monoInit :: T.Pattern -> M.Pattern +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 diff --git a/src/Monomorphizer/MonomorphizerIr.hs b/src/Monomorphizer/MonomorphizerIr.hs index 4d71363..e4c4bad 100644 --- a/src/Monomorphizer/MonomorphizerIr.hs +++ b/src/Monomorphizer/MonomorphizerIr.hs @@ -24,10 +24,13 @@ data Exp | ELet Bind ExpT | EApp ExpT ExpT | EAdd ExpT ExpT - | ECase ExpT [Injection] + | ECase ExpT [Branch] deriving (Show, Ord, Eq) -data Injection = Injection (Init, Type) ExpT +data Pattern = PVar Id | PLit (Lit, Type) | PInj Ident [Pattern] | PCatch + deriving (Eq, Ord, Show) + +data Branch = Branch (Pattern, Type) ExpT deriving (Eq, Ord, Show) type ExpT = (Exp, Type)