Remove :template in favour of ->preserve
This commit is contained in:
parent
ef66c1d358
commit
40c26f006e
|
@ -12,15 +12,19 @@
|
|||
(define-field value 0)
|
||||
(define reporter (report-stats REPORT_EVERY))
|
||||
(send! k (hash 'getter
|
||||
(ref (during* (action (observer)
|
||||
(embedded
|
||||
(ref (during* #:name 'subscription-handler
|
||||
(action (observer)
|
||||
(log-info "observer ~v" observer)
|
||||
(at observer (assert (value))))))
|
||||
(at (embedded-value observer) (assert (value)))))))
|
||||
'setter
|
||||
(ref (entity #:message
|
||||
(embedded
|
||||
(ref (entity #:name 'update-handler
|
||||
#:message
|
||||
(action (new-value)
|
||||
(reporter new-value)
|
||||
(when (= new-value LIMIT) (stop-facet root-facet))
|
||||
(value new-value)))))))))
|
||||
(value new-value))))))))))
|
||||
|
||||
(define client
|
||||
(action (getter setter)
|
||||
|
@ -29,7 +33,9 @@
|
|||
(define root-facet this-facet)
|
||||
(define count 0)
|
||||
(at getter
|
||||
(assert (ref (entity #:assert
|
||||
(assert (embedded
|
||||
(ref (entity #:name 'termination-detector
|
||||
#:assert
|
||||
(action (_value _handle)
|
||||
(set! count (+ count 1)))
|
||||
#:retract
|
||||
|
@ -37,9 +43,11 @@
|
|||
(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))))))))))
|
||||
(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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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 ()
|
||||
|
|
Loading…
Reference in New Issue