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) (begin (hash-set! b x new-count)
(if (zero? old-count) 'absent->present 'present->present)))) (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 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) (if (zero? new-count)
(values (hash-remove b x) (values (hash-remove b x)
(if (zero? old-count) 'absent->absent 'present->absent)) (if (zero? old-count) 'absent->absent 'present->absent))

10
syndicate/dataspace.rkt
View File

@ -549,13 +549,15 @@
(define (adhoc-retract! ac assertion) (define (adhoc-retract! ac assertion)
(when (not (void? 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) (set-actor-adhoc-assertions! ac new-assertions)
(match summary (match summary
;; 'absent->absent and 'absent->present absurd (if the call to ;; 'absent->present absurd (if the call to `adhoc-retract!`
;; `adhoc-retract!` matches a previous `adhoc-assert!`) ;; matches a previous `adhoc-assert!`)
['present->absent (retract! ac assertion)] ['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) (define (adhoc-assert! ac assertion)
(when (not (void? assertion)) (when (not (void? assertion))