summaryrefslogtreecommitdiff
path: root/module/ice-9/weak-vector.scm
diff options
context:
space:
mode:
Diffstat (limited to 'module/ice-9/weak-vector.scm')
-rw-r--r--module/ice-9/weak-vector.scm59
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))