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

Add ephemeron tables

Browse source 
* libguile/ephemerons.h:
* libguile/ephemerons.c (scm_c_make_ephemeron):
(scm_c_ephemeron_key):
(scm_c_ephemeron_value):
(scm_c_ephemeron_mark_dead_x):
(scm_c_ephemeron_swap_x):
(scm_c_ephemeron_next): Add C ephemeron API.
(scm_make_ephemeron, scm_ephemeron_key, scm_ephemeron_value)
(scm_ephemeron_mark_dead_x): Dispatch to helpers above.
(scm_ephemeron_swap_x, scm_ephemeron_mark_dead_x): New Scheme-exposed
functions.
(scm_c_make_ephemeron_table):
(scm_c_ephemeron_table_length):
(scm_c_ephemeron_table_ref):
(scm_c_ephemeron_table_push_x):
(scm_c_ephemeron_table_try_push_x): New C API for tables of ephemerons.
(scm_ephemeron_table_length):
(scm_ephemeron_table_ref):
(scm_ephemeron_table_push_x):
(scm_ephemeron_table_try_push_x): New Scheme-exposed API.
(scm_c_ephemeron_hash_table_refq):
(scm_c_ephemeron_hash_table_setq_x):
(scm_c_ephemeron_hash_table_copy): New C API for use by internal weak
table users (dynamic states, etc).

* module/ice-9/ephemerons.scm: Add new Scheme API.

* libguile/evalext.c (scm_self_evaluating_p):
* libguile/goops.c (scm_class_of, %goops-early-init):
* libguile/print.c (iprin1):
* module/oop/goops.scm:
* libguile/scm.h (scm_tc7_ephemeron_table): Add new tc7 for ephemeron
tables.

* test-suite/tests/ephemerons.test ("ephemeron tables"): Add tests.
This commit is contained in:
Andy Wingo 2025-05-09 11:52:42 +02:00
parent 67dca3a1f5
commit 134c3be452
9 changed files with 405 additions and 27 deletions
Download patch file Download diff file Expand all files Collapse all files

34
test-suite/tests/ephemerons.test
View file

@ -44,8 +44,42 @@
(pass-if (ephemeron? e))
(pass-if (eq? x (ephemeron-key e)))
(pass-if-equal 100 (ephemeron-value e))
(pass-if-equal 100 (ephemeron-swap! e 'qux))
(pass-if-equal 'qux (ephemeron-value e))
(ephemeron-mark-dead! e)
(pass-if (ephemeron? e))
(pass-if-equal #f (ephemeron-key e))
(pass-if-equal #f (ephemeron-value e))))
(with-test-prefix "ephemeron tables"
(define et (make-ephemeron-table 47))
(pass-if (ephemeron-table? et))
(define keys (map list (iota 47)))
(for-each (lambda (idx)
(pass-if (not (ephemeron-table-ref et idx))))
(iota 47))
(for-each (lambda (idx key)
(ephemeron-table-push! et idx (make-ephemeron key #t)))
(iota 47) keys)
(for-each (lambda (idx)
(define head (ephemeron-table-ref et idx))
(pass-if (ephemeron? head))
(pass-if-equal (list idx) (ephemeron-key head))
(pass-if (ephemeron-value head))
(pass-if (not (ephemeron-next head))))
(iota 47))
(define prev (ephemeron-table-ref et 42))
(pass-if-equal prev
(ephemeron-table-try-push! et 42 (make-ephemeron 'hey 'qux) #f))
(pass-if-equal prev
(ephemeron-table-try-push! et 42 (make-ephemeron 'hey 'qux) prev))
(pass-if-equal 'hey (ephemeron-key (ephemeron-table-ref et 42)))
(pass-if-equal prev (ephemeron-next (ephemeron-table-ref et 42)))
(pass-if-equal (list 42)
(ephemeron-key (ephemeron-next (ephemeron-table-ref et 42))))
(pass-if (not (ephemeron-next (ephemeron-next (ephemeron-table-ref et 42))))))