Fixed printing bug in MorbIr, fixed Monomorphizer forgetting to output constructors on EInj

This commit is contained in:
Rakarake 2023-05-01 16:14:01 +02:00
parent 3377879dd0
commit 59da6d8864
3 changed files with 17 additions and 1 deletions

View file

@ -0,0 +1,12 @@
data Either (a b) where
Left : a -> Either (a b)
Right : b -> Either (a b)
unwrap : Either (a a) -> a
unwrap x = case x of
Left y => y
Right y => y
main : Int
main = unwrap (Left 3)

View file

@ -64,7 +64,7 @@ Binds, Polymorphic Data types (monomorphized in a later step) and
Marked bind, which means that it is in the process of monomorphization Marked bind, which means that it is in the process of monomorphization
and should not be monomorphized again. and should not be monomorphized again.
-} -}
data Outputted = Marked | Complete M.Bind | Data M.Type T.Data data Outputted = Marked | Complete M.Bind | Data M.Type T.Data deriving (Show)
-- | Static environment. -- | Static environment.
data Env = Env data Env = Env
@ -214,6 +214,7 @@ morphExp expectedType exp = case exp of
T.ELit lit -> return $ M.ELit (convertLit lit) T.ELit lit -> return $ M.ELit (convertLit lit)
-- Constructor -- Constructor
T.EInj ident -> do T.EInj ident -> do
morphCons expectedType ident
return $ M.EVar ident return $ M.EVar ident
T.EApp (e1, _t1) (e2, t2) -> do T.EApp (e1, _t1) (e2, t2) -> do
t2' <- getMonoFromPoly t2 t2' <- getMonoFromPoly t2
@ -234,6 +235,8 @@ morphExp expectedType exp = case exp of
bs' <- mapM morphBranch bs bs' <- mapM morphBranch bs
exp' <- morphExp t' exp exp' <- morphExp t' exp
return $ M.ECase (exp', t') (catMaybes bs') return $ M.ECase (exp', t') (catMaybes bs')
-- Ideally constructors should be EInj, though this code handles them
-- as well.
T.EVar ident -> do T.EVar ident -> do
isLocal <- localExists ident isLocal <- localExists ident
if isLocal if isLocal

View file

@ -175,6 +175,7 @@ instance Print Type where
prt i = \case prt i = \case
TLit uident -> prPrec i 1 (concatD [prt 0 uident]) TLit uident -> prPrec i 1 (concatD [prt 0 uident])
TFun type_1 type_2 -> prPrec i 0 (concatD [prt 1 type_1, doc (showString "->"), prt 0 type_2]) TFun type_1 type_2 -> prPrec i 0 (concatD [prt 1 type_1, doc (showString "->"), prt 0 type_2])
TData uident types -> prPrec i 1 (concatD [prt 0 uident, doc (showString "("), prt 0 types, doc (showString ")")])
instance Print Lit where instance Print Lit where
prt i = \case prt i = \case