Here is a version that runs (if both files are in the same directory):

In `main.rkt`:
#lang racket

(require racket/runtime-path)

(define-runtime-path computation-place.rkt
  "computation-place.rkt")

(define (start-places places#)
  (for/list ([place-id places#])
    (define-values (a-place _in _out _err)
      (dynamic-place* computation-place.rkt
                      'compute
                      #:out (current-output-port)
                      #:err (current-error-port)
                      #:in (current-input-port)))
    (printf "created place ~s~n" place-id)
    ;; initialize the place
    (place-channel-put a-place (list 'initialize place-id))
    a-place))

(define (stop-places places)
  ;; simply terminate all places
  (for ([a-place places])
    (place-channel-put a-place 'terminate)
    (place-wait a-place)))

(define (main)
  ;; entry point of the program
  (define my-places
    (let ([procs (processor-count)])
      (printf "you have ~s processors~n" procs)
      (start-places procs)))
  ;; This lets all of the places print "place starting"
  ;; before any start doing work.
  (sleep 1)
  (for ([message '(the quick brown fox jumped over the lazy dogs)]
        [place (in-cycle my-places)])
    ;; we cyclically place work on the places - this might be not so good
in all cases
    ;; better would be to know what places still have work to do
    ;; and let places which are finished signal that they need more work
    (place-channel-put place
                       `(work ,message)))
  (printf "main has no more work data\n")
  (stop-places my-places))

In `computation-place.rkt`:
#lang racket

(provide compute)

(define (place-output fmt . output-data)
  (apply printf fmt output-data)
  (newline)
  (flush-output (current-output-port)))

(define (compute channel)
  (place-output "place starting")
  (define place-id
    (match (place-channel-get channel)
      [(list 'initialize place-id)
       place-id]
      [bad-message
       (place-output "Not an initialization message: ~e" bad-message)
       #f]))
  (when place-id
    (let loop ()
      (match (place-channel-get channel)
        [(list 'work data)
         (place-output "Place ~s got the following work: ~a."
                       place-id
                       data)
         (loop)]
        ['terminate
         (place-output "Place ~s is going to finish now." place-id)]
        [bad-message
         (place-output "Place ~s did not understand message: ~a."
                       place-id
                       bad-message)]))))

-Philip

On Sat, Jan 13, 2018 at 4:54 PM, Philip McGrath <phi...@philipmcgrath.com>
wrote:

> There are a few other problems with the code, but, most fundamentally,
> there is no call `message-processing-loop`, so each place starts up,
> handles the `'initialize` message, and terminates.
>
> -Philip
>
> On Sat, Jan 13, 2018 at 4:37 PM, Zelphir Kaltstahl <
> zelphirkaltst...@gmail.com> wrote:
>
>> I would like to create multiple places and let them all print to the same
>> output port, which is the output port of the main Racket instance, which
>> creates the other places. Currently I have the following code, slightly
>> adapted from the example in another topic here:
>>
>> FILE 1: main.rkt
>> ~~~
>> #lang racket
>>
>> (define (start-places places#)
>>   "starts a given amount of places"
>>
>>   (for/list [(place-id places#)]  ; create a list of places
>>     (let-values ([(a-place _a-place-input-port _a-place-output-port
>> _a-place-error-port)
>>                   (dynamic-place* "computation-place.rkt"
>>                                   'compute
>>                                   #:out (current-output-port)
>>                                   #:err (current-error-port)
>>                                   #:in (current-input-port))])
>>       (printf "created place ~s~n" place-id)
>>       (place-channel-put a-place (list 'initialize place-id))  ;
>> initialize the place
>>       a-place)))
>>
>> (define (stop-places places)
>>   "simply terminate all places"
>>
>>   (for [(a-place places)]
>>     (place-channel-put a-place 'terminate)
>>     (place-wait a-place)))
>>
>> (define (main)
>>   "entry point of the program"
>>
>>   (printf "you have ~s processors~n" (processor-count))
>>   (let ([my-places (start-places (processor-count))])
>>     (sleep 1)  ; why is this here?
>>
>>     (let loop [(messages (list 'the 'quick 'brown 'fox 'jumped 'over 'the
>> 'lazy 'dogs))
>>                (place-list-index 0)]
>>       (cond
>>         [(null? messages) (printf "main has no more work data")]
>>
>>         ;; we cyclically place work on the places - this might be not so
>> good in all cases
>>         ;; better would be to know what places still have work to do
>>         ;; and let places which are finished signal that they need more
>> work
>>         [else (place-channel-put (list-ref my-places place-list-index)
>> (list 'work (car messages)))
>>               (loop (cdr messages)
>>                     (remainder (+ place-list-index 1)
>>                                (length my-places)))]))
>>
>>     ;; (sleep 1)  ; why is this here?
>>     (stop-places my-places)))
>>
>> ~~~
>>
>> FILE 2: computation-place.rkt
>> ~~~
>> #lang racket
>>
>> (provide compute)
>>
>> (define compute
>>   (let ([place-output (λ (fmt . output-data)
>>                         (apply printf fmt output-data)
>>                         (flush-output (current-output-port)))]
>>         [place-id #f])
>>
>>     (λ (channel)
>>       (place-output "place starting~n")
>>
>>       ;; here comes the actual work being done
>>       ;; first we capture the exit continuation so that we can exit the
>> place later using it
>>       (let/ec finish
>>
>>         ;; then we loop to get all messages and react on them accordingly
>>         (let message-processing-loop ([message (place-channel-get
>> channel)])
>>           ;; this represents the communication protocol between places
>>           (match message
>>             [(list 'initialize a-place-id) (set! place-id a-place-id)]
>>             [(list 'work data) (do-work place-output
>>                                         place-id
>>                                         data)]
>>             ['terminate (finish-gracefully place-output
>>                                            place-id
>>                                            finish)]
>>             [else (reaction-message-not-understood place-output
>>                                                    place-id
>>                                                    message)]))))))
>>
>> (define finish-gracefully
>>   (λ (place-output place-id cont)
>>     (place-output "Place ~s is going to finish now." place-id)
>>     (cont)))
>>
>> (define reaction-message-not-understood
>>   (λ (place-output place-id message)
>>     (place-output "Place ~s did not understand message: ~a." place-id
>> message)))
>>
>> (define do-work
>>   (λ (place-output place-id data)
>>     (place-output "Place ~s got the following work: ~a." place-id data)))
>> ~~~
>>
>>
>> I am probably misunderstanding the docs
>> <https://docs.racket-lang.org/reference/places.html?q=place*#%28def._%28%28lib._racket%2Fplace..rkt%29._dynamic-place%2A%29%29>
>> or I am making some silly mistake in my thinking. To me it seems that the
>> docs are saying I can give `dynamic-place*` any port I want for the created
>> place to use as an output port. Only if I give it `#f` it would create its
>> own output port (or input or error port). I am giving the places the
>> current output input and error ports, but I still see no output of these
>> places in my Racket REPL in Emacs.
>>
>> What am I doing wrong?
>>
>> (On that note:
>> I read elsewhere (Stackoverflow? Could be.), that I cannot pass
>> procedures to places.
>> Is there something preventing me from passing procedures as "data", as
>> lists, to be evaluated with something like `eval`?
>> Is the idea of allowing arbitrary computations to be distributed like
>> this no good?)
>>
>> --
>> You received this message because you are subscribed to the Google Groups
>> "Racket Users" group.
>> To unsubscribe from this group and stop receiving emails from it, send an
>> email to racket-users+unsubscr...@googlegroups.com.
>> For more options, visit https://groups.google.com/d/optout.
>>
>
>

-- 
You received this message because you are subscribed to the Google Groups 
"Racket Users" group.
To unsubscribe from this group and stop receiving emails from it, send an email 
to racket-users+unsubscr...@googlegroups.com.
For more options, visit https://groups.google.com/d/optout.

Reply via email to