new-places-experiment.rkt

#lang racket/base

(require racket/place
         racket/list
         racket/sequence
         (except-in racket/match ==)
         minikanren)

(define-syntax-rule (forever proc)
  (let loop () (proc) (loop)))

(define-namespace-anchor anchor)

(define (eval-in-fresh-namespace code)
  (parameterize ([current-namespace (namespace-anchor->empty-namespace anchor)])
    (namespace-require 'minikanren)
    (namespace-require '(only racket/base sleep))
    (eval code)))

(define (run-in-place)
  (define p 
    (place ch
      (forever
       (lambda ()
         (with-handlers ([(lambda (x) #t) (lambda (x) (void))])
           (place-channel-put ch 'ready)
           (let* ([code (place-channel-get ch)]
                  [value (eval-in-fresh-namespace code)])
             (place-channel-put ch value))
           ; block until break for new job
           (sync never-evt))))))
  (match-define 'ready (place-channel-get p))
  p)

(define (start-places num-places)
  (define p*
    (for/list ([i (range num-places)])
      (run-in-place)))
  
  (define current-state #f)
  
  (define (run . expr*)    
    (set! current-state (make-list (length expr*) 'running))
    
    (for ([p p*] [expr expr*])
      (place-break p)
      (sequence-length (in-producer (lambda () (place-channel-get p)) 'ready))
      (place-channel-put p expr)))
  
  (define (check-for-updates!)
    (for ([(p i) (in-indexed p*)])
      (sync/timeout 0
        (handle-evt p
          (lambda (result)
            (set! current-state (list-set current-state i result)))))))
  
  (define (show)
    (check-for-updates!)    
    current-state)
  
  (values run show))

(module+ main
  (define-values (runner show) (start-places 3))
  
  (define (test-run)
    (runner
     '(run 1 (q) (== q 1))
     '(let ()
        (sleep 5)
        2)
     '(let ()
        (define (nevero)
          (conde
           [(== 1 2)]
           [(nevero)]))
        (run 1 (q) (nevero)))))
  
  (test-run)
  
  (displayln (show))
  (sleep 6)
  (displayln (show))
  
  (test-run)
  
  (forever
   (lambda ()
     (displayln (show))
     (sleep 3))))