[Guile-commits] 01/09: Reorganizing of intset/intmap helper functions

[Andy Wingo]

wingo pushed a commit to branch master
in repository guile.

commit 1bb7a7fa7af9157e4b6b04dfb46c2e0ddcf9cb45
Author: Andy Wingo <address@hidden>
Date:   Mon Jul 13 11:01:43 2015 +0200

    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 763ede5..20cb516 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 d375925..e4ed473 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)