Multi-assert!/retract! for adhoc assertions
This commit is contained in:
parent
e43054a6bd
commit
896cfe2498
|
@ -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
|
||||
|
|
|
@ -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)))
|
||||
|
|
Loading…
Reference in New Issue