;;; Copyright (C) 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 program. If not, see ;;; . ;;; Commentary: ;;; ;;; Properties are a lispy way to associate random info with random ;;; objects. Traditionally properties are implemented as an alist or a ;;; plist actually pertaining to the object in question. ;;; ;;; These "object properties" have the advantage that they can be ;;; associated with any object, even if the object has no plist. Object ;;; properties are good when you are extending pre-existing objects in ;;; unexpected ways. They also present a pleasing, uniform ;;; procedure-with-setter interface. But if you have a data type that ;;; always has properties, it's often still best to store those ;;; properties within the object itself. ;;; ;;; Code: (define-module (ice-9 object-properties) #:use-module (ice-9 weak-tables) ;; FIXME: Change to #:export when deprecated bindings removed. #:replace (make-object-property object-properties set-object-properties! object-property set-object-property!)) (define (make-object-property) ;; Weak tables are thread-safe. (let ((prop (make-weak-key-hash-table))) (make-procedure-with-setter (lambda (obj) (weak-key-hash-table-ref prop obj)) (lambda (obj val) (weak-key-hash-table-set! prop obj val))))) ;; FIXME: Deprecate these global properties. (define global-properties (make-weak-key-hash-table)) (define (object-properties obj) (weak-key-hash-table-ref global-properties obj #:default (lambda (k) '()))) (define (set-object-properties! obj props) (weak-key-hash-table-set! global-properties obj props)) (define (object-property obj key) (assq-ref (object-properties obj) key)) (define (set-object-property! obj key value) (set-object-properties! obj (assq-set! (object-properties obj) key value)))