Gestalt-based ground.rkt

This commit is contained in:
Tony Garnock-Jones 2014-05-13 23:15:36 -04:00
parent 2462c686ec
commit 7fc0875228
1 changed files with 15 additions and 11 deletions

View File

@ -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)]