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:
Sam Caldwell 2019-07-25 14:57:47 -04:00
parent ded2629296
commit 0e44970bef
1 changed files with 37 additions and 18 deletions

View File

@ -2,6 +2,7 @@
(require (for-syntax racket/base syntax/kerncase))
(require (for-syntax syntax/parse))
(require (for-syntax (only-in racket/list make-list)))
(require racket/match)
(require "main.rkt")
@ -52,6 +53,24 @@
(module+ main (current-ground-dataspace run-ground))
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)
(syntax-parse stx
[(_ (action-ids ...) (form forms ...))
@ -61,27 +80,27 @@
#'begin-for-declarations)
(kernel-form-identifier-list))))
(syntax-parse expanded
#:literals (begin)
#:literals (begin define-values)
[(begin more-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 ...)
(if (ormap (lambda (i) (free-identifier=? #'head i))
(syntax->list #'(require
provide
define-values
define-syntaxes
begin-for-syntax
module
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 ...)))))]
(cond
[(kernel-id? #'head)
#`(begin #,expanded (syndicate-module (action-ids ...) (forms ...)))]
[else
(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
#'(begin form (syndicate-module (action-ids ...) (forms ...)))])]
[(_ (action-ids ...) ())