diff options
Diffstat (limited to 'module/ice-9/weak-vector.scm')
-rw-r--r-- | module/ice-9/weak-vector.scm | 59 |
1 files changed, 55 insertions, 4 deletions
diff --git a/module/ice-9/weak-vector.scm b/module/ice-9/weak-vector.scm index 0df8e1a45..5a89e6831 100644 --- a/module/ice-9/weak-vector.scm +++ b/module/ice-9/weak-vector.scm @@ -1,6 +1,6 @@ ;;; installed-scm-file -;;;; Copyright (C) 2003, 2006, 2011, 2014 Free Software Foundation, Inc. +;;;; 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 @@ -19,6 +19,9 @@ (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 @@ -26,6 +29,54 @@ weak-vector-ref weak-vector-set!)) -(eval-when (load eval compile) - (load-extension (string-append "libguile-" (effective-version)) - "scm_init_weak_vector_builtins")) +(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)) |