Fix error in analyze-body* macro; adjust scope of compute-gestalt
This commit is contained in:
parent
38ea50e352
commit
c0a92a64f5
|
@ -73,17 +73,17 @@
|
||||||
body-forms
|
body-forms
|
||||||
forms-stx)
|
forms-stx)
|
||||||
|
|
||||||
(define-syntax-rule (analyze-body* body-stx struct-type o [keyword accessor fieldname] ...)
|
(define-syntax-rule (analyze-body* self body-stx struct-type o [keyword accessor fieldname] ...)
|
||||||
(syntax-case body-stx ()
|
(syntax-case body-stx ()
|
||||||
[(keyword v rest (... ...))
|
[(keyword v rest (... ...))
|
||||||
(if (accessor o)
|
(if (accessor o)
|
||||||
(raise-syntax-error #f (format "duplicate ~a clause" 'keyword) body-stx)
|
(raise-syntax-error #f (format "duplicate ~a clause" 'keyword) body-stx)
|
||||||
(analyze-observer-body #'(rest (... ...)) (struct-copy struct-type o [fieldname #'v])))]
|
(self #'(rest (... ...)) (struct-copy struct-type o [fieldname #'v])))]
|
||||||
...
|
...
|
||||||
[other (values o #'other)]))
|
[other (values o #'other)]))
|
||||||
|
|
||||||
(define (analyze-observer-body body-stx o)
|
(define (analyze-observer-body body-stx o)
|
||||||
(analyze-body* body-stx observer o
|
(analyze-body* analyze-observer-body body-stx observer o
|
||||||
[#:when observer-condition condition]
|
[#:when observer-condition condition]
|
||||||
[#:level observer-level level]
|
[#:level observer-level level]
|
||||||
[#:meta-level observer-meta-level meta-level]
|
[#:meta-level observer-meta-level meta-level]
|
||||||
|
@ -94,7 +94,7 @@
|
||||||
[#:removed observer-removed-name removed-name]))
|
[#:removed observer-removed-name removed-name]))
|
||||||
|
|
||||||
(define (analyze-participator-body body-stx p)
|
(define (analyze-participator-body body-stx p)
|
||||||
(analyze-body* body-stx participator p
|
(analyze-body* analyze-participator-body body-stx participator p
|
||||||
[#:when participator-condition condition]
|
[#:when participator-condition condition]
|
||||||
[#:meta-level participator-meta-level meta-level]))
|
[#:meta-level participator-meta-level meta-level]))
|
||||||
|
|
||||||
|
@ -286,11 +286,12 @@
|
||||||
[(and id (struct #,state-struct-name (#,@stateinits)))
|
[(and id (struct #,state-struct-name (#,@stateinits)))
|
||||||
(syntax-parameterize (#,@(for/list ([sv statevars] [si stateinits])
|
(syntax-parameterize (#,@(for/list ([sv statevars] [si stateinits])
|
||||||
#`(#,sv (syntax-id-rules () [_ #,si]))))
|
#`(#,sv (syntax-id-rules () [_ #,si]))))
|
||||||
body (... ...))])]))
|
body (... ...))])])))
|
||||||
(compute-gestalt (syntax-rules () [(_ state) (#,compute-gestalt-stx state)])))
|
|
||||||
(let ((#,compute-gestalt-stx (match-state #,state-stx
|
(let ((#,compute-gestalt-stx (match-state #,state-stx
|
||||||
(gestalt-union #,@gestalt-computers)))
|
(gestalt-union #,@gestalt-computers)))
|
||||||
(#,state-stx (#,state-struct-name #,@statevars)))
|
(#,state-stx (#,state-struct-name #,@statevars)))
|
||||||
|
(syntax-parameterize
|
||||||
|
((compute-gestalt (syntax-rules () [(_ state) (#,compute-gestalt-stx state)])))
|
||||||
(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)
|
||||||
|
@ -298,14 +299,16 @@
|
||||||
((match #,e-stx
|
((match #,e-stx
|
||||||
[(routing-update #,g-stx)
|
[(routing-update #,g-stx)
|
||||||
(begin-transition
|
(begin-transition
|
||||||
#,@(append-map (lambda (p) (syntax->list (p g-stx))) gestalt-observers))]
|
#,@(append-map
|
||||||
|
(lambda (p) (syntax->list (p g-stx)))
|
||||||
|
gestalt-observers))]
|
||||||
#,@(map (lambda (p) (p e-stx)) message-handlers)
|
#,@(map (lambda (p) (p e-stx)) message-handlers)
|
||||||
[_ (lambda (state) #f)])
|
[_ (lambda (state) #f)])
|
||||||
#,state-stx))
|
#,state-stx))
|
||||||
#,state-stx))
|
#,state-stx))
|
||||||
'#,actor-name)
|
'#,actor-name)
|
||||||
#,state-stx
|
#,state-stx
|
||||||
(#,compute-gestalt-stx #,state-stx))))))
|
(#,compute-gestalt-stx #,state-stx)))))))
|
||||||
;; (pretty-print `(result ,(syntax->datum result)))
|
;; (pretty-print `(result ,(syntax->datum result)))
|
||||||
result)]
|
result)]
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue