Rename meta-message-handler to ground-message-handler

This commit is contained in:
Tony Garnock-Jones 2012-01-16 18:29:32 -05:00
parent d24ca2a2c8
commit 16b4dc413e
3 changed files with 22 additions and 11 deletions

View File

@ -17,7 +17,7 @@
(define sid `(read-line-transaction ,reply-addr))
(transition w
(subscribe sid
(meta-message-handler w
(ground-message-handler w
[((read-line-evt (current-input-port) 'any) => l)
(transition w
(unsubscribe sid)
@ -30,7 +30,7 @@
(define (tick-driver self-sid interval)
(let loop ((last-tick-time 0) (counter 0))
(subscribe self-sid
(meta-message-handler w
(ground-message-handler w
[((time-evt (+ last-tick-time interval)) => now)
(transition w
(unsubscribe self-sid)

View File

@ -16,7 +16,8 @@
(struct-out on-message)
(struct-out on-meta-message)
message-handlers
meta-message-handler
meta-message-handlers
ground-message-handler
(except-out (struct-out transition) transition)
(rename-out [make-transition transition])
@ -58,16 +59,26 @@
;; representation of a suspended world and its active subscriptions.
(struct world (state subscriptions) #:transparent)
(define-syntax message-handlers*
(syntax-rules ()
((_ action-constructor old-state-pattern [pattern body ...] ...)
(action-constructor (match-lambda [pattern #t] ... [_ #f])
(lambda (message old-state)
(match-define old-state-pattern old-state)
(match message
[pattern body ...] ...))))))
(define-syntax message-handlers
(syntax-rules ()
((_ old-state-pattern [pattern body ...] ...)
(on-message (match-lambda [pattern #t] ... [_ #f])
(lambda (message old-state)
(match-define old-state-pattern old-state)
(match message
[pattern body ...] ...))))))
(message-handlers* on-message old-state-pattern [pattern body ...] ...))))
(define-syntax meta-message-handler
(define-syntax meta-message-handlers
(syntax-rules ()
((_ old-state-pattern [pattern body ...] ...)
(message-handlers* on-meta-message old-state-pattern [pattern body ...] ...))))
(define-syntax ground-message-handler
(syntax-rules (=>)
((_ old-state-pattern [(raw-pattern => pattern) body ...])
(on-meta-message raw-pattern

View File

@ -57,7 +57,7 @@
(unsubscribe 'ticker))]))
(let loop ((next-alarm-time 0))
(subscribe 'ticker
(meta-message-handler
(ground-message-handler
(and w (ticker-state counter interval limit))
[((time-evt next-alarm-time) => now)
(if (and (positive? limit) (>= counter limit))
@ -105,7 +105,7 @@
(list
(spawn (os-big-bang 'none
(subscribe 'inbound-relay
(meta-message-handler w
(ground-message-handler w
[(c:ui->world => message)
(transition w (send-message message))]))
(subscribe 'stopper