Split out dataspace.rkt
This commit is contained in:
parent
7a9f52b97c
commit
40310a0eb3
|
@ -0,0 +1,60 @@
|
||||||
|
#lang racket/base
|
||||||
|
|
||||||
|
(provide (all-from-out "schemas/gen/dataspace.rkt")
|
||||||
|
(all-from-out "schemas/gen/dataspace-patterns.rkt")
|
||||||
|
(all-from-out "schemas/gen/dataspace-patterns.meta.rkt")
|
||||||
|
|
||||||
|
dataspace)
|
||||||
|
|
||||||
|
(require racket/match)
|
||||||
|
|
||||||
|
(require preserves)
|
||||||
|
|
||||||
|
(require "bag.rkt")
|
||||||
|
(require "main.rkt")
|
||||||
|
|
||||||
|
(require "schemas/gen/dataspace.rkt")
|
||||||
|
(require "schemas/gen/dataspace-patterns.rkt")
|
||||||
|
(require "schemas/gen/dataspace-patterns.meta.rkt")
|
||||||
|
|
||||||
|
(define (dataspace)
|
||||||
|
(define handles (make-hash))
|
||||||
|
(define assertions (make-bag))
|
||||||
|
(define subscriptions (make-hash))
|
||||||
|
(entity #:assert (action (rec handle)
|
||||||
|
(log-info "+ ~v ~v" handle rec)
|
||||||
|
(when (record? rec)
|
||||||
|
(hash-set! handles handle rec)
|
||||||
|
(when (eq? (bag-change! assertions rec +1) 'absent->present)
|
||||||
|
(match (parse-Observe rec)
|
||||||
|
[(? eof-object?) (void)]
|
||||||
|
[(Observe label observer)
|
||||||
|
(define seen (make-hash))
|
||||||
|
(hash-set! (hash-ref! subscriptions label make-hasheq) observer seen)
|
||||||
|
(for [(existing (in-bag assertions))]
|
||||||
|
(when (preserve=? (record-label existing) label)
|
||||||
|
(hash-set! seen existing (turn-assert! this-turn observer existing))))])
|
||||||
|
(for [((observer seen) (in-hash (hash-ref subscriptions (record-label rec) '#hash())))]
|
||||||
|
(unless (hash-has-key? seen rec)
|
||||||
|
(hash-set! seen rec (turn-assert! this-turn observer rec)))))))
|
||||||
|
#:retract (action (upstream-handle)
|
||||||
|
(define rec (hash-ref handles upstream-handle #f))
|
||||||
|
(log-info "- ~v ~v" upstream-handle rec)
|
||||||
|
(when rec
|
||||||
|
(hash-remove! handles upstream-handle)
|
||||||
|
(when (eq? (bag-change! assertions rec -1) 'present->absent)
|
||||||
|
(for [(seen (in-hash-values (hash-ref subscriptions (record-label rec) '#hash())))]
|
||||||
|
(turn-retract! this-turn (hash-ref seen rec))
|
||||||
|
(hash-remove! seen rec))
|
||||||
|
(match (parse-Observe rec)
|
||||||
|
[(? eof-object?) (void)]
|
||||||
|
[(Observe label observer)
|
||||||
|
(let ((subscribers (hash-ref subscriptions label)))
|
||||||
|
(hash-remove! subscribers observer)
|
||||||
|
(when (hash-empty? subscribers)
|
||||||
|
(hash-remove! subscriptions label)))]))))
|
||||||
|
#:message (action (message)
|
||||||
|
(log-info "! ~v" message)
|
||||||
|
(when (record? message)
|
||||||
|
(for [(peer (in-hash-keys (hash-ref subscriptions (record-label message) '#hash())))]
|
||||||
|
(turn-message! this-turn peer message))))))
|
|
@ -1,14 +1,12 @@
|
||||||
#lang racket/base
|
#lang racket/base
|
||||||
|
|
||||||
(require racket/match)
|
(require racket/match)
|
||||||
(require preserves)
|
|
||||||
|
|
||||||
(require (except-in "main.rkt" actor-system))
|
(require "main.rkt")
|
||||||
(require "bag.rkt")
|
(require "dataspace.rkt")
|
||||||
|
|
||||||
(require "schemas/gen/box-protocol.rkt")
|
(require "schemas/gen/box-protocol.rkt")
|
||||||
(require "schemas/gen/dataspace.rkt")
|
|
||||||
|
|
||||||
(require "syntax.rkt")
|
|
||||||
(require (only-in "pattern.rkt" :pattern))
|
(require (only-in "pattern.rkt" :pattern))
|
||||||
|
|
||||||
(define box
|
(define box
|
||||||
|
@ -59,48 +57,6 @@
|
||||||
;; (stop-facet root-facet)))
|
;; (stop-facet root-facet)))
|
||||||
))))
|
))))
|
||||||
|
|
||||||
(define (dataspace)
|
|
||||||
(define handles (make-hash))
|
|
||||||
(define assertions (make-bag))
|
|
||||||
(define subscriptions (make-hash))
|
|
||||||
(entity #:assert (action (rec handle)
|
|
||||||
(log-info "+ ~v ~v" handle rec)
|
|
||||||
(when (record? rec)
|
|
||||||
(hash-set! handles handle rec)
|
|
||||||
(when (eq? (bag-change! assertions rec +1) 'absent->present)
|
|
||||||
(match (parse-Observe rec)
|
|
||||||
[(? eof-object?) (void)]
|
|
||||||
[(Observe label observer)
|
|
||||||
(define seen (make-hash))
|
|
||||||
(hash-set! (hash-ref! subscriptions label make-hasheq) observer seen)
|
|
||||||
(for [(existing (in-bag assertions))]
|
|
||||||
(when (preserve=? (record-label existing) label)
|
|
||||||
(hash-set! seen existing (turn-assert! this-turn observer existing))))])
|
|
||||||
(for [((observer seen) (in-hash (hash-ref subscriptions (record-label rec) '#hash())))]
|
|
||||||
(unless (hash-has-key? seen rec)
|
|
||||||
(hash-set! seen rec (turn-assert! this-turn observer rec)))))))
|
|
||||||
#:retract (action (upstream-handle)
|
|
||||||
(define rec (hash-ref handles upstream-handle #f))
|
|
||||||
(log-info "- ~v ~v" upstream-handle rec)
|
|
||||||
(when rec
|
|
||||||
(hash-remove! handles upstream-handle)
|
|
||||||
(when (eq? (bag-change! assertions rec -1) 'present->absent)
|
|
||||||
(for [(seen (in-hash-values (hash-ref subscriptions (record-label rec) '#hash())))]
|
|
||||||
(turn-retract! this-turn (hash-ref seen rec))
|
|
||||||
(hash-remove! seen rec))
|
|
||||||
(match (parse-Observe rec)
|
|
||||||
[(? eof-object?) (void)]
|
|
||||||
[(Observe label observer)
|
|
||||||
(let ((subscribers (hash-ref subscriptions label)))
|
|
||||||
(hash-remove! subscribers observer)
|
|
||||||
(when (hash-empty? subscribers)
|
|
||||||
(hash-remove! subscriptions label)))]))))
|
|
||||||
#:message (action (message)
|
|
||||||
(log-info "! ~v" message)
|
|
||||||
(when (record? message)
|
|
||||||
(for [(peer (in-hash-keys (hash-ref subscriptions (record-label message) '#hash())))]
|
|
||||||
(turn-message! this-turn peer message))))))
|
|
||||||
|
|
||||||
(module+ main
|
(module+ main
|
||||||
(time
|
(time
|
||||||
(actor-system
|
(actor-system
|
||||||
|
|
|
@ -1,19 +1,11 @@
|
||||||
#lang racket/base
|
#lang racket/base
|
||||||
|
|
||||||
(provide (all-from-out "actor.rkt"))
|
(provide (all-from-out "actor.rkt")
|
||||||
|
(all-from-out "syntax.rkt")
|
||||||
|
(all-from-out preserves))
|
||||||
|
|
||||||
(require "actor.rkt")
|
(require (except-in "actor.rkt" actor-system))
|
||||||
|
(require "syntax.rkt")
|
||||||
;; (provide (all-from-out "dataspace.rkt")
|
(require preserves)
|
||||||
;; (all-from-out "assertions.rkt")
|
|
||||||
;; (all-from-out "syntax.rkt")
|
|
||||||
;; (all-from-out "ground.rkt")
|
|
||||||
;; (all-from-out "relay.rkt"))
|
|
||||||
|
|
||||||
;; (module reader syntax/module-reader syndicate/lang)
|
;; (module reader syntax/module-reader syndicate/lang)
|
||||||
|
|
||||||
;; (require "dataspace.rkt")
|
|
||||||
;; (require "assertions.rkt")
|
|
||||||
;; (require "syntax.rkt")
|
|
||||||
;; (require "ground.rkt")
|
|
||||||
;; (require "relay.rkt")
|
|
||||||
|
|
Loading…
Reference in New Issue