# HG changeset patch # User Adam Chlipala # Date 1214488288 14400 # Node ID c1e21ab42896a540781d2de02ffbd13b33cfb289 # Parent 9f89f0b00b842d0fb3458699f24b8b619f3b1bc4 Explify cfold diff -r 9f89f0b00b84 -r c1e21ab42896 src/corify.sml --- a/src/corify.sml Thu Jun 26 09:48:54 2008 -0400 +++ b/src/corify.sml Thu Jun 26 09:51:28 2008 -0400 @@ -244,6 +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" fun corifyExp st (e, loc) = case e of diff -r 9f89f0b00b84 -r c1e21ab42896 src/expl.sml --- a/src/expl.sml Thu Jun 26 09:48:54 2008 -0400 +++ b/src/expl.sml Thu Jun 26 09:51:28 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 9f89f0b00b84 -r c1e21ab42896 src/expl_print.sml --- a/src/expl_print.sml Thu Jun 26 09:48:54 2008 -0400 +++ b/src/expl_print.sml Thu Jun 26 09:51:28 2008 -0400 @@ -143,6 +143,7 @@ string "++", space, p_con env c2]) + | CFold _ => string "fold" and p_con env = p_con' false env diff -r 9f89f0b00b84 -r c1e21ab42896 src/expl_util.sml --- a/src/expl_util.sml Thu Jun 26 09:48:54 2008 -0400 +++ b/src/expl_util.sml Thu Jun 26 09:51:28 2008 -0400 @@ -138,6 +138,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 9f89f0b00b84 -r c1e21ab42896 src/explify.sml --- a/src/explify.sml Thu Jun 26 09:48:54 2008 -0400 +++ b/src/explify.sml Thu Jun 26 09:51:28 2008 -0400 @@ -59,7 +59,7 @@ | L.CRecord (k, xcs) => (L'.CRecord (explifyKind k, map (fn (c1, c2) => (explifyCon c1, explifyCon c2)) xcs), loc) | L.CConcat (c1, c2) => (L'.CConcat (explifyCon c1, explifyCon c2), loc) - | L.CFold _ => raise Fail "Explify CFold" + | L.CFold (dom, ran) => (L'.CFold (explifyKind dom, explifyKind ran), loc) | L.CError => raise Fail ("explifyCon: CError at " ^ EM.spanToString loc) | L.CUnif (_, _, ref (SOME c)) => explifyCon c