Modify syndicate's module-begin to capture actions on the RHS of define
Example. consider a procedure that spawns an actor and then returns some value relevant to communicating to that actor: (define (spawn-an-actor) (define name (gensym)) (spawn (on (asserted (... name ...)) ...) ...) name) And the module top level tries to boot and use this actor with a define: (define the-name (spawn-an-actor)) (spawn ... use the-name ...) The new module-begin analyzes (forms that expand to) define-values to wrap the body with a capture-actor-actions, allowing such spawns to be detected.
This commit is contained in:
parent
ded2629296
commit
0e44970bef
|
@ -2,6 +2,7 @@
|
||||||
|
|
||||||
(require (for-syntax racket/base syntax/kerncase))
|
(require (for-syntax racket/base syntax/kerncase))
|
||||||
(require (for-syntax syntax/parse))
|
(require (for-syntax syntax/parse))
|
||||||
|
(require (for-syntax (only-in racket/list make-list)))
|
||||||
|
|
||||||
(require racket/match)
|
(require racket/match)
|
||||||
(require "main.rkt")
|
(require "main.rkt")
|
||||||
|
@ -52,6 +53,24 @@
|
||||||
(module+ main (current-ground-dataspace run-ground))
|
(module+ main (current-ground-dataspace run-ground))
|
||||||
forms ...)))]))
|
forms ...)))]))
|
||||||
|
|
||||||
|
;; Identifier -> Bool
|
||||||
|
;; Is the identifier a form that shouldn't capture actor actions?
|
||||||
|
;; note the absence of define-values
|
||||||
|
(define-for-syntax (kernel-id? x)
|
||||||
|
(ormap (lambda (i) (free-identifier=? x i))
|
||||||
|
(syntax->list #'(require
|
||||||
|
provide
|
||||||
|
define-values
|
||||||
|
define-syntaxes
|
||||||
|
begin-for-syntax
|
||||||
|
module
|
||||||
|
module*
|
||||||
|
module+
|
||||||
|
#%require
|
||||||
|
#%provide
|
||||||
|
#%declare
|
||||||
|
begin-for-declarations))))
|
||||||
|
|
||||||
(define-syntax (syndicate-module stx)
|
(define-syntax (syndicate-module stx)
|
||||||
(syntax-parse stx
|
(syntax-parse stx
|
||||||
[(_ (action-ids ...) (form forms ...))
|
[(_ (action-ids ...) (form forms ...))
|
||||||
|
@ -61,27 +80,27 @@
|
||||||
#'begin-for-declarations)
|
#'begin-for-declarations)
|
||||||
(kernel-form-identifier-list))))
|
(kernel-form-identifier-list))))
|
||||||
(syntax-parse expanded
|
(syntax-parse expanded
|
||||||
#:literals (begin)
|
#:literals (begin define-values)
|
||||||
[(begin more-forms ...)
|
[(begin more-forms ...)
|
||||||
#'(syndicate-module (action-ids ...) (more-forms ... forms ...))]
|
#'(syndicate-module (action-ids ...) (more-forms ... forms ...))]
|
||||||
|
[(define-values (x:id ...) e)
|
||||||
|
#:with action-id (car (generate-temporaries (list #'form)))
|
||||||
|
#:with (tmp ...) (generate-temporaries #'(x ...))
|
||||||
|
#`(begin
|
||||||
|
(define-values (tmp ...) (values #,@(make-list (length (syntax->list #'(x ...))) #'#f)))
|
||||||
|
(define action-id
|
||||||
|
(capture-actor-actions
|
||||||
|
(lambda () (set!-values (tmp ...) e))))
|
||||||
|
(define-values (x ...) (values tmp ...))
|
||||||
|
(syndicate-module (action-ids ... action-id) (forms ...)))]
|
||||||
[(head rest ...)
|
[(head rest ...)
|
||||||
(if (ormap (lambda (i) (free-identifier=? #'head i))
|
(cond
|
||||||
(syntax->list #'(require
|
[(kernel-id? #'head)
|
||||||
provide
|
#`(begin #,expanded (syndicate-module (action-ids ...) (forms ...)))]
|
||||||
define-values
|
[else
|
||||||
define-syntaxes
|
(with-syntax ([action-id (car (generate-temporaries (list #'form)))])
|
||||||
begin-for-syntax
|
#`(begin (define action-id (capture-actor-actions (lambda () #,expanded)))
|
||||||
module
|
(syndicate-module (action-ids ... action-id) (forms ...))))])]
|
||||||
module*
|
|
||||||
module+
|
|
||||||
#%require
|
|
||||||
#%provide
|
|
||||||
#%declare
|
|
||||||
begin-for-declarations)))
|
|
||||||
#`(begin #,expanded (syndicate-module (action-ids ...) (forms ...)))
|
|
||||||
(with-syntax ([action-id (car (generate-temporaries (list #'form)))])
|
|
||||||
#`(begin (define action-id (capture-actor-actions (lambda () #,expanded)))
|
|
||||||
(syndicate-module (action-ids ... action-id) (forms ...)))))]
|
|
||||||
[non-pair-syntax
|
[non-pair-syntax
|
||||||
#'(begin form (syndicate-module (action-ids ...) (forms ...)))])]
|
#'(begin form (syndicate-module (action-ids ...) (forms ...)))])]
|
||||||
[(_ (action-ids ...) ())
|
[(_ (action-ids ...) ())
|
||||||
|
|
Loading…
Reference in New Issue