1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-10 14:00:21 +02:00

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.
This commit is contained in:
Andy Wingo 2015-07-13 11:01:43 +02:00
parent dbe6247acf
commit 1bb7a7fa7a
2 changed files with 30 additions and 4 deletions

View file

@ -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))

View file

@ -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)