syndicate-lang
/
syndicate-rkt
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

syntax-classes.rkt

This commit is contained in:
Tony Garnock-Jones 2021-06-09 23:05:51 +02:00
parent 52362a9183
commit 5dec0afe39
2 changed files with 31 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

18
syndicate/syntax-classes.rkt Normal file
View File

@ -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)))

25
syndicate/syntax.rkt
View File

@ -40,6 +40,7 @@
(require racket/stxparam) (require racket/stxparam)
(require (for-syntax racket/base)) (require (for-syntax racket/base))
(require (for-syntax racket/syntax)) (require (for-syntax racket/syntax))
(require (for-syntax syntax/parse))
(require preserves-schema) (require preserves-schema)
(require "actor.rkt") (require "actor.rkt")
@ -47,6 +48,7 @@
(require "event-expander.rkt") (require "event-expander.rkt")
(require "pattern.rkt") (require "pattern.rkt")
(require "syntax-classes.rkt")
(define-syntax-parameter this-turn (define-syntax-parameter this-turn
(lambda (stx) (lambda (stx)
@ -68,12 +70,10 @@
(lambda (turn . formals) (lambda (turn . formals)
(with-this-turn turn expr ...))) (with-this-turn turn expr ...)))
(define-syntax actor-system (define-syntax (actor-system stx)
(syntax-rules () (syntax-parse stx
[(_ #:name name expr ...) [(_ name:<name> expr ...)
(actor:actor-system #:name name (action () expr ...))] #'(actor:actor-system #:name name.N (action () expr ...))]))
[(_ expr ...)
(actor:actor-system (action () expr ...))]))
(define-syntax-rule (with-fresh-turn expr ...) (define-syntax-rule (with-fresh-turn expr ...)
(turn-freshen this-turn (action () expr ...))) (turn-freshen this-turn (action () expr ...)))
@ -107,12 +107,13 @@
(define-syntax-rule (send! peer assertion) (define-syntax-rule (send! peer assertion)
(turn-message! this-turn peer (->preserve assertion))) (turn-message! this-turn peer (->preserve assertion)))
(define-syntax spawn (define-syntax (spawn stx)
(syntax-rules () (syntax-parse stx
[(_ #:name name setup-expr ...) [(_ name:<name> daemon:<daemon?> setup-expr ...)
(turn-spawn! #:name name this-turn (action () setup-expr ...))] #'(turn-spawn! #:name name.N
[(_ setup-expr ...) #:daemon? daemon.D
(turn-spawn! this-turn (action () setup-expr ...))])) this-turn
(action () setup-expr ...))]))
(define-syntax-rule (begin/dataflow expr ...) (define-syntax-rule (begin/dataflow expr ...)
(turn-dataflow! this-turn (action () expr ...))) (turn-dataflow! this-turn (action () expr ...)))