diff --git a/syndicate-examples/speed-tests/box-and-client/without-dataspace.rkt b/syndicate-examples/speed-tests/box-and-client/without-dataspace.rkt index 3dd24a5..3637375 100644 --- a/syndicate-examples/speed-tests/box-and-client/without-dataspace.rkt +++ b/syndicate-examples/speed-tests/box-and-client/without-dataspace.rkt @@ -12,15 +12,19 @@ (define-field value 0) (define reporter (report-stats REPORT_EVERY)) (send! k (hash 'getter - (ref (during* (action (observer) - (log-info "observer ~v" observer) - (at observer (assert (value)))))) + (embedded + (ref (during* #:name 'subscription-handler + (action (observer) + (log-info "observer ~v" observer) + (at (embedded-value observer) (assert (value))))))) 'setter - (ref (entity #:message - (action (new-value) - (reporter new-value) - (when (= new-value LIMIT) (stop-facet root-facet)) - (value new-value))))))))) + (embedded + (ref (entity #:name 'update-handler + #:message + (action (new-value) + (reporter new-value) + (when (= new-value LIMIT) (stop-facet root-facet)) + (value new-value)))))))))) (define client (action (getter setter) @@ -29,17 +33,21 @@ (define root-facet this-facet) (define count 0) (at getter - (assert (ref (entity #:assert - (action (_value _handle) - (set! count (+ count 1))) - #:retract - (action (_handle) - (set! count (- count 1)) - (when (zero? count) - (log-info "Client detected box termination") - (stop-facet root-facet)))))) - (assert (ref (entity #:assert - (action (value _handle) (send! setter (+ value 1)))))))))) + (assert (embedded + (ref (entity #:name 'termination-detector + #:assert + (action (_value _handle) + (set! count (+ count 1))) + #:retract + (action (_handle) + (set! count (- count 1)) + (when (zero? count) + (log-info "Client detected box termination") + (stop-facet root-facet))))))) + (assert (embedded + (ref (entity #:name 'update-handler + #:assert + (action (value _handle) (send! setter (+ value 1))))))))))) (module+ main (time @@ -47,10 +55,12 @@ (define root-facet this-facet) (define disarm (facet-prevent-inert-check! this-facet)) (box this-turn - (ref (entity #:message + (ref (entity #:name 'box-boot-handler + #:message (action (refs) (log-info "refs ~v" refs) - (match-define (hash-table ('getter g) ('setter s)) refs) + (match-define (hash-table ('getter (embedded g)) + ('setter (embedded s))) refs) (client this-turn g s) (stop-facet root-facet)))) 500000 diff --git a/syndicate/main.rkt b/syndicate/main.rkt index ff37ac1..b7ad7da 100644 --- a/syndicate/main.rkt +++ b/syndicate/main.rkt @@ -11,8 +11,7 @@ assertion-struct message-struct - :pattern - :template) + :pattern) (require (except-in "actor.rkt" actor-system)) (require "syntax.rkt") @@ -23,6 +22,6 @@ (define-syntax-rule (assertion-struct item ...) (struct item ... #:prefab)) (define-syntax-rule (message-struct item ...) (struct item ... #:prefab)) -(require (only-in "pattern.rkt" :pattern :template)) +(require (only-in "pattern.rkt" :pattern)) (module reader syntax/module-reader syndicate/lang) diff --git a/syndicate/pattern.rkt b/syndicate/pattern.rkt index 901918f..df1ef16 100644 --- a/syndicate/pattern.rkt +++ b/syndicate/pattern.rkt @@ -9,7 +9,6 @@ analyse-pattern-bindings) define-preserves-pattern :pattern - :template pattern->constant-values pattern->constant-paths @@ -53,10 +52,6 @@ (syntax-case s () [(_ field-stxs ...) pattern-stx] [_ (raise-syntax-error 'ctor-stx "Invalid pattern")])] - ['template - (syntax-case s () - [(_ field-stxs ...) - (syntax (->preserve (ctor-stx field-stxs ...)))])] ['bindings (syntax-case s () [(_ field-stxs ...) bindings-stx] @@ -228,34 +223,7 @@ '()] [other - '()]))) - - (define (analyse-template stx) - (syntax-case stx ($ quasiquote unquote quote) - [(ctor args ...) - (constructor-registered? #'ctor) - ((free-id-table-ref preserves-pattern-registry #'ctor) 'template stx)] - - ;; Extremely limited support for quasiquoting and quoting - [(quasiquote (unquote p)) #'p] - [(quasiquote (p ...)) (analyse-template #'(list (quasiquote p) ...))] - [(quasiquote p) #''p] - [(quote p) #''p] - - [(ctor piece ...) - (struct-info? (id-value #'ctor)) - #`(ctor #,@(map analyse-template (syntax->list #'(piece ...))))] - - [(list-stx piece ...) - (list-id? #'list-stx) - #`(list-stx #,@(map analyse-template (syntax->list #'(piece ...))))] - - [(hash-stx piece ...) - (hash-or-hasheqv-id? #'hash-stx) - #`(hash-stx #,@(append-map-pairs (lambda (k v) (list k (analyse-template v))) - (syntax->list #'(piece ...))))] - - [other #'other]))) + '()])))) (define-pattern-expander :pattern (lambda (stx) @@ -272,11 +240,6 @@ [(_ pat-stx) (analyse-pattern #'pat-stx)]))) -(define-syntax (:template stx) - (syntax-case stx () - [(_ template-stx) - (analyse-template #'template-stx)])) - ;;--------------------------------------------------------------------------- (define (select-pattern-leaves desc capture-fn lit-fn) diff --git a/syndicate/syntax.rkt b/syndicate/syntax.rkt index 3b8e424..90ff11d 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 preserves-schema) (require "actor.rkt") (require (prefix-in actor: "actor.rkt")) @@ -105,7 +106,7 @@ (turn-sync! this-turn peer (action (_reply) expr ...))) (define-syntax-rule (send! peer assertion) - (turn-message! this-turn peer (:template assertion))) + (turn-message! this-turn peer (->preserve assertion))) (define-syntax spawn (syntax-rules () @@ -154,7 +155,7 @@ (define-event-expander assert (syntax-rules () [(_ expr) - (turn-assert/dataflow! this-turn this-target (action () (:template expr)))])) + (turn-assert/dataflow! this-turn this-target (action () (->preserve expr)))])) (define-event-expander stop-when (syntax-rules ()