syndicate-lang
/
minimart-2014
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

Driver and example updates from fastrouting branch.

This commit is contained in:
Tony Garnock-Jones 2014-05-14 13:45:42 -04:00
parent 6dc52115e3
commit dc54c31ab2
3 changed files with 76 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

12
minimart/drivers/timer.rkt
View File

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

47
minimart/examples/example-lang.rkt
View File

@ -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 . ,?)))

44
minimart/examples/example-plain.rkt
View File

@ -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 . ,?))))