Mercurial > urweb
changeset 69:8e9920db39f2
Corify cfold
author | Adam Chlipala <adamc@hcoop.net> |
---|---|
date | Thu, 26 Jun 2008 09:53:52 -0400 |
parents | c1e21ab42896 |
children | 2e0f3b21fb85 |
files | src/core.sml src/core_print.sml src/core_util.sml src/corify.sml src/monoize.sml |
diffstat | 5 files changed, 10 insertions(+), 1 deletions(-) [+] |
line wrap: on
line diff
--- a/src/core.sml Thu Jun 26 09:51:28 2008 -0400 +++ b/src/core.sml Thu Jun 26 09:53:52 2008 -0400 @@ -52,6 +52,7 @@ | CRecord of kind * (con * con) list | CConcat of con * con + | CFold of kind * kind withtype con = con' located
--- a/src/core_print.sml Thu Jun 26 09:51:28 2008 -0400 +++ b/src/core_print.sml Thu Jun 26 09:53:52 2008 -0400 @@ -134,6 +134,7 @@ string "++", space, p_con env c2]) + | CFold _ => string "fold" and p_con env = p_con' false env
--- a/src/core_util.sml Thu Jun 26 09:51:28 2008 -0400 +++ b/src/core_util.sml Thu Jun 26 09:53:52 2008 -0400 @@ -143,6 +143,12 @@ S.map2 (mfc ctx c2, fn c2' => (CConcat (c1', c2'), loc))) + | CFold (k1, k2) => + S.bind2 (mfk k1, + fn k1' => + S.map2 (mfk k2, + fn k2' => + (CFold (k1', k2'), loc))) in mfc end
--- a/src/corify.sml Thu Jun 26 09:51:28 2008 -0400 +++ b/src/corify.sml Thu Jun 26 09:53:52 2008 -0400 @@ -244,7 +244,7 @@ | L.CRecord (k, xcs) => (L'.CRecord (corifyKind k, map (fn (c1, c2) => (corifyCon st c1, corifyCon st c2)) xcs), loc) | L.CConcat (c1, c2) => (L'.CConcat (corifyCon st c1, corifyCon st c2), loc) - | L.CFold _ => raise Fail "Corify CFold" + | L.CFold (k1, k2) => (L'.CFold (corifyKind k1, corifyKind k2), loc) fun corifyExp st (e, loc) = case e of