Multi-assert!/retract! for adhoc assertions

This commit is contained in:
Tony Garnock-Jones 2018-05-01 20:58:26 +01:00
parent e43054a6bd
commit 896cfe2498
2 changed files with 9 additions and 8 deletions

View File

@ -547,10 +547,10 @@
(when (not (void? assertion))
(bag-change! (ensure-patch-action! ac) assertion +1)))
(define (adhoc-retract! ac assertion)
(define (adhoc-retract! ac assertion [count 1])
(when (not (void? assertion))
(define-values (new-assertions summary)
(bag-change (actor-adhoc-assertions ac) assertion -1 #:clamp? #t))
(bag-change (actor-adhoc-assertions ac) assertion (- count) #:clamp? #t))
(set-actor-adhoc-assertions! ac new-assertions)
(match summary
;; 'absent->present absurd (if the call to `adhoc-retract!`
@ -559,9 +559,10 @@
['present->present (void)]
['absent->absent (void)]))) ;; can happen if we're exploiting the clamping
(define (adhoc-assert! ac assertion)
(define (adhoc-assert! ac assertion [count 1])
(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 count))
(set-actor-adhoc-assertions! ac new-assertions)
(match summary
;; 'absent->absent and 'present->absent absurd (assuming there

View File

@ -599,13 +599,13 @@
(until (message ack)
(on-start (send! ack))))
(define (assert! a)
(define (assert! a [count 1])
(ensure-in-script! 'assert!)
(adhoc-assert! (current-actor) a))
(adhoc-assert! (current-actor) a count))
(define (retract! a)
(define (retract! a [count 1])
(ensure-in-script! 'retract!)
(adhoc-retract! (current-actor) a))
(adhoc-retract! (current-actor) a count))
(define (current-adhoc-assertions)
(actor-adhoc-assertions (current-actor)))