Gestalt-based ground.rkt
This commit is contained in:
parent
2462c686ec
commit
7fc0875228
|
@ -1,5 +1,6 @@
|
|||
#lang racket/base
|
||||
|
||||
(require racket/set)
|
||||
(require racket/match)
|
||||
(require racket/list)
|
||||
(require "core.rkt")
|
||||
|
@ -12,15 +13,18 @@
|
|||
(define (event-handler descriptor)
|
||||
(handle-evt descriptor (lambda vs (send (event descriptor vs)))))
|
||||
|
||||
(define (extract-active-events routes)
|
||||
(filter-map (lambda (r)
|
||||
(and (route-subscription? r)
|
||||
(zero? (route-meta-level r))
|
||||
(zero? (route-level r))
|
||||
(match (route-pattern r)
|
||||
[(event descriptor (? wildcard?)) (event-handler descriptor)]
|
||||
[_ #f])))
|
||||
routes))
|
||||
(define event-projection (compile-gestalt-projection (event ?! ?)))
|
||||
|
||||
(define (extract-active-events gestalt)
|
||||
(define es (gestalt-project->finite-set gestalt 0 0 #f event-projection))
|
||||
;; TODO: how should the following error be handled, ideally?
|
||||
;; In principle, security restrictions should make it impossible.
|
||||
;; But absent those, what should be done? Should an offending
|
||||
;; process be identified and terminated?
|
||||
(when (not es) (error 'extract-active-events "User program subscribed to wildcard event"))
|
||||
(for/list [(ev (in-set es))]
|
||||
(match-define (vector e) ev)
|
||||
(event-handler e)))
|
||||
|
||||
(define idle-handler
|
||||
(handle-evt (system-idle-evt) (lambda _ #f)))
|
||||
|
@ -44,8 +48,8 @@
|
|||
(await-interrupt #f (struct-copy process p [state new-state]) active-events)]
|
||||
[(cons a actions)
|
||||
(match a
|
||||
[(routing-update routes)
|
||||
(process-actions actions (extract-active-events routes))]
|
||||
[(routing-update gestalt)
|
||||
(process-actions actions (extract-active-events gestalt))]
|
||||
[(quit)
|
||||
(log-info "run-ground: Terminating by request")
|
||||
(void)]
|
||||
|
|
Loading…
Reference in New Issue