From 0e44970befd1209a6f2fb756eeee363c3169d750 Mon Sep 17 00:00:00 2001
From: Sam Caldwell <samc@ccs.neu.edu>
Date: Thu, 25 Jul 2019 14:57:47 -0400
Subject: [PATCH] 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.
---
 racket/syndicate/core-lang.rkt | 55 +++++++++++++++++++++++-----------
 1 file changed, 37 insertions(+), 18 deletions(-)

diff --git a/racket/syndicate/core-lang.rkt b/racket/syndicate/core-lang.rkt
index 639ac0d..8c81054 100644
--- a/racket/syndicate/core-lang.rkt
+++ b/racket/syndicate/core-lang.rkt
@@ -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 ...) ())