mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-24 04:15:36 +02:00
Code Activity

Add vhash-fold*' in (ice-9 vlist)'.

Browse source 
* module/ice-9/vlist.scm (%vhash-fold*): New inline procedure.
  (vhash-fold*, vhash-foldq*, vhash-foldv*): New procedures.

* test-suite/tests/vlist.test ("vhash")["vhash-fold*", "vhash-fold*
  tail", "vhash-fold* interleaved", "vhash-foldq* degenerate"]: New
  tests.

* doc/ref/api-compound.texi (VHashes): Add `vhash-fold*' & co.
This commit is contained in:
Ludovic Courtès 2010-07-20 10:27:38 +02:00
parent 442eaa681b
commit 927bf5e8cc
3 changed files with 123 additions and 7 deletions
Download patch file Download diff file Expand all files Collapse all files

43
test-suite/tests/vlist.test
View file

@ -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))
;;;
@ -300,4 +301,38 @@
(equal? (assq k alist)
(vhash-assoc k vh eq?))))
#t
keys)))))
keys))))
(pass-if "vhash-fold*"
(let* ((keys (make-list 10 'a))
(values (iota 10))
(vh (fold vhash-cons vlist-null keys values)))
(equal? (vhash-fold* cons '() 'a vh)
values)))
(pass-if "vhash-fold* tail"
(let* ((keys (make-list 100 'a))
(values (iota 100))
(vh (fold vhash-cons vlist-null keys values)))
(equal? (vhash-fold* cons '() 'a (vlist-drop vh 42))
(take values (- 100 42)))))
(pass-if "vhash-fold* 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* cons '() 'a vh)
(filter (cut > <> 0) values))))
(pass-if "vhash-foldq* 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-consq 'x 'x vh))
(vh2 (vlist-tail vh1)))
(vhash-consq k v vh2)))
vlist-null keys values)))
(equal? (vhash-foldq* cons '() 'a vh)
(filter (cut > <> 0) values)))))