diff options
author | Thomas White <taw@physics.org> | 2022-07-10 16:46:55 +0200 |
---|---|---|
committer | Thomas White <taw@physics.org> | 2022-07-10 17:02:43 +0200 |
commit | bf3b24846ce01de46eb4ed2a454cd27b70d9f4ee (patch) | |
tree | 217370c337ca1fdf010a1e5afdca5dd52fa51bb1 /guile/starlet | |
parent | b2ffed93c6a40243ee7d284d237b6facabee8c4c (diff) |
Add "remove-fixture[s]-from-state!"
Diffstat (limited to 'guile/starlet')
-rw-r--r-- | guile/starlet/state.scm | 24 |
1 files changed, 23 insertions, 1 deletions
diff --git a/guile/starlet/state.scm b/guile/starlet/state.scm index 560df82..15b5d4e 100644 --- a/guile/starlet/state.scm +++ b/guile/starlet/state.scm @@ -58,7 +58,9 @@ atomically-overlay-state! update-state! add-update-hook! - state-empty?)) + state-empty? + remove-fixtures-from-state! + remove-fixture-from-state!)) ;; A "state" is an atomically-updating container for an immutable @@ -453,3 +455,23 @@ pre-existing contents." (hash-table-empty? (atomic-box-ref (get-ht-box st)))) + + +(define (remove-fixtures-from-state! st fixture-list) + (let ((new-ht (make-hash-table)) + (old-ht (atomic-box-ref (get-ht-box st)))) + (state-for-each + (lambda (fix attr val) + (unless (memq fix fixture-list) + (hash-set! new-ht (cons fix attr) val))) + st) + (if (eq? old-ht (atomic-box-compare-and-swap! + (get-ht-box st) + old-ht + new-ht)) + (run-hook (get-update-hook st) #f) + (remove-fixtures-from-state! st fixture-list)))) + + +(define (remove-fixture-from-state! st fix) + (remove-fixtures-from-state! st (list fix))) |