From 5dec0afe390db169a3dee0fe14a0708b866aa9c5 Mon Sep 17 00:00:00 2001
From: Tony Garnock-Jones <tonyg@leastfixedpoint.com>
Date: Wed, 9 Jun 2021 23:05:51 +0200
Subject: [PATCH] syntax-classes.rkt

---
 syndicate/syntax-classes.rkt | 18 ++++++++++++++++++
 syndicate/syntax.rkt         | 25 +++++++++++++------------
 2 files changed, 31 insertions(+), 12 deletions(-)
 create mode 100644 syndicate/syntax-classes.rkt

diff --git a/syndicate/syntax-classes.rkt b/syndicate/syntax-classes.rkt
new file mode 100644
index 0000000..cd11180
--- /dev/null
+++ b/syndicate/syntax-classes.rkt
@@ -0,0 +1,18 @@
+#lang racket/base
+;;; SPDX-License-Identifier: LGPL-3.0-or-later
+;;; SPDX-FileCopyrightText: Copyright © 2021 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
+
+(provide (for-syntax <name>
+                     <daemon?>))
+
+(require (for-syntax racket/base))
+(require (for-syntax syntax/parse))
+
+(begin-for-syntax
+  (define-splicing-syntax-class <name>
+    (pattern (~seq #:name N))
+    (pattern (~seq) #:attr N #''?))
+
+  (define-splicing-syntax-class <daemon?>
+    (pattern (~seq #:daemon? D))
+    (pattern (~seq) #:attr D #'#f)))
diff --git a/syndicate/syntax.rkt b/syndicate/syntax.rkt
index bb39be9..1554de0 100644
--- a/syndicate/syntax.rkt
+++ b/syndicate/syntax.rkt
@@ -40,6 +40,7 @@
 (require racket/stxparam)
 (require (for-syntax racket/base))
 (require (for-syntax racket/syntax))
+(require (for-syntax syntax/parse))
 (require preserves-schema)
 
 (require "actor.rkt")
@@ -47,6 +48,7 @@
 
 (require "event-expander.rkt")
 (require "pattern.rkt")
+(require "syntax-classes.rkt")
 
 (define-syntax-parameter this-turn
   (lambda (stx)
@@ -68,12 +70,10 @@
   (lambda (turn . formals)
     (with-this-turn turn expr ...)))
 
-(define-syntax actor-system
-  (syntax-rules ()
-    [(_ #:name name expr ...)
-     (actor:actor-system #:name name (action () expr ...))]
-    [(_ expr ...)
-     (actor:actor-system (action () expr ...))]))
+(define-syntax (actor-system stx)
+  (syntax-parse stx
+    [(_ name:<name> expr ...)
+     #'(actor:actor-system #:name name.N (action () expr ...))]))
 
 (define-syntax-rule (with-fresh-turn expr ...)
   (turn-freshen this-turn (action () expr ...)))
@@ -107,12 +107,13 @@
 (define-syntax-rule (send! peer assertion)
   (turn-message! this-turn peer (->preserve assertion)))
 
-(define-syntax spawn
-  (syntax-rules ()
-    [(_ #:name name setup-expr ...)
-     (turn-spawn! #:name name this-turn (action () setup-expr ...))]
-    [(_ setup-expr ...)
-     (turn-spawn! this-turn (action () setup-expr ...))]))
+(define-syntax (spawn stx)
+  (syntax-parse stx
+    [(_ name:<name> daemon:<daemon?> setup-expr ...)
+     #'(turn-spawn! #:name name.N
+                    #:daemon? daemon.D
+                    this-turn
+                    (action () setup-expr ...))]))
 
 (define-syntax-rule (begin/dataflow expr ...)
   (turn-dataflow! this-turn (action () expr ...)))