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

Cosmetic

This commit is contained in:
Tony Garnock-Jones 2014-06-27 15:33:28 -04:00
parent 584831e3e9
commit 82edbd0936
1 changed files with 24 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

38
minimart/actor.rkt
View File

@ -340,11 +340,16 @@
(when gestalt-name-available? (when gestalt-name-available?
(push! gestalt-updaters (push! gestalt-updaters
#`(begin #`(begin
(define #,projector-init (#,(if pub? #'project-subs #'project-pubs) #,projector-stx (define #,projector-init
#:level #,(or level 0) #:meta-level #,(or meta-level 0))) (#,(if pub? #'project-subs #'project-pubs) #,projector-stx
#:level #,(or level 0) #:meta-level #,(or meta-level 0)))
(define #,gestalt-init (projection->gestalt #,projector-init)) (define #,gestalt-init (projection->gestalt #,projector-init))
#,@(if using-set? #`(#:update [#,projector-name #,projector-init]) #'()) #,@(if using-set?
#,@(if gestalt-name-available? #`(#:update [#,gestalt-name #,gestalt-init]) #'())))) #`(#:update [#,projector-name #,projector-init])
#'())
#,@(if gestalt-name-available?
#`(#:update [#,gestalt-name #,gestalt-init])
#'()))))
(push! gestalt-fragments (push! gestalt-fragments
(let ((g (if gestalt-name-available? (let ((g (if gestalt-name-available?
@ -415,17 +420,21 @@
(let () (let ()
#,@(for/list [(sv statevars)] #`(define-syntax-parameter #,sv #f)) #,@(for/list [(sv statevars)] #`(define-syntax-parameter #,sv #f))
(syntax-parameterize (syntax-parameterize
((update-state-struct (syntax-rules () [(_ v [n e] (... ...)) ((update-state-struct
(struct-copy #,state-struct-name v [n e] (... ...))])) (syntax-rules () [(_ v [n e] (... ...))
(match-state (syntax-rules () [(_ id body (... ...)) (struct-copy #,state-struct-name v [n e] (... ...))]))
(match-lambda (match-state
[(and id (struct #,state-struct-name (#,@statetemps))) (syntax-rules () [(_ id body (... ...))
(syntax-parameterize (#,@(for/list ([sv statevars] [si statetemps]) (match-lambda
#`(#,sv (syntax-id-rules () [_ #,si])))) [(and id (struct #,state-struct-name (#,@statetemps)))
body (... ...))])]))) (syntax-parameterize
(#,@(for/list ([sv statevars] [si statetemps])
#`(#,sv (syntax-id-rules () [_ #,si]))))
body (... ...))])])))
(splicing-syntax-parameterize (splicing-syntax-parameterize
((update-gestalt (syntax-id-rules () [_ #,update-gestalt-stx])) ((update-gestalt (syntax-id-rules () [_ #,update-gestalt-stx]))
#,@(for/list ([sv statevars] [si statetemps]) #`(#,sv (syntax-id-rules () [_ #,si])))) #,@(for/list ([sv statevars] [si statetemps])
#`(#,sv (syntax-id-rules () [_ #,si]))))
#,@(reverse body-forms) #,@(reverse body-forms)
(define #,update-gestalt-stx (define #,update-gestalt-stx
(begin-transition (begin-transition
@ -433,7 +442,8 @@
(routing-update (gestalt-union #,@gestalt-fragments)))) (routing-update (gestalt-union #,@gestalt-fragments))))
(match (#,update-gestalt-stx (#,state-struct-name #,@statevars)) (match (#,update-gestalt-stx (#,state-struct-name #,@statevars))
[(transition #,state-stx initial-gestalt-actions) [(transition #,state-stx initial-gestalt-actions)
(match-define (list (routing-update initial-gestalt)) (clean-actions initial-gestalt-actions)) (match-define (list (routing-update initial-gestalt))
(clean-actions initial-gestalt-actions))
(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)