syndicate-lang
/
syndicate-rkt
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Clamp `adhoc-retract!` to not drop below zero.

This commit is contained in:
Tony Garnock-Jones 2018-04-30 22:48:27 +01:00
parent 2575b71db4
commit ec0933ffdd
2 changed files with 10 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

6
syndicate/bag.rkt
View File

@ -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))

10
syndicate/dataspace.rkt
View File

@ -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))