# HG changeset patch # User Adam Chlipala # Date 1214488432 14400 # Node ID 8e9920db39f27db3962cd075c38e3bce3732a729 # Parent c1e21ab42896a540781d2de02ffbd13b33cfb289 Corify cfold diff -r c1e21ab42896 -r 8e9920db39f2 src/core.sml --- 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 diff -r c1e21ab42896 -r 8e9920db39f2 src/core_print.sml --- 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 diff -r c1e21ab42896 -r 8e9920db39f2 src/core_util.sml --- 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 diff -r c1e21ab42896 -r 8e9920db39f2 src/corify.sml --- 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 diff -r c1e21ab42896 -r 8e9920db39f2 src/monoize.sml --- a/src/monoize.sml Thu Jun 26 09:51:28 2008 -0400 +++ b/src/monoize.sml Thu Jun 26 09:53:52 2008 -0400 @@ -71,6 +71,7 @@ | L.CRecord _ => poly () | L.CConcat _ => poly () + | L.CFold _ => poly () end val dummyExp = (L'.EPrim (Prim.Int 0), E.dummySpan)