From 1bb7a7fa7af9157e4b6b04dfb46c2e0ddcf9cb45 Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Mon, 13 Jul 2015 11:01:43 +0200
Subject: [PATCH] Reorganizing of intset/intmap helper functions

* module/language/cps2/split-rec.scm (intmap-keys): Move to utils.
* module/language/cps2/utils.scm (trivial-intset): New function.
  (intmap-keys, invert-bijection, invert-partition): New functions.
---
 module/language/cps2/split-rec.scm |  4 ----
 module/language/cps2/utils.scm     | 30 ++++++++++++++++++++++++++++++
 2 files changed, 30 insertions(+), 4 deletions(-)

diff --git a/module/language/cps2/split-rec.scm b/module/language/cps2/split-rec.scm
index 763ede570..20cb516a2 100644
--- a/module/language/cps2/split-rec.scm
+++ b/module/language/cps2/split-rec.scm
@@ -105,10 +105,6 @@ references."
                                  (persistent-intset defs)))))))
   (visit-fun kfun))
 
-(define (intmap-keys map)
-  (persistent-intset
-   (intmap-fold (lambda (k v keys) (intset-add! keys k)) map empty-intset)))
-
 (define (compute-sorted-strongly-connected-components edges)
   (define nodes
     (intmap-keys edges))
diff --git a/module/language/cps2/utils.scm b/module/language/cps2/utils.scm
index d375925c9..e4ed47389 100644
--- a/module/language/cps2/utils.scm
+++ b/module/language/cps2/utils.scm
@@ -37,7 +37,10 @@
 
             ;; Various utilities.
             fold1 fold2
+            trivial-intset
             intmap-map
+            intmap-keys
+            invert-bijection invert-partition
             intset->intmap
             worklist-fold
             fixpoint
@@ -108,12 +111,39 @@
          (lambda (s0 s1)
            (lp l s0 s1)))))))
 
+(define (trivial-intset set)
+  "Returns the sole member of @var{set}, if @var{set} has exactly one
+member, or @code{#f} otherwise."
+  (let ((first (intset-next set)))
+    (and first
+         (not (intset-next set (1+ first)))
+         first)))
+
 (define (intmap-map proc map)
   (persistent-intmap
    (intmap-fold (lambda (k v out) (intmap-replace! out k (proc k v)))
                 map
                 map)))
 
+(define (intmap-keys map)
+  "Return an intset of the keys in @var{map}."
+  (persistent-intset
+   (intmap-fold (lambda (k v keys) (intset-add! keys k)) map empty-intset)))
+
+(define (invert-bijection map)
+  "Assuming the values of @var{map} are integers and are unique, compute
+a map in which each value maps to its key.  If the values are not
+unique, an error will be signalled."
+  (intmap-fold (lambda (k v out) (intmap-add out v k)) map empty-intmap))
+
+(define (invert-partition map)
+  "Assuming the values of @var{map} are disjoint intsets, compute a map
+in which each member of each set maps to its key.  If the values are not
+disjoint, an error will be signalled."
+  (intmap-fold (lambda (k v* out)
+                 (intset-fold (lambda (v out) (intmap-add out v k)) v* out))
+               map empty-intmap))
+
 (define (intset->intmap f set)
   (persistent-intmap
    (intset-fold (lambda (label preds)