Changing the signature of ‘vhash-assoc’

Changing the signature of ‘vhash-assoc’

[Ludovic Courtès]

[-- Attachment #1.1: Type: text/plain, Size: 1140 bytes --]

Hello,

I wanted to access all the values associated with a key in a “vhash”.
To do that, I started implementing ‘vhash-fold-matches’ (attached), with
the vague feeling of piling feature on top of feature.

Indeed, if ‘vhash-assoc’ et al. are changed to return a vhash instead of
a pair, then we have all that’s needed to do that:

  (define (vhash-fold-matches proc init key vh)
    (let loop ((vh     vh)
               (result init))
      (let ((match (vhash-assoc key vh)))
        (if (vlist-null? match)
            result
            (loop (vlist-tail match)
                  (vlist-head match))))))

Thus I’m planning to make that change.  [The ‘vhash-fold-matches’ above
conses at each match whereas the attached one doesn’t, but that’s OK.]

However, it’s an incompatible change.  Instead of writing:

  (define first-value (and=> (vhash-assoc key vh) cdr))

one will have to write:

  (define first-value
    (let ((match (vhash-assoc key vh)))
      (if (vlist-null? match)
          #f
          (vlist-head match))))

Comments?  Objections?

Thanks,
Ludo’.


[-- Attachment #1.2: Type: application/pgp-signature, Size: 197 bytes --]

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: dumb vhash-fold-matches --]
[-- Type: text/x-patch, Size: 5096 bytes --]

diff --git a/module/ice-9/vlist.scm b/module/ice-9/vlist.scm
index 0c92976..4b32302 100644
--- a/module/ice-9/vlist.scm
+++ b/module/ice-9/vlist.scm
@@ -30,6 +30,7 @@
             block-growth-factor
 
             vhash? vhash-cons vhash-consq vhash-consv
+            vhash-fold-matches
             vhash-assoc vhash-assq vhash-assv
             vhash-delete vhash-fold alist->vhash))
 
@@ -408,8 +409,48 @@ with @var{value}.  Use @var{hash} to compute @var{key}'s hash."
 (define vhash-consq (cut vhash-cons <> <> <> hashq))
 (define vhash-consv (cut vhash-cons <> <> <> hashv))
 
