clean up places benchmark compilation

pkgs/racket-pkgs/racket-test/tests/racket/benchmarks/places/place-channel.rkt

@@ -1,6 +1,7 @@
 #lang racket/base
 ;; stress tests for place-channels
-(require (prefix-in pp: "place-processes.rkt"))
+(require (prefix-in pp: "place-processes.rkt")
+         (prefix-in pu: "place-utils.rkt"))
 (require racket/place
          racket/path
          racket/system)
@@ -17,16 +18,18 @@
          (exact->inexact (/ B/sE (* 1024 1024)))
          'MB-per-second)))
 
-(define (processes-byte-message-test)
+(pp:place/base 
-  (let ([pl (pp:place/base
+ byte-message
-             (bo ch)
+ (bo ch)
-             (define message-size (* 4024 1024))
+ (define message-size (* 4024 1024))
-             (define count 10)
+ (define count 10)
-             (define fourk-b-message (make-bytes message-size 66))
+ (define fourk-b-message (make-bytes message-size 66))
-             (for ([i (in-range count)])
+ (for ([i (in-range count)])
-               (place-channel-get ch)
+   (place-channel-get ch)
-               (place-channel-put ch fourk-b-message)))])
+   (place-channel-put ch fourk-b-message)))
 
+(define (processes-byte-message-test)
+  (let ([pl (pp:dynamic-place (pu:here-submod byte-message) 'bo)])
     (define message-size (* 4024 1024))
     (define four-k-message (make-bytes message-size 65))
     (define count 10)
@@ -73,7 +76,9 @@ END
 
 
     (print-out "places" (/ (* 2 count message-size) (/ t2 1000)))
-    (place-wait pl)))
+    (place-wait pl))
+
+  (delete-file "pct1.rkt"))
 
 (define (cons-tree-test)
   (splat
@@ -108,7 +113,9 @@ END
     (printf "cons-tree ~a ~a ~a ~a\n" t1 t2 t3  (exact->inexact (/ t2 1000)))
     (print-out "cons-tree" (/ s (/ t2 1000)))
 
-    (place-wait pl)))
+    (place-wait pl))
+
+  (delete-file "pct1.rkt"))
 
 (define (current-executable-path) 
  (parameterize ([current-directory (find-system-path 'orig-dir)])

pkgs/racket-pkgs/racket-test/tests/racket/benchmarks/places/place-processes.rkt

@@ -54,7 +54,11 @@
       [(path? name)   (path->bytes name)]
       [(string? name) (string->bytes/locale name)]
       [(bytes? name)  name]
-      [else (raise 'module->path "expects a path or string")]))
+      [(and (list? name)
+            (= 3 (length name))
+            (eq? (car name) 'submod))
+       `(submod ,(module-name->bytes (cadr name)) ,(caddr name))]
+      [else (error 'module->path "expects a path or string")]))
   (define (current-executable-path) 
     (parameterize ([current-directory (find-system-path 'orig-dir)])
       (find-executable-path (find-system-path 'exec-file) #f)))
@@ -66,7 +70,12 @@
                                                           (find-system-path 'orig-dir))))))
   (define worker-cmdline-list (list (current-executable-path) "-X" (path->string (current-collects-path)) "-e" "(eval(read))"))
   (let-values ([(process-handle out in err) (apply subprocess #f #f (current-error-port) worker-cmdline-list)])
-    (send/msg `((dynamic-require (bytes->path ,(module-name->bytes module-name)) (quote ,func-name))) in)
+    (send/msg `((dynamic-require ,(let ([bstr (module-name->bytes module-name)])
+                                    (if (bytes? bstr)
+                                        `(bytes->path ,bstr)
+                                        `(list ',(car bstr) (bytes->path ,(cadr bstr)) ',(caddr bstr))))
+                                 (quote ,func-name))) 
+              in)
     (make-place-s (make-place-channel-s out in) process-handle err)))
 
 ;; kill a place
@@ -107,35 +116,15 @@
               (sub1 left-overs)
               new-result)))]))
 
-;; macro which lifts a place-worker body to module scope and provides it 
-;; (place/lambda (worker-name:identifier channel:identifier) body ...)
-;; returns syntax that creates a place 
 (define-syntax (place/base stx)
   (syntax-case stx ()
-    [(_ (name ch) body ...)
+    [(_ module-name (name ch) body ...)
-      (begin
+     #'(module module-name racket/base
-        (define (splat txt fn)
+         (require "place-processes.rkt")
-          (call-with-output-file fn #:exists 'replace
+         (provide name)
-              (lambda (out)
+         (define (name)
-                (write txt out))))
+           (let ([ch (place-child-channel)])
-
+             body ...)))]))
-        (define module-path-prefix (make-temporary-file "place-benchmark~a.rkt" #f (current-directory)))
-        (define-values (base file-name isdir) (split-path module-path-prefix))
-        (define worker-syntax
-          (with-syntax ([module-name (datum->syntax #'name (string->symbol (path->string (path-replace-suffix file-name ""))))])
-            #'(module module-name racket/base
-                (require "place-processes.rkt")
-                (provide name)
-                (define (name)
-                  (let ([ch (place-child-channel)])
-                    body ...)))))
-        (define module-path (path->string module-path-prefix))
-
-        (splat (syntax->datum worker-syntax) module-path)
-
-        (define place-syntax #`(dynamic-place #,module-path (quote name)))
-        ;(write (syntax->datum place-syntax))
-        place-syntax)]))
 
 (define-syntax (place/lambda stx)
   (syntax-case stx ()

pkgs/racket-pkgs/racket-test/tests/racket/benchmarks/places/place-utils.rkt

@@ -10,6 +10,7 @@
          barrier
          places-wait
          place/base
+         here-submod
          time-n)
 
 
@@ -36,29 +37,18 @@
 
 (define-syntax (place/base stx)
   (syntax-case stx ()
-    [(_ (name ch) body ...)
+    [(_ module-name (name ch) body ...)
-      (begin
+     #'(module module-name racket/base
-        (define (splat txt fn)
+         (require racket/place)
-          (call-with-output-file fn #:exists 'replace
+         (provide name)
-              (lambda (out)
+         (define (name ch)
-                (write txt out))))
+           body ...))]))
 
-        (define module-path (make-temporary-file "place-worker-~a.rkt" #f))
+(define-syntax-rule (here-submod id)
-        (define-values (base file-name isdir) (split-path module-path))
+  `(submod ,(resolved-module-path-name
-        (define worker-syntax
+             (variable-reference->resolved-module-path
-          (with-syntax ([module-name (datum->syntax #'name (string->symbol (path->string (path-replace-suffix file-name ""))))])
+             (#%variable-reference)))
-            #'(module module-name racket/base
+           id))
-                (require racket/place)
-                (provide name)
-                (define (name ch)
-                    body ...))))
-        (define module-path-str (path->string module-path))
-
-        (splat (syntax->datum worker-syntax) module-path-str)
-
-        (define place-syntax #`(dynamic-place #,module-path (quote name)))
-        ;(write (syntax->datum place-syntax)) (newline)
-        place-syntax)]))
 
 (define-syntax (time-n stx)
   (syntax-case stx ()