(during (know P) O ...) for internal knowledge
This commit is contained in:
parent
e6b733325c
commit
7462af708b
|
@ -523,14 +523,18 @@
|
||||||
|
|
||||||
(define-syntax (during stx)
|
(define-syntax (during stx)
|
||||||
(syntax-parse stx
|
(syntax-parse stx
|
||||||
[(_ P O ...)
|
#:literals (know)
|
||||||
(define E-stx (syntax/loc #'P (asserted P)))
|
[(_ (~or (~and K (know P)) P) O ...)
|
||||||
|
(define E-stx (quasisyntax/loc #'P #,(if (attribute K)
|
||||||
|
#'K
|
||||||
|
#'(asserted P))))
|
||||||
|
(define R-stx (if (attribute K) #'forget #'retracted))
|
||||||
(define-values (_proj _pat _bindings instantiated)
|
(define-values (_proj _pat _bindings instantiated)
|
||||||
(analyze-pattern E-stx #'P))
|
(analyze-pattern E-stx #'P))
|
||||||
(quasisyntax/loc stx
|
(quasisyntax/loc stx
|
||||||
(on #,E-stx
|
(on #,E-stx
|
||||||
(let ((p #,instantiated))
|
(let ((p #,instantiated))
|
||||||
(react (stop-when (retracted p))
|
(react (stop-when (#,R-stx p))
|
||||||
O ...))))]))
|
O ...))))]))
|
||||||
|
|
||||||
(define-syntax (during/spawn stx)
|
(define-syntax (during/spawn stx)
|
||||||
|
|
|
@ -41,10 +41,9 @@ balance = 8
|
||||||
(when (not (negative? new))
|
(when (not (negative? new))
|
||||||
(stop-current-facet))))))
|
(stop-current-facet))))))
|
||||||
|
|
||||||
(on (know (overdraft))
|
(during (know (overdraft))
|
||||||
(printf "know overdraft!\n"))
|
(on-start (printf "know overdraft!\n"))
|
||||||
(on (forget (overdraft))
|
(on-stop (printf "no longer in overdraft\n"))))
|
||||||
(printf "no longer in overdraft\n")))
|
|
||||||
|
|
||||||
(spawn
|
(spawn
|
||||||
(on (asserted (balance $v))
|
(on (asserted (balance $v))
|
||||||
|
|
Loading…
Reference in New Issue