From ec0933ffdd8171a037edb863b3130e532bbcb495 Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Mon, 30 Apr 2018 22:48:27 +0100 Subject: [PATCH] Clamp `adhoc-retract!` to not drop below zero. --- syndicate/bag.rkt | 6 ++++-- syndicate/dataspace.rkt | 10 ++++++---- 2 files changed, 10 insertions(+), 6 deletions(-) diff --git a/syndicate/bag.rkt b/syndicate/bag.rkt index 5be1d51..776317e 100644 --- a/syndicate/bag.rkt +++ b/syndicate/bag.rkt @@ -36,9 +36,11 @@ (begin (hash-set! b x new-count) (if (zero? old-count) 'absent->present 'present->present)))) -(define (bag-change b x delta) +(define (bag-change b x delta #:clamp? [clamp? #f]) (define old-count (bag-ref b x)) - (define new-count (+ old-count delta)) + (define new-count (if clamp? + (max 0 (+ old-count delta)) + (+ old-count delta))) (if (zero? new-count) (values (hash-remove b x) (if (zero? old-count) 'absent->absent 'present->absent)) diff --git a/syndicate/dataspace.rkt b/syndicate/dataspace.rkt index 46d920f..fa04d37 100644 --- a/syndicate/dataspace.rkt +++ b/syndicate/dataspace.rkt @@ -549,13 +549,15 @@ (define (adhoc-retract! ac assertion) (when (not (void? assertion)) - (define-values (new-assertions summary) (bag-change (actor-adhoc-assertions ac) assertion -1)) + (define-values (new-assertions summary) + (bag-change (actor-adhoc-assertions ac) assertion -1 #:clamp? #t)) (set-actor-adhoc-assertions! ac new-assertions) (match summary - ;; 'absent->absent and 'absent->present absurd (if the call to - ;; `adhoc-retract!` matches a previous `adhoc-assert!`) + ;; 'absent->present absurd (if the call to `adhoc-retract!` + ;; matches a previous `adhoc-assert!`) ['present->absent (retract! ac assertion)] - ['present->present (void)]))) + ['present->present (void)] + ['absent->absent (void)]))) ;; can happen if we're exploiting the clamping (define (adhoc-assert! ac assertion) (when (not (void? assertion))