new-places-experiment.rkt

#lang racket/base

(require racket/place racket/list racket/match)

(define (run-in-place)
  (place ch
    (define base-ns
      (let ()
        (define ns (make-base-empty-namespace))
        (parameterize ([current-namespace ns])
          (namespace-require 'minikanren)
          (namespace-require 'racket/base))
        ns))
    
    (define (each-time)
      (define code (place-channel-get ch))
      
      (define ns (make-empty-namespace))
      
      (parameterize ([current-namespace ns])
        (namespace-attach-module base-ns 'minikanren))
      
      (define compiled
        (parameterize ([current-namespace base-ns])
          (compile code)))
      
      (define result (eval compiled ns))
      
      (place-channel-put ch result))
    
    (let loop ()
      (each-time)
      (loop))))

(struct state (run-id results) #:transparent)
(struct result (run-id proc value) #:transparent)

(define (foo num-places)
  (define p* (for/list ([i (range num-places)])
               (run-in-place)))
  
  (for ([p p*])
    (place-channel-put p 1)
    (place-channel-get p))
  
  (define current-state (state 0 #f))
  
  (define (run . expr*)
    (define run-id (+ 1 (state-run-id current-state)))
    (define starting-thread (current-thread))
    (set! current-state (state run-id (make-list (length expr*) 'running)))
    
    (for ([p p*]
          [expr expr*])
      (place-channel-put p expr))
    
    (for ([p p*]
          [i (range (length p*))])
      (thread
       (lambda ()
         (thread-send starting-thread
                      (result run-id i (place-channel-get p)))))))
  
  (define (callback res)
    (match-define (result res-run-id proc value) res)
    (match-define (state st-run-id results) current-state)
    
    (when (eqv? res-run-id st-run-id)
      (set! current-state (state st-run-id (list-set results proc value)))))
  
  (define (show)
    (do ([recv (thread-try-receive) (thread-try-receive)])
      ((not recv))
      (callback recv))
    
    (state-results current-state))
  
  (values run show))

#;(module+ main
  (define-values (runner show) (foo 8))
  
  (runner
   '(run 1 (q) (== q 1))
   '(run 1 (q) (== q 2))
   '(run 1 (q) (== q 3))
   '(run 1 (q) (== q 4))
   '(run 1 (q) (== q 5))
   '(run 1 (q) (== q 6))
   '(let ()
      (sleep 30)
      7
      )
   '(let ()
      (define (nevero)
        (conde
         [(== 1 2)]
         [(nevero)]))
      (run 1 (q) (nevero)))))