Monomorphizer now outputs constructors that are matched on but not created
This commit is contained in:
parent
0ab13e5979
commit
c2bf6312f6
3 changed files with 19 additions and 5 deletions
11
sample-programs/mono-3.crf
Normal file
11
sample-programs/mono-3.crf
Normal file
|
|
@ -0,0 +1,11 @@
|
||||||
|
data Number() where
|
||||||
|
One: Number ()
|
||||||
|
Two: Number ()
|
||||||
|
|
||||||
|
numberToInt : Number () -> Int
|
||||||
|
numberToInt n = case n of
|
||||||
|
One => 1
|
||||||
|
Two => 2
|
||||||
|
|
||||||
|
main = numberToInt One
|
||||||
|
|
||||||
|
|
@ -237,22 +237,25 @@ morphBranch (T.Branch (p, pt) (e, et)) = do
|
||||||
pt' <- getMonoFromPoly pt
|
pt' <- getMonoFromPoly pt
|
||||||
et' <- getMonoFromPoly et
|
et' <- getMonoFromPoly et
|
||||||
env <- ask
|
env <- ask
|
||||||
(p', newLocals) <- morphPattern (locals env) p
|
(p', newLocals) <- morphPattern pt' (locals env) p
|
||||||
local (const env { locals = Set.union newLocals (locals env) }) $ do
|
local (const env { locals = Set.union newLocals (locals env) }) $ do
|
||||||
e' <- morphExp et' e
|
e' <- morphExp et' e
|
||||||
return $ M.Branch (p', pt') (e', et')
|
return $ M.Branch (p', pt') (e', et')
|
||||||
|
|
||||||
-- Morphs pattern (patter -> expression), gives the newly bound local variables.
|
-- Morphs pattern (patter -> expression), gives the newly bound local variables.
|
||||||
morphPattern :: Set.Set Ident -> T.Pattern -> EnvM (M.Pattern, Set.Set Ident)
|
morphPattern :: M.Type -> Set.Set Ident -> T.Pattern -> EnvM (M.Pattern, Set.Set Ident)
|
||||||
morphPattern ls = \case
|
morphPattern expectedType ls = \case
|
||||||
T.PVar (ident, t) -> do t' <- getMonoFromPoly t
|
T.PVar (ident, t) -> do t' <- getMonoFromPoly t
|
||||||
return (M.PVar (ident, t'), Set.insert ident ls)
|
return (M.PVar (ident, t'), Set.insert ident ls)
|
||||||
T.PLit (lit, t) -> do t' <- getMonoFromPoly t
|
T.PLit (lit, t) -> do t' <- getMonoFromPoly t
|
||||||
return (M.PLit (convertLit lit, t'), ls)
|
return (M.PLit (convertLit lit, t'), ls)
|
||||||
T.PCatch -> return (M.PCatch, ls)
|
T.PCatch -> return (M.PCatch, ls)
|
||||||
-- Constructor ident
|
-- Constructor ident
|
||||||
T.PEnum ident -> return (M.PEnum ident, ls)
|
T.PEnum ident -> do morphCons expectedType ident
|
||||||
T.PInj ident ps -> do pairs <- mapM (morphPattern ls) ps
|
return (M.PEnum ident, ls)
|
||||||
|
T.PInj ident ps -> do morphCons expectedType ident
|
||||||
|
let (M.TData tIdent ts) = expectedType
|
||||||
|
pairs <- mapM (\(pat, patT) -> morphPattern patT ls pat) (zip ps ts)
|
||||||
return (M.PInj ident (map fst pairs), Set.unions (map snd pairs))
|
return (M.PInj ident (map fst pairs), Set.unions (map snd pairs))
|
||||||
|
|
||||||
-- | Creates a new identifier for a function with an assigned type
|
-- | Creates a new identifier for a function with an assigned type
|
||||||
|
|
|
||||||
Loading…
Add table
Add a link
Reference in a new issue