From 887af944c67e3395679a750a205ef114234c61a0 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adamc@hcoop.net>
Date: Tue, 11 Nov 2008 19:20:37 -0500
Subject: Add CutMulti

---
 src/core_util.sml | 16 +++++++++++++++-
 1 file changed, 15 insertions(+), 1 deletion(-)

(limited to 'src/core_util.sml')

diff --git a/src/core_util.sml b/src/core_util.sml
index 38004f74..71efe16e 100644
--- a/src/core_util.sml
+++ b/src/core_util.sml
@@ -444,10 +444,16 @@ fun compare ((e1, _), (e2, _)) =
 
       | (ECut (e1, c1, _), ECut (e2, c2, _)) =>
         join (compare (e1, e2),
-              fn () => Con.compare (c1, c2))
+           fn () => Con.compare (c1, c2))
       | (ECut _, _) => LESS
       | (_, ECut _) => GREATER
 
+      | (ECutMulti (e1, c1, _), ECutMulti (e2, c2, _)) =>
+        join (compare (e1, e2),
+           fn () => Con.compare (c1, c2))
+      | (ECutMulti _, _) => LESS
+      | (_, ECutMulti _) => GREATER
+
       | (EFold _, EFold _) => EQUAL
       | (EFold _, _) => LESS
       | (_, EFold _) => GREATER
@@ -588,6 +594,14 @@ fun mapfoldB {kind = fk, con = fc, exp = fe, bind} =
                                              S.map2 (mfc ctx rest,
                                                   fn rest' =>
                                                      (ECut (e', c', {field = field', rest = rest'}), loc)))))
+              | ECutMulti (e, c, {rest}) =>
+                S.bind2 (mfe ctx e,
+                      fn e' =>
+                         S.bind2 (mfc ctx c,
+                              fn c' =>
+                                 S.map2 (mfc ctx rest,
+                                      fn rest' =>
+                                         (ECutMulti (e', c', {rest = rest'}), loc))))
               | EFold k =>
                 S.map2 (mfk k,
                          fn k' =>
-- 
cgit v1.2.3