From 7134b95ff10b2474774d2a308c2b73f049633bf7 Mon Sep 17 00:00:00 2001
From: Kevin Tew <tewk@racket-lang.org>
Date: Fri, 22 Apr 2011 14:13:06 -0600
Subject: [PATCH] [Places] place/anon place/thunk

---
 collects/racket/place.rkt                   | 36 ++++++++++++++++++++-
 collects/scribblings/reference/places.scrbl | 19 +++++++++++
 collects/setup/parallel-do.rkt              | 25 --------------
 3 files changed, 54 insertions(+), 26 deletions(-)

diff --git a/collects/racket/place.rkt b/collects/racket/place.rkt
index 89f751d47c..7fcfb1f5ae 100644
--- a/collects/racket/place.rkt
+++ b/collects/racket/place.rkt
@@ -6,7 +6,8 @@
          '#%place-struct
          racket/fixnum
          racket/flonum
-         racket/vector)
+         racket/vector
+         (for-syntax racket/base))
 
 (provide place
          place-sleep
@@ -19,6 +20,9 @@
          place?
          place-channel-send/receive
          processor-count
+         place/anon
+         place/thunk
+         define-place
          (rename-out [pl-place-enabled? place-enabled?]))
 
 (define-struct TH-place (th ch cust) 
@@ -124,3 +128,33 @@
 (define-pl place-channel-receive pl-place-channel-receive th-place-channel-receive)
 (define-pl place-channel?     pl-place-channel?     th-place-channel?)
 (define-pl place?             pl-place?             TH-place?)
+
+(define-syntax-rule (define-syntax-case (N a ...) b ...)
+  (define-syntax (N stx)
+    (syntax-case stx ()
+      [(_ a ...) b ...])))
+
+(define-for-syntax (gen-create-place stx)
+ (syntax-case stx ()
+   [(_ ch body ...)
+     (with-syntax ([interal-def-name
+                    (syntax-local-lift-expression #'(lambda (ch) body ...))]
+                   [funcname #'OBSCURE_FUNC_NAME_%#%])
+      (syntax-local-lift-provide #'(rename interal-def-name funcname))
+      #'(let ([module-path (resolved-module-path-name
+              (variable-reference->resolved-module-path
+               (#%variable-reference)))])
+       (place module-path (quote funcname))))]))
+
+(define-syntax (place/thunk stx)
+  (with-syntax ([create-place (gen-create-place stx)])
+    #'(lambda () create-place)))
+
+(define-syntax (place/anon stx)
+  (gen-create-place stx))
+
+
+(define-syntax (define-place stx)
+ (syntax-case stx ()
+   [(_ (name ch) body ...)
+    #'(define name (place/thunk ch body ...))]))
diff --git a/collects/scribblings/reference/places.scrbl b/collects/scribblings/reference/places.scrbl
index 953593b553..6cf2d3cf4b 100644
--- a/collects/scribblings/reference/places.scrbl
+++ b/collects/scribblings/reference/places.scrbl
@@ -127,6 +127,25 @@ racket
   Terminates the place indicated by @racket[p],
 }
 
+
+@defform[(place/thunk place-channel? body ...)]{
+  In-line definition of a place worker body, which is lifted up to module scope.
+  @racket[place/thunk] closes over only module scope variables.
+  Returns a thunk for creating the described place.
+}
+
+@defform[(place/anon place-channel? body ...)]{
+  In-line definition of a place worker body, which is lifted up to module scope.
+  @racket[place/anon] closes over only module scope variables.
+  Returns the place descriptor for the newly constructed place.
+}
+
+@defform[(define-place (place-name-id place-channel-id) body ...)]{
+  In-line definition of a place worker body, which is lifted up to module scope.
+  @racket[define-place] closes over only module scope variables.
+  Defines a procedure for creating the described place.
+}
+
 @defproc[(place-channel) (values place-channel? place-channel?)]{
 
   Returns two @tech{place channels}. Data sent through the first
diff --git a/collects/setup/parallel-do.rkt b/collects/setup/parallel-do.rkt
index 86f01fde16..f3bf99ba48 100644
--- a/collects/setup/parallel-do.rkt
+++ b/collects/setup/parallel-do.rkt
@@ -371,28 +371,3 @@
         (define module-path (path->string (resolved-module-path-name (variable-reference->resolved-module-path (#%variable-reference)))))
         (parallel-do-event-loop module-path 'name initalmsg wq worker-count)
         (queue/results wq))]))
-
-(define-syntax-rule (define-syntax-case (N a ...) b ...)
-  (define-syntax (N stx)
-    (syntax-case stx ()
-      [(_ a ...) b ...])))
-
-(define-for-syntax (gen-create-place stx)
- (syntax-case stx ()
-   [(_ ch body ...)
-     (with-syntax ([interal-def-name
-                    (syntax-local-lift-expression #'(lambda (ch) body ...))]
-                   [funcname #'OBSCURE_FUNC_NAME_%#%])
-      (syntax-local-lift-provide #'(rename interal-def-name funcname))
-      #'(let ([module-path (resolved-module-path-name
-              (variable-reference->resolved-module-path
-               (#%variable-reference)))])
-       (place module-path (quote funcname))))]))
-
-(define-syntax (place/thunk stx)
-  (with-syntax ([create-place (gen-create-place stx)])
-    #'(lambda () create-place)))
-
-(define-syntax (place/anon stx)
-  (gen-create-place stx))
-