From 5ab375bc2627deb292c61ecfa0cbcd5c9dae283b Mon Sep 17 00:00:00 2001
From: Tony Garnock-Jones <tonyg@leastfixedpoint.com>
Date: Thu, 10 Jun 2021 10:00:22 +0200
Subject: [PATCH] Conditional assertion

---
 syndicate/syntax-classes.rkt |  7 ++++++-
 syndicate/syntax.rkt         | 12 +++++++++---
 2 files changed, 15 insertions(+), 4 deletions(-)

diff --git a/syndicate/syntax-classes.rkt b/syndicate/syntax-classes.rkt
index cd11180..dcbb2a0 100644
--- a/syndicate/syntax-classes.rkt
+++ b/syndicate/syntax-classes.rkt
@@ -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 #''?))
diff --git a/syndicate/syntax.rkt b/syndicate/syntax.rkt
index 24ab6be..c37139e 100644
--- a/syndicate/syntax.rkt
+++ b/syndicate/syntax.rkt
@@ -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 ()