syndicate-rkt/syndicate/ground.rkt

84 lines
3 KiB
Racket
Raw Normal View History

2018-04-29 11:22:12 +00:00
#lang racket/base
;; Breaking the infinite tower of nested dataspaces, connecting to Racket at the fracture line.
2018-04-29 11:22:12 +00:00
(provide current-ground-event-async-channel
ground-send!
ground-assert!
ground-retract!
signal-background-activity!
run-ground)
2018-04-29 11:22:12 +00:00
(define-logger syndicate/ground)
(require racket/async-channel)
(require racket/set)
(require racket/match)
(require racket/list)
2018-04-29 11:22:12 +00:00
(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))
2018-04-29 11:22:12 +00:00
2018-05-01 16:34:34 +00:00
(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-syndicate/ground-debug "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))]))))
2018-05-01 16:34:34 +00:00
(define (run-ground boot-proc)
(if (equal? (getenv "SYNDICATE_PROFILE") "ground")
(let ()
(local-require profile)
(profile (run-ground* boot-proc)))
(run-ground* boot-proc)))