mirror of
https://git.savannah.gnu.org/git/guile.git
synced 2025-06-06 20:20:20 +02:00
c63f9101f8
* module/ice-9/weak-vector.scm: New implementation, same interface. * doc/ref/api-memory.texi (Weak vectors): Default weak vector value was documented as empty list when it was actually unspecified, but #f is most useful, so we change documentation and code to match. * libguile/Makefile.am (libguile_@GUILE_EFFECTIVE_VERSION@_la_SOURCES): (DOT_X_FILES): (DOT_DOC_FILES): (noinst_HEADERS): (modinclude_HEADERS): * libguile.h: * libguile/deprecated.c: * libguile/deprecated.h: * libguile/init.c: * libguile/weak-vector.c: * libguile/weak-vector.h: Remove C weak vector implementation, replaced with deprecation stubs that call out to Scheme. * libguile/weak-set.c: * libguile/weak-table.c: * libguile/weak-list.h: Remove unused internal header. * libguile/eq.c: * libguile/evalext.c: * libguile/goops.c: * libguile/hash.c: * libguile/scm.h: * module/system/base/types.scm: * module/system/base/types/internal.scm: * module/system/vm/assembler.scm: Remove wvect tc7.
82 lines
2.4 KiB
Scheme
82 lines
2.4 KiB
Scheme
;;; installed-scm-file
|
||
|
||
;;;; Copyright (C) 2003, 2006, 2011, 2014, 2025 Free Software Foundation, Inc.
|
||
;;;;
|
||
;;;; This library is free software; you can redistribute it and/or
|
||
;;;; modify it under the terms of the GNU Lesser General Public
|
||
;;;; License as published by the Free Software Foundation; either
|
||
;;;; version 3 of the License, or (at your option) any later version.
|
||
;;;;
|
||
;;;; This library is distributed in the hope that it will be useful,
|
||
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
||
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
|
||
;;;; Lesser General Public License for more details.
|
||
;;;;
|
||
;;;; You should have received a copy of the GNU Lesser General Public
|
||
;;;; License along with this library; if not, write to the Free Software
|
||
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
|
||
;;;;
|
||
|
||
|
||
(define-module (ice-9 weak-vector)
|
||
#:use-module (ice-9 ephemerons)
|
||
#:use-module (ice-9 match)
|
||
#:use-module (srfi srfi-9)
|
||
#:export (make-weak-vector
|
||
list->weak-vector
|
||
weak-vector
|
||
weak-vector?
|
||
weak-vector-ref
|
||
weak-vector-set!))
|
||
|
||
(define (immediate? x)
|
||
(cond
|
||
((exact-integer? x) (<= most-negative-fixnum x most-positive-fixnum))
|
||
((char? x) #t)
|
||
((eq? x #f) #t)
|
||
((eq? x #nil) #t)
|
||
((eq? x '()) #t)
|
||
((eq? x #t) #t)
|
||
((unspecified? x) #t)
|
||
((eof-object? x) #t)
|
||
(else #f)))
|
||
|
||
(define-record-type <weak-vector>
|
||
(%make-weak-vector weaks)
|
||
weak-vector?
|
||
(weaks weak-vector-weaks))
|
||
|
||
(define* (make-weak-vector size #:optional (fill #f))
|
||
(let ((wv (%make-weak-vector (make-vector size #f))))
|
||
(let lp ((i 0))
|
||
(when (< i size)
|
||
(weak-vector-set! wv i fill)
|
||
(lp (1+ i))))
|
||
wv))
|
||
|
||
(define (make-weak val)
|
||
(if (immediate? val)
|
||
val
|
||
(make-ephemeron val #t)))
|
||
|
||
(define (weak-vector-set! wv idx val)
|
||
(vector-set! (weak-vector-weaks wv) idx (make-weak val))
|
||
(values))
|
||
|
||
(define (weak-vector-ref wv idx)
|
||
(let ((weak (vector-ref (weak-vector-weaks wv) idx)))
|
||
(if (ephemeron? weak)
|
||
(ephemeron-key weak)
|
||
weak)))
|
||
|
||
(define (list->weak-vector ls)
|
||
(let ((wv (make-weak-vector (length ls) #f)))
|
||
(let lp ((ls ls) (idx 0))
|
||
(match ls
|
||
(() wv)
|
||
((elt . ls)
|
||
(weak-vector-set! wv idx elt)
|
||
(lp ls (1+ idx)))))))
|
||
|
||
(define (weak-vector . elts)
|
||
(list->weak-vector elts))
|