syndicate-rkt/syndicate/ground.rkt

#lang racket/base
;; Breaking the infinite tower of nested dataspaces, connecting to Racket at the fracture line.

(provide current-ground-event-async-channel
         ground-send!
         ground-assert!
         ground-retract!
         signal-background-activity!
         run-ground)

(define-logger syndicate/ground)

(require racket/async-channel)
(require racket/set)
(require racket/match)
(require racket/list)
(require "dataspace.rkt")
(require "syntax.rkt")

(define current-ground-event-async-channel (make-parameter #f))

(define (ground-enqueue! item)
  (async-channel-put (current-ground-event-async-channel) item))

(define (ground-send! body)
  (ground-enqueue! (lambda (ac) (enqueue-send! ac body))))

(define (ground-assert! assertion)
  (ground-enqueue! (lambda (ac) (adhoc-assert! ac assertion))))

(define (ground-retract! assertion)
  (ground-enqueue! (lambda (ac) (adhoc-retract! ac assertion))))

(define (signal-background-activity! delta)
  (ground-enqueue! delta))

(define (run-ground boot-proc)
  (define ch (make-async-channel))
  (parameterize ((current-ground-event-async-channel ch))
    (define ground-event-relay-actor #f)
    (define background-activity-count 0)

    (define ground-event-relay-evt
      (handle-evt ch (lambda (item)
                       (match item
                         [(? procedure? proc)
                          (push-script! ground-event-relay-actor
                                        (lambda () (proc ground-event-relay-actor)))]
                         [(? number? delta)
                          (set! background-activity-count (+ background-activity-count delta))]))))

    (define ds (make-dataspace
                (lambda ()
                  (schedule-script! (current-actor)
                                    (lambda ()
                                      (spawn #:name 'ground-event-relay
                                             (set! ground-event-relay-actor (current-actor))
                                             ;; v Adds a dummy endpoint to keep this actor alive
                                             (begin/dataflow (void)))))
                  (schedule-script! (current-actor) boot-proc))))

    (let loop ()
      (define work-remaining? (run-scripts! ds))
      (define events-expected? (positive? background-activity-count))
      (log-info "GROUND: ~a; ~a background activities"
                (if work-remaining? "busy" "idle")
                background-activity-count)
      (cond
        [events-expected?
         (sync ground-event-relay-evt (if work-remaining? (system-idle-evt) never-evt))
         (loop)]
        [work-remaining?
         (sync ground-event-relay-evt (system-idle-evt))
         (loop)]
        [else
         (sync (handle-evt ground-event-relay-evt (lambda _ (loop))) (system-idle-evt))]))))