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

Switch from gestalt-observers/message-handlers to plain event-handlers

This commit is contained in:
Tony Garnock-Jones 2014-06-27 15:49:59 -04:00
parent 82edbd0936
commit 8050324f5b
1 changed files with 50 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

101
minimart/actor.rkt
View File

@ -14,7 +14,8 @@
for/advertise for/advertise
for/subscribe for/subscribe
define-transition define-transition
begin-transition) begin-transition
noop-transition)
;; (require (for-syntax racket/pretty)) ;; (require (for-syntax racket/pretty))
;; (require (for-syntax racket/trace)) ;; (require (for-syntax racket/trace))
@ -60,6 +61,9 @@
;; (pretty-print `(result ,(syntax->datum result))) ;; (pretty-print `(result ,(syntax->datum result)))
result)])) result)]))
(define (noop-transition state)
(transition state '()))
(begin-for-syntax (begin-for-syntax
(define-syntax-rule (define-temporaries [tempvar basestx] ...) (define-syntax-rule (define-temporaries [tempvar basestx] ...)
@ -142,11 +146,6 @@
;; Temporaries usable for internal bindings of state values. Computed, fresh identifiers. ;; Temporaries usable for internal bindings of state values. Computed, fresh identifiers.
(define statetemps '()) (define statetemps '())
;; (Listof (Syntax -> SyntaxList))
;; Sequence of functions generating code for responding to routing-update events.
;; State bindings and body definitions are in scope.
(define gestalt-observers '())
;; (Listof Syntax) ;; (Listof Syntax)
;; Fragments computing gestalt of the actor. Each is in transition context. ;; Fragments computing gestalt of the actor. Each is in transition context.
;; State bindings and body definitions are in scope. ;; State bindings and body definitions are in scope.
@ -158,9 +157,10 @@
(define gestalt-fragments '()) (define gestalt-fragments '())
;; (Listof (Syntax -> Syntax)) ;; (Listof (Syntax -> Syntax))
;; Sequence of functions generating message-handling clauses for responding to events. ;; Sequence of functions generating expressions yielding
;; transition-functions for responding to events.
;; State bindings and body definitions are in scope. ;; State bindings and body definitions are in scope.
(define message-handlers '()) (define event-handlers '())
;; (Listof Identifier) ;; (Listof Identifier)
;; Names for body-definitions representing actions to take on actor bootup. ;; Names for body-definitions representing actions to take on actor bootup.
@ -306,36 +306,39 @@
(when gestalt-name-available? (when gestalt-name-available?
(push-statevar! gestalt-name gestalt-init #'#f)) (push-statevar! gestalt-name gestalt-init #'#f))
(push-many! gestalt-observers (push! event-handlers
(if using-presence? (lambda (e-stx)
(list (lambda (g-stx) #`(match #,e-stx
#`(#:update [#,presence-name [(routing-update g)
(not (gestalt-empty? (begin-transition
(gestalt-filter #,g-stx #,gestalt-name)))]))) #,@(if using-presence?
'()) #`(#:update [#,presence-name
(if using-set? (not (gestalt-empty?
(list (lambda (g-stx) (gestalt-filter g #,gestalt-name)))])
#`((define #,set-temp #'())
#,(if set-exp #,@(if using-set?
#`(for/set [(e (in-set #`((define #,set-temp
(gestalt-project/keys #,g-stx #,(if set-exp
#,projector-name)))] #`(for/set [(e (in-set
(match-define (list #,@binders) e) (gestalt-project/keys g
#,set-exp) #,projector-name)))]
#`(gestalt-project/keys #,g-stx #,projector-name))) (match-define (list #,@binders) e)
#,@(if added-name #,set-exp)
#`((define #,added-name (set-subtract #,set-temp #`(gestalt-project/keys g #,projector-name)))
#,set-name))) #,@(if added-name
#'()) #`((define #,added-name (set-subtract #,set-temp
#,@(if removed-name #,set-name)))
#`((define #,removed-name (set-subtract #,set-name #'())
#,set-temp))) #,@(if removed-name
#'()) #`((define #,removed-name (set-subtract #,set-name
#,@(if set-name #,set-temp)))
#`(#:update [#,set-name #,set-temp]) #'())
#'())))) #,@(if set-name
'()) #`(#:update [#,set-name #,set-temp])
(list (lambda (g-stx) remaining-stx))) #'()))
#'())
#,@remaining-stx)]
[_ noop-transition])))
(when gestalt-name-available? (when gestalt-name-available?
(push! gestalt-updaters (push! gestalt-updaters
@ -375,10 +378,12 @@
#`(if #,condition #,gestalt-name (gestalt-empty)) #`(if #,condition #,gestalt-name (gestalt-empty))
gestalt-name)) gestalt-name))
(push! message-handlers (push! event-handlers
(lambda (e-stx) (lambda (e-stx)
#`[(message #,matcher-stx (== #,(or meta-level 0)) #,pub?) #`(match #,e-stx
(begin-transition #,@remaining-stx)]))) [(message #,matcher-stx (== #,(or meta-level 0)) #,pub?)
(begin-transition #,@remaining-stx)]
[_ noop-transition]))))
(define (analyze-group-participation! loopspecs-stx pat-stx body-stx pub?) (define (analyze-group-participation! loopspecs-stx pat-stx body-stx pub?)
(define-values (p remaining-stx) (analyze-participator-body body-stx (participator #f #f))) (define-values (p remaining-stx) (analyze-participator-body body-stx (participator #f #f)))
@ -412,7 +417,6 @@
(define-temporaries (define-temporaries
[e-stx #'event] [e-stx #'event]
[state-stx #'state] [state-stx #'state]
[g-stx #'gestalt]
[update-gestalt-stx #'update-gestalt]) [update-gestalt-stx #'update-gestalt])
(define result (define result
#`(let () #`(let ()
@ -447,15 +451,10 @@
(spawn #:boot (begin-transition #,@(reverse action-ids)) (spawn #:boot (begin-transition #,@(reverse action-ids))
(procedure-rename (procedure-rename
(lambda (#,e-stx #,state-stx) (lambda (#,e-stx #,state-stx)
((match #,e-stx (and #,e-stx
[(routing-update #,g-stx) (sequence-transitions (transition #,state-stx '())
(begin-transition #,@(map (lambda (p) (p e-stx))
#,@(append-map (reverse event-handlers)))))
(lambda (p) (syntax->list (p g-stx)))
gestalt-observers))]
#,@(map (lambda (p) (p e-stx)) message-handlers)
[_ (lambda (state) #f)])
#,state-stx))
'#,actor-name) '#,actor-name)
#,state-stx #,state-stx
initial-gestalt)])))))) initial-gestalt)]))))))