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

Remove :template in favour of ->preserve

This commit is contained in:
Tony Garnock-Jones 2021-06-08 16:20:58 +02:00
parent ef66c1d358
commit 40c26f006e
4 changed files with 37 additions and 64 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
syndicate-examples/speed-tests/box-and-client/without-dataspace.rkt
View File

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

5
syndicate/main.rkt
View File

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

39
syndicate/pattern.rkt
View File

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

5
syndicate/syntax.rkt
View File

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