52 lines
2.2 KiB
Racket
52 lines
2.2 KiB
Racket
#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 "skeleton.rkt")
|
|
|
|
(require "schemas/gen/dataspace.rkt")
|
|
(require "schemas/gen/dataspace-patterns.rkt")
|
|
(require "schemas/gen/dataspace-patterns.meta.rkt")
|
|
|
|
(define-logger syndicate/dataspace)
|
|
|
|
(define (dataspace)
|
|
(define handles (make-hash))
|
|
(define assertions (make-bag))
|
|
(define skeleton (make-empty-skeleton))
|
|
(define ds-e
|
|
(entity #:assert (action (value handle)
|
|
(log-syndicate/dataspace-debug "~v + ~v ~v" ds-e handle value)
|
|
(define maybe-observe (parse-Observe value))
|
|
(hash-set! handles handle (cons value maybe-observe))
|
|
(when (eq? (bag-change! assertions value +1) 'absent->present)
|
|
(match maybe-observe
|
|
[(? eof-object?) (void)]
|
|
[(Observe pat ref) (add-interest! this-turn skeleton pat ref)])
|
|
(add-assertion! this-turn skeleton value)))
|
|
#:retract (action (upstream-handle)
|
|
(match (hash-ref handles upstream-handle #f)
|
|
[#f (error 'dataspace "Peer retracted unknown handle ~v" upstream-handle)]
|
|
[(cons value maybe-observe)
|
|
(log-syndicate/dataspace-debug "~v - ~v ~v" ds-e upstream-handle value)
|
|
(hash-remove! handles upstream-handle)
|
|
(when (eq? (bag-change! assertions value -1) 'present->absent)
|
|
(remove-assertion! this-turn skeleton value)
|
|
(match maybe-observe
|
|
[(? eof-object?) (void)]
|
|
[(Observe pat ref) (remove-interest! this-turn skeleton pat ref)]))]))
|
|
#:message (action (message)
|
|
(log-syndicate/dataspace-debug "~v ! ~v" ds-e message)
|
|
(send-assertion! this-turn skeleton message))))
|
|
ds-e)
|