define/await

This commit is contained in:
Tony Garnock-Jones 2022-11-30 19:50:25 +00:00
parent 092fb7eb2f
commit 41b38e7fb2
3 changed files with 16 additions and 4 deletions

View File

@ -1,13 +1,15 @@
#lang syndicate #lang racket/base
;;; SPDX-License-Identifier: LGPL-3.0-or-later ;;; SPDX-License-Identifier: LGPL-3.0-or-later
;;; SPDX-FileCopyrightText: Copyright © 2022 Tony Garnock-Jones <tonyg@leastfixedpoint.com> ;;; SPDX-FileCopyrightText: Copyright © 2022 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
(provide async (provide async
async? async?
suspend suspend
await) await
define/await)
(require (only-in (submod "actor.rkt" internals) with-active-facet)) (require (only-in (submod "actor.rkt" internals) with-active-facet))
(require "syntax.rkt")
(define prompt-tag (make-continuation-prompt-tag 'syndicate)) (define prompt-tag (make-continuation-prompt-tag 'syndicate))
@ -45,6 +47,12 @@
(let ((k (lambda results (stop-facet facet (apply k results))))) (let ((k (lambda results (stop-facet facet (apply k results)))))
body ...))))) body ...)))))
(define-syntax-rule (define/await [name (op args ...)] ...)
(define-values (name ...)
(await k
(define name (op query-result args ...)) ...
(sync! this-target (k name ...)))))
(module+ test (module+ test
(require "dataspace.rkt") (require "dataspace.rkt")
(actor-system/dataspace (ds) (actor-system/dataspace (ds)

View File

@ -9,6 +9,7 @@
(all-from-out "query.rkt") (all-from-out "query.rkt")
(all-from-out "service.rkt") (all-from-out "service.rkt")
(all-from-out "event-expander.rkt") (all-from-out "event-expander.rkt")
(all-from-out "async.rkt")
(all-from-out preserves) (all-from-out preserves)
(all-from-out preserves-schema) (all-from-out preserves-schema)
@ -23,6 +24,7 @@
(require "query.rkt") (require "query.rkt")
(require "service.rkt") (require "service.rkt")
(require "event-expander.rkt") (require "event-expander.rkt")
(require "async.rkt")
(require preserves) (require preserves)
(require preserves-schema) (require preserves-schema)

View File

@ -42,6 +42,7 @@
during*) during*)
(require racket/match) (require racket/match)
(require racket/splicing)
(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))
@ -304,8 +305,9 @@
(define-syntax (at stx) (define-syntax (at stx)
(syntax-case stx () (syntax-case stx ()
[(_ target-expr items ...) [(_ target-expr items ...)
#`(let ((target target-expr)) #`(begin
(syntax-parameterize ([this-target (make-rename-transformer #'target)]) (define target target-expr)
(splicing-syntax-parameterize ([this-target (make-rename-transformer #'target)])
items ...))])) items ...))]))
(define-syntax assert (define-syntax assert