Mercurial > urweb
diff src/monoize.sml @ 182:d11754ffe252
Compiled pattern matching to C
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Sun, 03 Aug 2008 12:43:20 -0400 |
parents | 3bbed533fbd2 |
children | c0ea24dcb86f |
line wrap: on
line diff
--- a/src/monoize.sml Sun Aug 03 11:17:33 2008 -0400 +++ b/src/monoize.sml Sun Aug 03 12:43:20 2008 -0400 @@ -212,10 +212,10 @@ fm) | SOME t => let - val (arg, fm) = fooify fm ((L'.ERel 0, loc), - monoType env t) + val t = monoType env t + val (arg, fm) = fooify fm ((L'.ERel 0, loc), t) in - (((L'.PCon (L'.PConVar n, SOME (L'.PVar "a", loc)), loc), + (((L'.PCon (L'.PConVar n, SOME (L'.PVar ("a", t), loc)), loc), (L'.EStrcat ((L'.EPrim (Prim.String (x ^ "/")), loc), arg), loc)), fm) @@ -233,7 +233,8 @@ ran, (L'.ECase ((L'.ERel 0, loc), branches, - ran), loc)), loc), + {disc = dom, + result = ran}), loc)), loc), "")], loc), fm) end @@ -284,13 +285,13 @@ L.PConVar n => L'.PConVar n | L.PConFfi mx => L'.PConFfi mx -fun monoPat (p, loc) = +fun monoPat env (p, loc) = case p of L.PWild => (L'.PWild, loc) - | L.PVar x => (L'.PVar x, loc) + | L.PVar (x, t) => (L'.PVar (x, monoType env t), loc) | L.PPrim p => (L'.PPrim p, loc) - | L.PCon (pc, po) => (L'.PCon (monoPatCon pc, Option.map monoPat po), loc) - | L.PRecord xps => (L'.PRecord (map (fn (x, p) => (x, monoPat p)) xps), loc) + | L.PCon (pc, po) => (L'.PCon (monoPatCon pc, Option.map (monoPat env) po), loc) + | L.PRecord xps => (L'.PRecord (map (fn (x, p, t) => (x, monoPat env p, monoType env t)) xps), loc) fun monoExp (env, st, fm) (all as (e, loc)) = let @@ -667,7 +668,7 @@ | L.ECut _ => poly () | L.EFold _ => poly () - | L.ECase (e, pes, t) => + | L.ECase (e, pes, {disc, result}) => let val (e, fm) = monoExp (env, st, fm) e val (pes, fm) = ListUtil.foldlMap @@ -675,10 +676,10 @@ let val (e, fm) = monoExp (env, st, fm) e in - ((monoPat p, e), fm) + ((monoPat env p, e), fm) end) fm pes in - ((L'.ECase (e, pes, monoType env t), loc), fm) + ((L'.ECase (e, pes, {disc = monoType env disc, result = monoType env result}), loc), fm) end | L.EWrite e =>