-;; This hack to make sure `vhash-assq' gets to use the `eq?' instruction instead
-;; of calling the `eq?' subr.
+(define* (vhash-fold-matches proc init key vhash
+                             #:optional (equal? equal?) (hash hash))
+  "Fold over all the values associated with KEY in VHASH, with each call to PROC
+having the form `(PROC VALUE RESULT)', where RESULT is the result of the
+previous call to PROC and INIT the value of RESULT for the first call to PROC."
+  (define khash
+    (let ((size (block-size (vlist-base vhash))))
+      (and (> size 0) (hash key size))))
+
+  (let loop ((base       (vlist-base vhash))
+             (khash      khash)
+             (offset     (and khash
+                              (block-hash-table-ref (vlist-base vhash)
+                                                    khash)))
+             (max-offset (vlist-offset vhash))
+             (result     init))
+
+    (let ((answer (and offset (block-ref base offset))))
+      (cond ((and (pair? answer)
+                  (<= offset max-offset)
+                  (let ((answer-key (caar answer)))
+                    (equal? key answer-key)))
+             (let ((result      (proc (cdar answer) result))
+                   (next-offset (cdr answer)))
+               (loop base khash next-offset max-offset result)))
+            ((and (pair? answer) (cdr answer))
+             =>
+             (lambda (next-offset)
+               (loop base khash next-offset max-offset result)))
+            (else
+             (let ((next-base (block-base base)))
+               (if (and next-base (> (block-size next-base) 0))
+                   (let* ((khash  (hash key (block-size next-base)))
+                          (offset (block-hash-table-ref next-base khash)))
+                     (loop next-base khash offset (block-offset base)
+                           result))
+                   result)))))))
+
+;; A specialization of `vhash-fold-matches' that stops when the first value
+;; associated with KEY is found or when the end-of-list is reached.  Inline to
+;; make sure `vhash-assq' gets to use the `eq?' instruction instead of calling
+;; the `eq?' subr.
 (define-inline (%vhash-assoc key vhash equal? hash)
   (define khash
     (let ((size (block-size (vlist-base vhash))))
diff --git a/test-suite/tests/vlist.test b/test-suite/tests/vlist.test
index 47e386e..94ae1f4 100644
--- a/test-suite/tests/vlist.test
+++ b/test-suite/tests/vlist.test
@@ -19,9 +19,10 @@
 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (test-vlist)
-  :use-module (test-suite lib)
-  :use-module (ice-9 vlist)
-  :use-module (srfi srfi-1))
+  #:use-module (test-suite lib)
+  #:use-module (ice-9 vlist)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-26))
 
 \f
 ;;;
@@ -300,4 +301,38 @@
                         (equal? (assq k alist)
                                 (vhash-assoc k vh eq?))))
                  #t
-                 keys)))))
+                 keys))))
+
+  (pass-if "vhash-fold-matches"
+    (let* ((keys   (make-list 10 'a))
+           (values (iota 10))
+           (vh     (fold vhash-cons vlist-null keys values)))
+      (equal? (vhash-fold-matches cons '() 'a vh)
+              values)))
+
+  (pass-if "vhash-fold-matches tail"
+    (let* ((keys   (make-list 100 'a))
+           (values (iota 100))
+           (vh     (fold vhash-cons vlist-null keys values)))
+      (equal? (vhash-fold-matches cons '() 'a (vlist-drop vh 42))
+              (take values (- 100 42)))))
+
+  (pass-if "vhash-fold-matches interleaved"
+    (let* ((keys   '(a b a b a b a b a b c d e a b))
+           (values '(1 0 2 0 3 0 4 0 5 0 0 0 0 6 0))
+           (vh     (fold vhash-cons vlist-null keys values)))
+      (equal? (vhash-fold-matches cons '() 'a vh)
+              (filter (cut > <> 0) values))))
+
+  (pass-if "vhash-fold-matches degenerate"
+    (let* ((keys   '(a b a b a a a b a b a a a z))
+           (values '(1 0 2 0 3 4 5 0 6 0 7 8 9 0))
+           (vh     (fold (lambda (k v vh)
+                           ;; Degenerate case where VH2 contains only
+                           ;; 1-element blocks.
+                           (let* ((vh1 (vhash-cons 'x 'x vh))
+                                  (vh2 (vlist-tail vh1)))
+                             (vhash-cons k v vh2)))
+                         vlist-null keys values)))
+      (equal? (vhash-fold-matches cons '() 'a vh)
+              (filter (cut > <> 0) values)))))

Re: Changing the signature of ‘vhash-assoc’

[Andy Wingo]

On Tue 13 Jul 2010 19:16, ludo@gnu.org (Ludovic Courtès) writes:

> ‘vhash-assoc’ et al. are changed to return a vhash instead of a pair

Fine with me!

A
-- 
http://wingolog.org/

Re: Changing the signature of ‘vhash-assoc’

[Ludovic Courtès]

Hello,

I already changed my mind...  :-)

ludo@gnu.org (Ludovic Courtès) writes:

> Indeed, if ‘vhash-assoc’ et al. are changed to return a vhash instead of
> a pair, then we have all that’s needed to do that:

[...]

> Thus I’m planning to make that change.  [The ‘vhash-fold-matches’ above
> conses at each match whereas the attached one doesn’t, but that’s OK.]

Thinking more about it, I think I’d rather keep ‘vhash-assoc’ & co. as
they are, and add ‘vhash-assoc*’ & co., which would return a vhash.

This is so that ‘vhash-assoc’ keeps the overhead minimal for the common
pattern where only one value is associated with a key.  Also,
‘vhash-assoc’ is a drop-in replacement for SRFI-1 ‘assoc’, which is
probably worth keeping.

Thanks,
Ludo’.

Re: Changing the signature of ‘vhash-assoc’

[Ludovic Courtès]

Hello!

ludo@gnu.org (Ludovic Courtès) writes:

> I already changed my mind...  :-)

At the risk of looking silly, I changed again.

> ludo@gnu.org (Ludovic Courtès) writes:
>
>> Indeed, if ‘vhash-assoc’ et al. are changed to return a vhash instead of
>> a pair, then we have all that’s needed to do that:
>
> [...]
>
>> Thus I’m planning to make that change.  [The ‘vhash-fold-matches’ above
>> conses at each match whereas the attached one doesn’t, but that’s OK.]
>
> Thinking more about it, I think I’d rather keep ‘vhash-assoc’ & co. as
> they are, and add ‘vhash-assoc*’ & co., which would return a vhash.

Commit 927bf5e8cc0af9515797ebab6d9ba162bef23c2a is roughly the original
patch.

  http://git.savannah.gnu.org/cgit/guile.git/commit/?id=927bf5e8cc0af9515797ebab6d9ba162bef23c2a

I still think that ‘vhash-assoc*’ could/should be added eventually, but
it’s only useful for programs willing to access only *some* of the
values associated with a given key, which I expect to be uncommon.

Accessing the first value associated with a key (‘vhash-assoc’) or all
the values associated with a key (the new ‘vhash-fold*’) seems more
common.

Thanks,
Ludo’.

Re: Changing the signature of ‘vhash-assoc’

[Andy Wingo]

Hi,

On Wed 21 Jul 2010 01:17, ludo@gnu.org (Ludovic Courtès) writes:

>>> Indeed, if ‘vhash-assoc’ et al. are changed to return a vhash instead of
>>> a pair
>>
>> Thinking more about it, I think I’d rather keep ‘vhash-assoc’ & co. as
>> they are, and add ‘vhash-assoc*’ & co., which would return a vhash.
>
> Commit 927bf5e8cc0af9515797ebab6d9ba162bef23c2a is roughly the original
> patch.

Doesn't that impose an allocation penalty on vhash-assoc?

A
-- 
http://wingolog.org/

Re: Changing the signature of ‘vhash-assoc’

[Ludovic Courtès]

Hi,

Andy Wingo <wingo@pobox.com> writes:

> On Wed 21 Jul 2010 01:17, ludo@gnu.org (Ludovic Courtès) writes:
>
>>>> Indeed, if ‘vhash-assoc’ et al. are changed to return a vhash instead of
>>>> a pair
>>>
>>> Thinking more about it, I think I’d rather keep ‘vhash-assoc’ & co. as
>>> they are, and add ‘vhash-assoc*’ & co., which would return a vhash.
>>
>> Commit 927bf5e8cc0af9515797ebab6d9ba162bef23c2a is roughly the original
>> patch.
>
> Doesn't that impose an allocation penalty on vhash-assoc?

No, it remains as before.  The new ‘vhash-fold*’ does not allocate
either.

Thanks,
Ludo’.