From dc54c31ab279106c904fbf0768e436050143ea31 Mon Sep 17 00:00:00 2001 From: Tony Garnock-Jones Date: Wed, 14 May 2014 13:45:42 -0400 Subject: [PATCH] Driver and example updates from fastrouting branch. --- minimart/drivers/timer.rkt | 12 ++++---- minimart/examples/example-lang.rkt | 47 ++++++++++++++++++++++------- minimart/examples/example-plain.rkt | 44 +++++++++++++++++++++------ 3 files changed, 76 insertions(+), 27 deletions(-) diff --git a/minimart/drivers/timer.rkt b/minimart/drivers/timer.rkt index ea903aa..9151eca 100644 --- a/minimart/drivers/timer.rkt +++ b/minimart/drivers/timer.rkt @@ -48,12 +48,12 @@ (define (timer-subscriptions s) (define t (next-timer (driver-state-heap s))) - (append (list (sub (set-timer ? ? 'relative)) - (sub (set-timer ? ? 'absolute)) - (pub (timer-expired ? ?))) - (if t - (list (sub (event (timer-evt (pending-timer-deadline t)) ?) #:meta-level 1)) - '()))) + (gestalt-union (sub (set-timer ? ? 'relative)) + (sub (set-timer ? ? 'absolute)) + (pub (timer-expired ? ?)) + (if t + (sub (event (timer-evt (pending-timer-deadline t)) ?) #:meta-level 1) + (gestalt-empty)))) (define (spawn-timer-driver) (define s (driver-state (make-timer-heap))) diff --git a/minimart/examples/example-lang.rkt b/minimart/examples/example-lang.rkt index 0510181..ec77f43 100644 --- a/minimart/examples/example-lang.rkt +++ b/minimart/examples/example-lang.rkt @@ -1,10 +1,11 @@ #lang minimart (require (only-in racket/port read-line-evt)) +(require "../drivers/timer.rkt") (define (r e s) (match e - [(message body _ _) (transition s (send `(got ,body) #:meta-level 1))] + [(message body _ _) (transition s (send `(print got ,body) #:meta-level 1))] [_ #f])) (define (b e n) @@ -14,20 +15,44 @@ #f)] [_ #f])) -(spawn-world (spawn r (void) (list (sub ?))) +(spawn-world (spawn r (void) (sub ?)) (spawn b 0)) -(define (spy e s) - (when e (log-info "SPY: ~v" e)) - #f) - -(spawn spy (void) (list (sub ? #:level 1000) (pub ? #:level 1000))) - (define (echoer e s) (match e [(message (event _ (list (? eof-object?))) _ _) (transition s (quit))] - [(message (event _ (list line)) _ _) (transition s (send `(got-line ,line)))] + [(message (event _ (list line)) _ _) (transition s (send `(print got-line ,line)))] [_ #f])) -(spawn echoer (void) (list (sub (event (read-line-evt (current-input-port) 'any) ?) - #:meta-level 1))) +(spawn echoer (void) (sub (event (read-line-evt (current-input-port) 'any) ?) + #:meta-level 1)) + +(define (ticker e s) + (match e + [(routing-update g) + (printf "EMPTY? ~v\n" (gestalt-empty? g)) + (printf "REF:") + (pretty-print-matcher (gestalt-ref g 0 0 #f) #:indent 4) + (printf "INTERSECTED:\n") + (pretty-print-gestalt (gestalt-intersect g (sub (set-timer ? ? ?)))) + #f] + [(message (timer-expired 'tick now) _ _) + (printf "TICK ~v\n" now) + (transition (+ s 1) (if (< s 3) + (send (set-timer 'tick 1000 'relative)) + (quit)))] + [_ #f])) + +(spawn-timer-driver) +(send (set-timer 'tick 1000 'relative)) +(spawn ticker 1 (gestalt-union (pub (set-timer ? ? ?) #:level 1) + (sub (timer-expired 'tick ?)))) + +(define (printer e s) + (match e + [(message (cons 'print v) _ _) + (log-info "PRINTER: ~a" v) + #f] + [_ #f])) + +(spawn printer (void) (sub `(print . ,?))) diff --git a/minimart/examples/example-plain.rkt b/minimart/examples/example-plain.rkt index 6a1dbf1..ff76989 100644 --- a/minimart/examples/example-plain.rkt +++ b/minimart/examples/example-plain.rkt @@ -3,10 +3,11 @@ (require racket/match) (require (only-in racket/port read-line-evt)) (require "../main.rkt") +(require "../drivers/timer.rkt") (define (r e s) (match e - [(message body _ _) (transition s (send `(got ,body) #:meta-level 1))] + [(message body _ _) (transition s (send `(print got ,body) #:meta-level 1))] [_ #f])) (define (b e n) @@ -16,18 +17,41 @@ #f)] [_ #f])) -(define (spy e s) - (when e (log-info "SPY: ~v" e)) - #f) - (define (echoer e s) (match e [(message (event _ (list (? eof-object?))) _ _) (transition s (quit))] - [(message (event _ (list line)) _ _) (transition s (send `(got-line ,line)))] + [(message (event _ (list line)) _ _) (transition s (send `(print got-line ,line)))] [_ #f])) -(run-ground (spawn-world (spawn r (void) (list (sub ?))) +(define (ticker e s) + (match e + [(routing-update g) + (printf "EMPTY? ~v\n" (gestalt-empty? g)) + (printf "REF:") + (pretty-print-matcher (gestalt-ref g 0 0 #f) #:indent 4) + (printf "INTERSECTED:\n") + (pretty-print-gestalt (gestalt-intersect g (sub (set-timer ? ? ?)))) + #f] + [(message (timer-expired 'tick now) _ _) + (printf "TICK ~v\n" now) + (transition (+ s 1) (if (< s 3) + (send (set-timer 'tick 1000 'relative)) + (quit)))] + [_ #f])) + +(define (printer e s) + (match e + [(message (cons 'print v) _ _) + (log-info "PRINTER: ~a" v) + #f] + [_ #f])) + +(run-ground (spawn-timer-driver) + (send (set-timer 'tick 1000 'relative)) + (spawn ticker 1 (gestalt-union (pub (set-timer ? ? ?) #:level 1) + (sub (timer-expired 'tick ?)))) + (spawn-world (spawn r (void) (sub ?)) (spawn b 0)) - (spawn echoer (void) (list (sub (event (read-line-evt (current-input-port) 'any) ?) - #:meta-level 1))) - (spawn spy (void) (list (sub ? #:level 1000) (pub ? #:level 1000)))) + (spawn echoer (void) (sub (event (read-line-evt (current-input-port) 'any) ?) + #:meta-level 1)) + (spawn printer (void) (sub `(print . ,?))))