Conditional assertion

This commit is contained in:
Tony Garnock-Jones 2021-06-10 10:00:22 +02:00
parent 82648dc0da
commit 5ab375bc26
2 changed files with 15 additions and 4 deletions

View File

@ -2,13 +2,18 @@
;;; SPDX-License-Identifier: LGPL-3.0-or-later
;;; SPDX-FileCopyrightText: Copyright © 2021 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
(provide (for-syntax <name>
(provide (for-syntax <when>
<name>
<daemon?>))
(require (for-syntax racket/base))
(require (for-syntax syntax/parse))
(begin-for-syntax
(define-splicing-syntax-class <when>
(pattern (~seq #:when E))
(pattern (~seq) #:attr E #'#t))
(define-splicing-syntax-class <name>
(pattern (~seq #:name N))
(pattern (~seq) #:attr N #''?))

View File

@ -154,9 +154,15 @@
item-stx])))))]))
(define-event-expander assert
(syntax-rules ()
[(_ expr)
(turn-assert/dataflow! this-turn this-target (action () (->preserve expr)))]))
(lambda (stx)
(syntax-parse stx
[(_ condition:<when> expr)
#`(turn-assert/dataflow! this-turn
this-target
(action ()
(if condition.E
(->preserve expr)
(void))))])))
(define-event-expander stop-when
(syntax-rules ()