;;; 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 (%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))