From fabac72992d397942fd5712d49733424ccb9de56 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Fri, 3 Jul 2015 17:25:56 -0400 Subject: Fix a maddening bug in the comparator for Core constructors --- src/core_util.sml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/core_util.sml') diff --git a/src/core_util.sml b/src/core_util.sml index 152ba7ac..d098039a 100644 --- a/src/core_util.sml +++ b/src/core_util.sml @@ -203,7 +203,7 @@ fun compare ((c1, _), (c2, _)) = | (_, CConcat _) => GREATER | (CMap (d1, r1), CMap (d2, r2)) => - join (Kind.compare (d1, r2), + join (Kind.compare (d1, d2), fn () => Kind.compare (r1, r2)) | (CMap _, _) => LESS | (_, CMap _) => GREATER -- cgit v1.2.3 From 31044921b25e830707fb00ba57fd4ea6cf50c422 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sun, 5 Jul 2015 16:11:24 -0400 Subject: Add a missed case in CoreUtil.Exp fold --- src/core_util.sml | 20 ++++++++++++-------- 1 file changed, 12 insertions(+), 8 deletions(-) (limited to 'src/core_util.sml') diff --git a/src/core_util.sml b/src/core_util.sml index d098039a..9ca85c37 100644 --- a/src/core_util.sml +++ b/src/core_util.sml @@ -607,15 +607,19 @@ fun mapfoldB {kind = fk, con = fc, exp = fe, bind} = | ERel _ => S.return2 eAll | ENamed _ => S.return2 eAll | ECon (dk, pc, cs, NONE) => - S.map2 (ListUtil.mapfold (mfc ctx) cs, - fn cs' => - (ECon (dk, pc, cs', NONE), loc)) - | ECon (dk, n, cs, SOME e) => - S.bind2 (mfe ctx e, - fn e' => + S.bind2 (mfpc ctx pc, + fn pc' => S.map2 (ListUtil.mapfold (mfc ctx) cs, - fn cs' => - (ECon (dk, n, cs', SOME e'), loc))) + fn cs' => + (ECon (dk, pc', cs', NONE), loc))) + | ECon (dk, pc, cs, SOME e) => + S.bind2 (mfpc ctx pc, + fn pc' => + S.bind2 (mfe ctx e, + fn e' => + S.map2 (ListUtil.mapfold (mfc ctx) cs, + fn cs' => + (ECon (dk, pc', cs', SOME e'), loc)))) | EFfi _ => S.return2 eAll | EFfiApp (m, x, es) => S.map2 (ListUtil.mapfold (mfet ctx) es, -- cgit v1.2.3