Check whether avoiding delays maintains truth

This commit is contained in:
Tony Garnock-Jones 2015-04-24 17:30:51 -04:00
parent 7c77223255
commit e00f079871
1 changed files with 17 additions and 13 deletions

View File

@ -84,17 +84,21 @@
(define (after msec thunk)
(define id (gensym 'after))
(list
(spawn (lambda (e s) (and (message? e) (quit (thunk))))
(void)
(sub (timer-expired id ?)))
(message (set-timer id msec 'relative))))
(if (zero? msec)
(thunk)
(list
(spawn (lambda (e s) (and (message? e) (quit (thunk))))
(void)
(sub (timer-expired id ?)))
(message (set-timer id msec 'relative)))))
(after 1000 (lambda ()
(printf "----- Retracting\n")
(message `(retract (parent bob john)))))
(after 2000 (lambda ()
(printf "----- Asserting\n")
(list (insert-record `(parent bob mary))
(insert-record `(parent mary sue))
(insert-record `(parent sue john)))))
(define use-delays? #t)
(after (if use-delays? 1000 0) (lambda ()
(printf "----- Retracting\n")
(message `(retract (parent bob john)))))
(after (if use-delays? 2000 0) (lambda ()
(printf "----- Asserting\n")
(list (insert-record `(parent bob mary))
(insert-record `(parent mary sue))
(insert-record `(parent sue john)))))