swap the meaning of spawn and actor in racket syndicate
This commit is contained in:
parent
413840382b
commit
9c1e9719ba
|
@ -134,7 +134,7 @@
|
|||
|
||||
;; KeyboardIntegrator. Integrates key-events into key-pressed assertions.
|
||||
(define (spawn-keyboard-integrator #:meta-level [meta-level 1])
|
||||
(spawn (lambda (e s)
|
||||
(actor (lambda (e s)
|
||||
(match e
|
||||
[(message (inbound* meta-level (key-event code press? _)))
|
||||
(transition (void) ((if press? assert retract) (key-pressed code)))]
|
||||
|
@ -145,7 +145,7 @@
|
|||
;; MouseIntegrator. Integrates mouse-events into mouse-state assertions.
|
||||
(define (spawn-mouse-integrator #:meta-level [meta-level 1])
|
||||
(define retract-state (retract (mouse-state ? ? ? ? ?)))
|
||||
(spawn (lambda (e s)
|
||||
(actor (lambda (e s)
|
||||
(match e
|
||||
[(message (inbound* meta-level (mouse-event 'leave _)))
|
||||
(transition (void) retract-state)]
|
||||
|
@ -434,7 +434,7 @@
|
|||
(define current-coordinate-maps (hash))
|
||||
|
||||
(define-values (proc pending-transition)
|
||||
(spawn->process+transition (spawn-dataspace boot-actions)))
|
||||
(actor->process+transition (spawn-dataspace boot-actions)))
|
||||
(define event-queue (make-queue))
|
||||
|
||||
(define target-frame-rate 60)
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
(require "../2d.rkt")
|
||||
|
||||
(define (spawn-background)
|
||||
(actor
|
||||
(spawn
|
||||
(during (inbound (window $width $height))
|
||||
(assert (outbound
|
||||
(scene (seal `((push-matrix (scale ,width ,(* height 2))
|
||||
|
@ -37,7 +37,7 @@
|
|||
(define (draggable-shape name orig-x orig-y z plain-image hover-image
|
||||
#:coordinate-map-id [coordinate-map-id #f]
|
||||
#:parent [parent-id #f])
|
||||
(actor (field [x orig-x] [y orig-y])
|
||||
(spawn (field [x orig-x] [y orig-y])
|
||||
(define/query-value touching? #f (inbound (touching name)) #t)
|
||||
(assert (outbound (simple-sprite #:parent parent-id
|
||||
#:coordinate-map-id coordinate-map-id
|
||||
|
@ -70,7 +70,7 @@
|
|||
(local-require 2htdp/planetcute)
|
||||
(define CC character-cat-girl)
|
||||
|
||||
(actor (field [x 100] [y 100])
|
||||
(spawn (field [x 100] [y 100])
|
||||
(assert (outbound (simple-sprite #:touchable-id 'player
|
||||
#:coordinate-map-id 'player
|
||||
-0.5 (x) (y) (image-width CC) (image-height CC) CC)))
|
||||
|
@ -99,7 +99,7 @@
|
|||
(y ny)))))
|
||||
|
||||
(define (spawn-frame-counter)
|
||||
(actor (field [i empty-image])
|
||||
(spawn (field [i empty-image])
|
||||
(assert (outbound
|
||||
(simple-sprite -10 300 10 (image-width (i)) (image-height (i)) (i))))
|
||||
(on (message (inbound (frame-event $counter $sim-time-ms _ _)))
|
||||
|
@ -125,10 +125,10 @@
|
|||
(circle 50 "solid" "green")
|
||||
(circle 50 "solid" "cyan"))
|
||||
|
||||
(actor* (until (message (inbound (key-event #\q #t _))))
|
||||
(spawn* (until (message (inbound (key-event #\q #t _))))
|
||||
(assert! (outbound 'stop)))
|
||||
|
||||
(actor (during (inbound (touching $id))
|
||||
(spawn (during (inbound (touching $id))
|
||||
(on-start (log-info "Touching ~v" id))
|
||||
(on-stop (log-info "No longer touching ~v" id))))
|
||||
|
||||
|
|
|
@ -32,7 +32,7 @@
|
|||
(define i (text content 24 "green"))
|
||||
(simple-sprite layer x y (image-width i) (image-height i) i))
|
||||
|
||||
(actor (field [minute-angle 0]
|
||||
(spawn (field [minute-angle 0]
|
||||
[hour-angle 0]
|
||||
[start-time (current-inexact-milliseconds)]
|
||||
[elapsed-seconds 0]
|
||||
|
|
|
@ -19,7 +19,7 @@
|
|||
(define sprite-count 20)
|
||||
|
||||
(define (spawn-background)
|
||||
(actor
|
||||
(spawn
|
||||
(during (inbound (window $width $height))
|
||||
(assert (outbound
|
||||
(scene (seal `((push-matrix (scale ,width ,height)
|
||||
|
@ -29,7 +29,7 @@
|
|||
(define i:logo (plt-logo))
|
||||
|
||||
(define (spawn-logo)
|
||||
(actor (field [x 100] [y 100])
|
||||
(spawn (field [x 100] [y 100])
|
||||
(field [dx (* (- (random) 0.5) speed-limit)]
|
||||
[dy (* (- (random) 0.5) speed-limit)])
|
||||
(define/query-value w #f (inbound ($ w (window _ _))) w)
|
||||
|
@ -56,14 +56,14 @@
|
|||
(for [(i sprite-count)]
|
||||
(spawn-logo))
|
||||
|
||||
(actor (on (message (inbound (frame-event $counter $timestamp _ _)))
|
||||
(spawn (on (message (inbound (frame-event $counter $timestamp _ _)))
|
||||
(when (and (zero? (modulo counter 100)) (positive? timestamp))
|
||||
(log-info "~v frames, ~v ms ==> ~v Hz"
|
||||
counter
|
||||
timestamp
|
||||
(/ counter (/ timestamp 1000.0))))))
|
||||
|
||||
(actor* (assert! (outbound 'fullscreen))
|
||||
(spawn* (assert! (outbound 'fullscreen))
|
||||
(until (message (inbound (key-event #\q #t _))))
|
||||
(assert! (outbound 'stop)))
|
||||
|
||||
|
|
|
@ -27,7 +27,7 @@ while the @racket[frame%] is active. If @racket[exit?] is true, calls
|
|||
|
||||
@defproc[(spawn-keyboard-integrator
|
||||
[#:meta-level meta-level natural-number/c 1])
|
||||
spawn?]{
|
||||
actor?]{
|
||||
KeyboardIntegrator. Integrates key-events into key-pressed assertions. The
|
||||
@racket[meta-level] must point to the root of the 2d dataspace, which defaults
|
||||
to assuming is one level removed.
|
||||
|
|
|
@ -60,7 +60,7 @@
|
|||
label)))))
|
||||
|
||||
(define (actor-view name parent-pid pid is-dataspace?)
|
||||
(actor #:name (list 'actor-view name pid)
|
||||
(spawn #:name (list 'actor-view name pid)
|
||||
|
||||
(field [pos #f])
|
||||
(define/query-value win #f (inbound (window $w $h)) (window w h)
|
||||
|
@ -123,7 +123,7 @@
|
|||
1x1-white-rectangle)))
|
||||
|
||||
(define (spawn-influence-view-factory)
|
||||
(actor #:name 'influence-view-factory
|
||||
(spawn #:name 'influence-view-factory
|
||||
(field [pairs (set)])
|
||||
(on (message (influence $subject $object))
|
||||
(define entry (cons subject object))
|
||||
|
@ -132,7 +132,7 @@
|
|||
(react
|
||||
(stop-when (retracted (view-position subject _)) (pairs (set-remove (pairs) entry)))
|
||||
(stop-when (retracted (view-position object _)) (pairs (set-remove (pairs) entry))))
|
||||
(actor #:name (list 'influence-view entry)
|
||||
(spawn #:name (list 'influence-view entry)
|
||||
(field [strength 1] [line-width 0])
|
||||
(define/query-value subject-pos #f (view-position subject $p) p)
|
||||
(define/query-value object-pos #f (view-position object $p) p)
|
||||
|
@ -153,7 +153,7 @@
|
|||
(strength (+ (strength) 1))))))))
|
||||
|
||||
(define (spawn-layout-engine)
|
||||
(actor #:name 'layout-engine
|
||||
(spawn #:name 'layout-engine
|
||||
(define/query-value win #f (inbound (window $w $h)) (window w h))
|
||||
(define/query-hash positions (view-position $pid $pos) pid pos)
|
||||
(define/query-set springs ($ s (spring _ _ _ _ _)) s)
|
||||
|
@ -213,7 +213,7 @@
|
|||
(with-store ((current-trace-procedures '()))
|
||||
((2d-dataspace #:label "Syndicate IDE" #:exit? exit?)
|
||||
|
||||
(actor #:name 'user-thread-death-monitor
|
||||
(spawn #:name 'user-thread-death-monitor
|
||||
(field [user-thread-running? #t])
|
||||
(assert #:when (user-thread-running?) 'user-thread-running)
|
||||
(on (message (inbound (? frame-event? _)))
|
||||
|
@ -222,7 +222,7 @@
|
|||
;; Ground dataspace
|
||||
(actor-view 'ground #f '() #t)
|
||||
|
||||
(actor #:name 'notification-relay
|
||||
(spawn #:name 'notification-relay
|
||||
(on (message (inbound (? frame-event? _)))
|
||||
(let loop ()
|
||||
(define n (async-channel-try-get from-user-thread-ch))
|
||||
|
@ -245,14 +245,14 @@
|
|||
(send! n)])
|
||||
(when n (loop)))))
|
||||
|
||||
(actor #:name 'quit-listener
|
||||
(spawn #:name 'quit-listener
|
||||
(on (message (inbound (key-event #\q #t _)))
|
||||
(assert! (outbound 'stop))))
|
||||
|
||||
(spawn-influence-view-factory)
|
||||
(spawn-layout-engine)
|
||||
|
||||
;; (actor #:name 'debug
|
||||
;; (spawn #:name 'debug
|
||||
;; (on (message (? trace-notification? $n))
|
||||
;; (log-info "INBOUND: ~v --~v--> ~v"
|
||||
;; (trace-notification-source n)
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
#lang racket/base
|
||||
|
||||
(provide actor
|
||||
actor*
|
||||
(provide spawn
|
||||
spawn*
|
||||
dataspace
|
||||
|
||||
react
|
||||
|
@ -19,7 +19,7 @@
|
|||
on-event*
|
||||
on
|
||||
during
|
||||
during/actor
|
||||
during/spawn
|
||||
begin/dataflow
|
||||
define/dataflow
|
||||
|
||||
|
@ -251,8 +251,8 @@
|
|||
|
||||
(begin-for-syntax
|
||||
(define-splicing-syntax-class actor-wrapper
|
||||
(pattern (~seq #:actor wrapper))
|
||||
(pattern (~seq) #:attr wrapper #'actor))
|
||||
(pattern (~seq #:spawn wrapper))
|
||||
(pattern (~seq) #:attr wrapper #'spawn))
|
||||
|
||||
(define-splicing-syntax-class on-crash-option
|
||||
(pattern (~seq #:on-crash expr))
|
||||
|
@ -281,13 +281,13 @@
|
|||
(syntax-parse stx
|
||||
[(_ name:name script ...)
|
||||
(quasisyntax/loc stx
|
||||
(core:make-spawn
|
||||
(core:make-actor
|
||||
(lambda ()
|
||||
(list actor-behavior
|
||||
(boot-actor (lambda () (begin/void-default script ...)))
|
||||
name.N))))]))
|
||||
|
||||
(define-syntax (actor stx)
|
||||
(define-syntax (spawn stx)
|
||||
(syntax-parse stx
|
||||
[(_ (~or (~optional (~seq #:name name-expr) #:defaults ([name-expr #'#f])
|
||||
#:name "#:name")
|
||||
|
@ -301,7 +301,7 @@
|
|||
(schedule-action! spawn-action)
|
||||
spawn-action)))]))
|
||||
|
||||
(define-syntax (actor* stx)
|
||||
(define-syntax (spawn* stx)
|
||||
(syntax-parse stx
|
||||
[(_ name:name script ...)
|
||||
(quasisyntax/loc stx
|
||||
|
@ -448,7 +448,7 @@
|
|||
(react (stop-when (retracted p))
|
||||
O ...))))]))
|
||||
|
||||
(define-syntax (during/actor stx)
|
||||
(define-syntax (during/spawn stx)
|
||||
(syntax-parse stx
|
||||
[(_ P w:actor-wrapper name:name parent-let:let-option oncrash:on-crash-option O ...)
|
||||
(define E-stx (syntax/loc #'P (asserted P)))
|
||||
|
@ -456,7 +456,7 @@
|
|||
(analyze-pattern E-stx #'P))
|
||||
(quasisyntax/loc stx
|
||||
(on #,E-stx
|
||||
(let* ((id (gensym 'during/actor))
|
||||
(let* ((id (gensym 'during/spawn))
|
||||
(p #,instantiated) ;; this is the concrete assertion corresponding to demand
|
||||
(inst (instance id p))) ;; this is the assertion representing supply
|
||||
(react (stop-when (asserted inst)
|
||||
|
|
|
@ -134,7 +134,7 @@
|
|||
|
||||
(define-syntax-rule (big-bang-dataspace* boot-actions extra-clause ...)
|
||||
(let-values (((proc initial-transition)
|
||||
(spawn->process+transition (spawn-dataspace boot-actions))))
|
||||
(actor->process+transition (spawn-dataspace boot-actions))))
|
||||
(big-bang (interpret-actions (bb proc
|
||||
'()
|
||||
'()
|
||||
|
|
|
@ -33,7 +33,7 @@
|
|||
(define (spawn-broker-server port
|
||||
#:hostname [hostname ?]
|
||||
#:path [resource-path-str "/"])
|
||||
(actor #:name 'broker:dm
|
||||
(spawn #:name 'broker:dm
|
||||
(on (web-request-get (id req)
|
||||
(web-virtual-host "http" hostname port)
|
||||
,(string->resource-path resource-path-str))
|
||||
|
@ -51,7 +51,7 @@
|
|||
(define (spawn-broker-server-connection req-id http-req
|
||||
#:scope [scope (http-req->scope http-req)]
|
||||
#:hook [hook void])
|
||||
(actor #:name (list 'broker:connection req-id)
|
||||
(spawn #:name (list 'broker:connection req-id)
|
||||
(hook)
|
||||
|
||||
(on-start (log-syndicate-broker-info "Starting broker connection ~v" req-id))
|
||||
|
@ -114,5 +114,5 @@
|
|||
(module+ main
|
||||
(run-ground
|
||||
(activate "..")
|
||||
(actor #:name 'broker:vh (assert (web-virtual-host "http" _ 8000)))
|
||||
(spawn #:name 'broker:vh (assert (web-virtual-host "http" _ 8000)))
|
||||
(spawn-broker-server 8000)))
|
||||
|
|
|
@ -4,8 +4,8 @@
|
|||
(provide (struct-out message)
|
||||
(except-out (struct-out quit) quit)
|
||||
(rename-out [quit <quit>])
|
||||
(except-out (struct-out spawn) spawn)
|
||||
(rename-out [spawn <spawn>])
|
||||
(except-out (struct-out actor) actor)
|
||||
(rename-out [actor <actor>])
|
||||
(struct-out quit-dataspace)
|
||||
(struct-out transition)
|
||||
|
||||
|
@ -45,9 +45,9 @@
|
|||
unsub
|
||||
|
||||
(rename-out [make-quit quit])
|
||||
make-spawn
|
||||
(rename-out [spawn-process spawn])
|
||||
spawn/stateless
|
||||
make-actor
|
||||
(rename-out [boot-process actor])
|
||||
actor/stateless
|
||||
|
||||
general-transition?
|
||||
ensure-transition
|
||||
|
@ -62,7 +62,7 @@
|
|||
clean-transition
|
||||
|
||||
update-process-state
|
||||
spawn->process+transition)
|
||||
actor->process+transition)
|
||||
|
||||
(require racket/match)
|
||||
(require (only-in racket/list flatten))
|
||||
|
@ -74,7 +74,7 @@
|
|||
(struct message (body) #:prefab)
|
||||
|
||||
;; Actions ⊃ Events
|
||||
(struct spawn (boot) #:prefab)
|
||||
(struct actor (boot) #:prefab)
|
||||
(struct quit-dataspace () #:prefab) ;; NB. An action. Compare (quit), a Transition.
|
||||
|
||||
;; A Behavior is a ((Option Event) Any -> Transition): a function
|
||||
|
@ -115,7 +115,7 @@
|
|||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define (event? x) (or (patch? x) (message? x)))
|
||||
(define (action? x) (or (event? x) (spawn? x) (quit-dataspace? x)))
|
||||
(define (action? x) (or (event? x) (actor? x) (quit-dataspace? x)))
|
||||
|
||||
(define-syntax-rule (match-event e clause ...)
|
||||
(match e
|
||||
|
@ -156,20 +156,20 @@
|
|||
(define (update-process-state i new-state)
|
||||
(struct-copy process i [state new-state]))
|
||||
|
||||
(define (spawn->process+transition s)
|
||||
(match-define (list beh t name) ((spawn-boot s)))
|
||||
(define (actor->process+transition s)
|
||||
(match-define (list beh t name) ((actor-boot s)))
|
||||
(values (process name beh 'undefined-initial-state) t))
|
||||
|
||||
(define (make-quit #:exception [exn #f] . actions)
|
||||
(quit exn actions))
|
||||
|
||||
(define (make-spawn spawn-producing-thunk)
|
||||
(spawn (let ((parameterization (current-parameterization)))
|
||||
(define (make-actor actor-producing-thunk)
|
||||
(actor (let ((parameterization (current-parameterization)))
|
||||
(lambda ()
|
||||
(call-with-parameterization
|
||||
parameterization
|
||||
(lambda ()
|
||||
(match (spawn-producing-thunk)
|
||||
(match (actor-producing-thunk)
|
||||
[(list (? procedure? raw-beh) (? general-transition? txn) name)
|
||||
(list (lambda (e s)
|
||||
(call-with-parameterization parameterization (lambda () (raw-beh e s))))
|
||||
|
@ -177,28 +177,28 @@
|
|||
name)]
|
||||
[other other]))))))) ;; punt on error checking to dataspace boot code
|
||||
|
||||
(define-syntax spawn-process
|
||||
(define-syntax boot-process
|
||||
(syntax-rules ()
|
||||
[(_ #:name name-exp behavior-exp initial-state-exp initial-action-tree-exp)
|
||||
(make-spawn (lambda ()
|
||||
(make-actor (lambda ()
|
||||
(list behavior-exp
|
||||
(transition initial-state-exp initial-action-tree-exp)
|
||||
name-exp)))]
|
||||
[(_ behavior-exp initial-state-exp initial-action-tree-exp)
|
||||
(make-spawn (lambda ()
|
||||
(make-actor (lambda ()
|
||||
(list behavior-exp
|
||||
(transition initial-state-exp initial-action-tree-exp)
|
||||
#f)))]))
|
||||
|
||||
(define-syntax spawn/stateless
|
||||
(define-syntax actor/stateless
|
||||
(syntax-rules ()
|
||||
[(_ #:name name-exp behavior-exp initial-action-tree-exp)
|
||||
(spawn-process #:name name-exp
|
||||
(boot-process #:name name-exp
|
||||
(stateless-behavior-wrap behavior-exp)
|
||||
(void)
|
||||
initial-action-tree-exp)]
|
||||
[(_ behavior-exp initial-action-tree-exp)
|
||||
(spawn-process (stateless-behavior-wrap behavior-exp)
|
||||
(boot-process (stateless-behavior-wrap behavior-exp)
|
||||
(void)
|
||||
initial-action-tree-exp)]))
|
||||
|
||||
|
|
|
@ -125,7 +125,7 @@
|
|||
(hash)))
|
||||
|
||||
(define (make-spawn-dataspace #:name [name #f] boot-actions-thunk)
|
||||
(<spawn> (lambda ()
|
||||
(<actor> (lambda ()
|
||||
(list dataspace-handle-event
|
||||
(transition (make-dataspace (boot-actions-thunk)) '())
|
||||
name))))
|
||||
|
@ -156,15 +156,15 @@
|
|||
|
||||
(define ((perform-action label a) w)
|
||||
(match a
|
||||
[(<spawn> boot)
|
||||
[(<actor> boot)
|
||||
(invoke-process (mux-next-pid (dataspace-mux w)) ;; anticipate pid allocation
|
||||
(lambda ()
|
||||
(match (boot)
|
||||
[(and results (list (? procedure?) (? general-transition?) _))
|
||||
results]
|
||||
[other
|
||||
(error 'spawn
|
||||
"Spawn boot procedure must yield boot spec; received ~v"
|
||||
(error 'actor
|
||||
"actor boot procedure must yield boot spec; received ~v"
|
||||
other)]))
|
||||
(lambda (results)
|
||||
(match-define (list behavior initial-transition name) results)
|
||||
|
|
|
@ -215,7 +215,7 @@
|
|||
(lambda (acs . rs) (cons (apply on-task-exit rs) acs))
|
||||
default-on-task-exit)
|
||||
#:task-supervisor task-supervisor))
|
||||
(spawn #:name name
|
||||
(actor #:name name
|
||||
demand-matcher-handle-event
|
||||
d
|
||||
(patch-seq (sub (projection->pattern demand-spec))
|
||||
|
|
|
@ -15,7 +15,7 @@
|
|||
(struct config (scope item) #:prefab)
|
||||
|
||||
(define (spawn-configuration scope path #:hook [hook void])
|
||||
(actor #:name (list 'configuration-monitor scope path)
|
||||
(spawn #:name (list 'configuration-monitor scope path)
|
||||
(hook)
|
||||
(during (file-content path file->list $items)
|
||||
(cond
|
||||
|
|
|
@ -17,8 +17,8 @@
|
|||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define (spawn-filesystem-driver)
|
||||
(actor #:name 'filesystem-driver
|
||||
(during/actor (observe (file-content $name $reader-proc _))
|
||||
(spawn #:name 'filesystem-driver
|
||||
(during/spawn (observe (file-content $name $reader-proc _))
|
||||
#:name (list 'file-content name reader-proc)
|
||||
(track-file name reader-proc))))
|
||||
|
||||
|
|
|
@ -24,7 +24,7 @@
|
|||
(struct irc-inbound (conn nick target body) #:prefab) ;; MESSAGE
|
||||
(struct irc-outbound (conn target body) #:prefab) ;; MESSAGE
|
||||
|
||||
(actor #:name 'irc-connection-factory
|
||||
(spawn #:name 'irc-connection-factory
|
||||
|
||||
(during (observe (irc-inbound $C _ _ _))
|
||||
(assert C))
|
||||
|
@ -32,8 +32,8 @@
|
|||
(during (observe (observe (irc-outbound $C _ _)))
|
||||
(assert C))
|
||||
|
||||
(during/actor (irc-connection $host $port $nick)
|
||||
#:actor supervise/actor
|
||||
(during/spawn (irc-connection $host $port $nick)
|
||||
#:spawn supervise/actor
|
||||
#:name (list 'irc-connection host port nick)
|
||||
(define C (irc-connection host port nick))
|
||||
(define LH (tcp-handle (gensym 'irc)))
|
||||
|
|
|
@ -14,7 +14,7 @@
|
|||
[(eqv? (bytes-ref bs i) b) i]
|
||||
[else (loop (+ i 1))])))
|
||||
|
||||
(actor (during/actor (observe (tcp-channel-line $src $dst _))
|
||||
(spawn (during/spawn (observe (tcp-channel-line $src $dst _))
|
||||
(field [buffer #""])
|
||||
(on (message (tcp-channel src dst $bs))
|
||||
(buffer (bytes-append (buffer) bs)))
|
||||
|
|
|
@ -60,8 +60,8 @@
|
|||
#:password [smtp-account-config-password #f])))
|
||||
|
||||
(define (spawn-smtp-driver)
|
||||
(actor #:name 'smtp-account-driver
|
||||
(during/actor (smtp-account-config $id $host $port $user $password $ssl-mode)
|
||||
(spawn #:name 'smtp-account-driver
|
||||
(during/spawn (smtp-account-config $id $host $port $user $password $ssl-mode)
|
||||
#:name (list 'smtp-account id)
|
||||
(on-start
|
||||
(log-syndicate/drivers/smtp-info "~v starting: ~s ~s ~s" id host user ssl-mode))
|
||||
|
@ -100,7 +100,7 @@
|
|||
#:tls-encode (case ssl-mode
|
||||
[(starttls) ports->ssl-ports]
|
||||
[else #f]))))))
|
||||
(during/actor (smtp-account-config _ _ _ _ _ _)
|
||||
(during/spawn (smtp-account-config _ _ _ _ _ _)
|
||||
;; By *conditionally* paying attention to inbound messages
|
||||
;; from ground, we ensure that we don't unnecessarily hold
|
||||
;; up ground termination.
|
||||
|
|
|
@ -93,7 +93,7 @@
|
|||
(define listener (tcp:tcp-listen port 128 #t))
|
||||
(define control-ch (make-channel))
|
||||
(thread (lambda () (tcp-listener-thread control-ch listener server-addr)))
|
||||
(spawn #:name (list 'drivers/tcp:listen port)
|
||||
(actor #:name (list 'drivers/tcp:listen port)
|
||||
tcp-listener-behavior
|
||||
(listener-state control-ch server-addr)
|
||||
(patch-seq
|
||||
|
@ -181,7 +181,7 @@
|
|||
(define (spawn-connection local-addr remote-addr cin cout)
|
||||
(define control-ch (make-channel))
|
||||
(thread (lambda () (tcp-connection-thread remote-addr local-addr control-ch cin)))
|
||||
(spawn #:name (list 'drivers/tcp:connect local-addr remote-addr)
|
||||
(actor #:name (list 'drivers/tcp:connect local-addr remote-addr)
|
||||
tcp-connection
|
||||
(connection-state control-ch cout)
|
||||
(patch-seq
|
||||
|
|
|
@ -70,7 +70,7 @@
|
|||
(transition (+ count 1)
|
||||
(when (= count 0) (sub (inbound (timer-expired ? ?)))))]
|
||||
[_ #f]))
|
||||
(spawn #:name 'drivers/timer
|
||||
(actor #:name 'drivers/timer
|
||||
timer-driver
|
||||
0 ;; initial count
|
||||
(patch-seq (sub (set-timer ? ? ?))
|
||||
|
|
|
@ -8,7 +8,7 @@
|
|||
|
||||
(struct later-than (msecs) #:prefab)
|
||||
|
||||
(actor #:name 'drivers/timestate
|
||||
(spawn #:name 'drivers/timestate
|
||||
(during (observe (later-than $msecs))
|
||||
(define timer-id (gensym 'timestate))
|
||||
(field [expired? #f])
|
||||
|
|
|
@ -82,7 +82,7 @@
|
|||
(for-trie ([(udp-multicast-loopback _ $enabled?) (patch-added p)])
|
||||
(udp:udp-multicast-set-loopback! socket enabled?)))
|
||||
|
||||
(spawn #:name (list 'udp-socket local-addr)
|
||||
(actor #:name (list 'udp-socket local-addr)
|
||||
(lambda (e s)
|
||||
(match e
|
||||
[(? patch? p)
|
||||
|
|
|
@ -262,16 +262,16 @@
|
|||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define (spawn-web-driver)
|
||||
(actor #:name 'web-server-manager
|
||||
(during/actor (web-virtual-host "http" _ $port)
|
||||
(spawn #:name 'web-server-manager
|
||||
(during/spawn (web-virtual-host "http" _ $port)
|
||||
#:name (list 'web-server port)
|
||||
(setup-web-server "http"
|
||||
(or (web-server-connection-manager)
|
||||
(start-connection-manager))
|
||||
port)))
|
||||
(actor #:name 'web-client-manager
|
||||
(spawn #:name 'web-client-manager
|
||||
(on (message (web-request $id 'outbound $req $body))
|
||||
(actor #:name (list 'web-client id)
|
||||
(spawn #:name (list 'web-client id)
|
||||
(do-client-request id req body)))))
|
||||
|
||||
(define (setup-web-server scheme cm port)
|
||||
|
@ -309,7 +309,7 @@
|
|||
(request-headers lowlevel-req)
|
||||
(url-query (request-uri lowlevel-req)))
|
||||
(request-post-data/raw lowlevel-req)))
|
||||
(actor #:name (list 'web-req id)
|
||||
(spawn #:name (list 'web-req id)
|
||||
(for [(c (request-cookies lowlevel-req))]
|
||||
(match-define (client-cookie n v d p) c)
|
||||
(assert (web-request-cookie id n v d p)))
|
||||
|
|
|
@ -136,7 +136,7 @@
|
|||
(ssl-options->ssl-tcp@ ssl-options)
|
||||
tcp@)
|
||||
(connection-handler server-addr)))
|
||||
(spawn #:name (list 'drivers/websocket:listen port)
|
||||
(actor #:name (list 'drivers/websocket:listen port)
|
||||
websocket-listener
|
||||
(listener-state shutdown-procedure server-addr)
|
||||
(patch-seq
|
||||
|
@ -160,7 +160,7 @@
|
|||
(when (not (exn? c))
|
||||
(log-info "Connected to ~a ~a" url (current-inexact-milliseconds))
|
||||
(connection-thread-loop control-ch c id))))
|
||||
(spawn #:name (list 'drivers/websocket:connect/initial local-addr remote-addr id)
|
||||
(actor #:name (list 'drivers/websocket:connect/initial local-addr remote-addr id)
|
||||
(lambda (e buffered-messages-rev)
|
||||
(match e
|
||||
[(message (inbound (websocket-connection _ _ _ c _)))
|
||||
|
@ -214,7 +214,7 @@
|
|||
[_ #f])))
|
||||
|
||||
(define (spawn-connection local-addr remote-addr id c control-ch)
|
||||
(spawn #:name (list 'drivers/websocket:connect local-addr remote-addr id)
|
||||
(actor #:name (list 'drivers/websocket:connect local-addr remote-addr id)
|
||||
websocket-connection-behaviour
|
||||
(connection-state local-addr remote-addr c control-ch)
|
||||
(patch-seq
|
||||
|
|
|
@ -4,14 +4,14 @@
|
|||
(struct account (balance) #:prefab)
|
||||
(struct deposit (amount) #:prefab)
|
||||
|
||||
(actor (field [balance 0])
|
||||
(spawn (field [balance 0])
|
||||
(assert (account (balance)))
|
||||
(on (message (deposit $amount))
|
||||
(balance (+ (balance) amount))))
|
||||
|
||||
(actor (on (asserted (account $balance))
|
||||
(spawn (on (asserted (account $balance))
|
||||
(printf "Balance changed to ~a\n" balance)))
|
||||
|
||||
(actor* (until (asserted (observe (deposit _))))
|
||||
(spawn* (until (asserted (observe (deposit _))))
|
||||
(send! (deposit +100))
|
||||
(send! (deposit -30)))
|
||||
|
|
|
@ -8,7 +8,7 @@
|
|||
#:font-size [font-size 22]
|
||||
name x y label callback)
|
||||
(define label-image (text label font-size foreground))
|
||||
(actor (on (message (inbound (mouse-event _ _ name "button-down"))) (callback))
|
||||
(spawn (on (message (inbound (mouse-event _ _ name "button-down"))) (callback))
|
||||
(assert (outbound
|
||||
(window name x y 0
|
||||
(seal
|
||||
|
@ -37,9 +37,9 @@
|
|||
(my nmy))
|
||||
(stop-when (message (inbound (mouse-event $mx $my _ (? mouse-left-event-type? $t))))
|
||||
(idle 0 (- mx dx) (- my dy)))))
|
||||
(actor* (idle 0 orig-x orig-y)))
|
||||
(spawn* (idle 0 orig-x orig-y)))
|
||||
|
||||
(actor (during (inbound (active-window $id))
|
||||
(spawn (during (inbound (active-window $id))
|
||||
(assert (outbound (window 'active-window-label 300 0 0
|
||||
(seal (text (format "~v" id) 22 "black")))))))
|
||||
(button #:background "red" 'stop-button 0 0 "Exit"
|
||||
|
|
|
@ -4,7 +4,7 @@
|
|||
(struct set-box (new-value) #:transparent)
|
||||
(struct box-state (value) #:transparent)
|
||||
|
||||
(actor (field [current-value 0])
|
||||
(spawn (field [current-value 0])
|
||||
(assert (box-state (current-value)))
|
||||
(stop-when (rising-edge (= (current-value) 10))
|
||||
(log-info "box: terminating"))
|
||||
|
@ -12,7 +12,7 @@
|
|||
(log-info "box: taking on new-value ~v" new-value)
|
||||
(current-value new-value)))
|
||||
|
||||
(actor (stop-when (retracted (observe (set-box _)))
|
||||
(spawn (stop-when (retracted (observe (set-box _)))
|
||||
(log-info "client: box has gone"))
|
||||
(on (asserted (box-state $v))
|
||||
(log-info "client: learned that box's value is now ~v" v)
|
||||
|
|
|
@ -3,13 +3,13 @@
|
|||
|
||||
(struct envelope (destination message) #:prefab)
|
||||
|
||||
(actor (on (message (envelope 'alice $message))
|
||||
(spawn (on (message (envelope 'alice $message))
|
||||
(log-info "Alice received ~v" message)))
|
||||
|
||||
(actor (on (message (envelope 'bob $message))
|
||||
(spawn (on (message (envelope 'bob $message))
|
||||
(log-info "Bob received ~v" message)))
|
||||
|
||||
(actor*
|
||||
(spawn*
|
||||
(log-info "Waiting for Alice and Bob.")
|
||||
(until (asserted (observe (envelope 'alice _))))
|
||||
(until (asserted (observe (envelope 'bob _))))
|
||||
|
|
|
@ -4,7 +4,7 @@
|
|||
|
||||
(define (chain-step n)
|
||||
(printf "chain-step ~v\n" n)
|
||||
(actor* (sleep 1)
|
||||
(spawn* (sleep 1)
|
||||
(if (< n 5)
|
||||
(chain-step (+ n 1))
|
||||
(printf "done.\n"))))
|
||||
|
|
|
@ -8,7 +8,7 @@
|
|||
(define remote-handle (tcp-address "localhost" 5999))
|
||||
(define stdin-evt (read-bytes-line-evt (current-input-port) 'any))
|
||||
|
||||
(actor (stop-when (message (inbound (external-event stdin-evt (list (? eof-object? _))))))
|
||||
(spawn (stop-when (message (inbound (external-event stdin-evt (list (? eof-object? _))))))
|
||||
(stop-when (retracted (advertise (tcp-channel remote-handle local-handle _))))
|
||||
(assert (advertise (tcp-channel local-handle remote-handle _)))
|
||||
|
||||
|
|
|
@ -8,7 +8,7 @@
|
|||
(struct present (who) #:prefab)
|
||||
|
||||
(define (spawn-session them us)
|
||||
(actor (define (send-to-remote fmt . vs)
|
||||
(spawn (define (send-to-remote fmt . vs)
|
||||
(send! (tcp-channel us them (string->bytes/utf-8 (apply format fmt vs)))))
|
||||
|
||||
(define (say who fmt . vs)
|
||||
|
@ -31,6 +31,6 @@
|
|||
(send! (says user (string-trim (bytes->string/utf-8 bs)))))))
|
||||
|
||||
(define us (tcp-listener 5999))
|
||||
(actor (assert (advertise (observe (tcp-channel _ us _))))
|
||||
(spawn (assert (advertise (observe (tcp-channel _ us _))))
|
||||
(on (asserted (advertise (tcp-channel $them us _)))
|
||||
(spawn-session them us)))
|
||||
|
|
|
@ -8,7 +8,7 @@
|
|||
(struct present (who) #:prefab)
|
||||
|
||||
(define (spawn-session them us)
|
||||
(actor (define (send-to-remote fmt . vs)
|
||||
(spawn (define (send-to-remote fmt . vs)
|
||||
(send! (outbound (tcp-channel us them (string->bytes/utf-8 (apply format fmt vs))))))
|
||||
|
||||
(define (say who fmt . vs)
|
||||
|
|
|
@ -13,7 +13,7 @@
|
|||
(struct present (who) #:prefab)
|
||||
|
||||
(define (spawn-session id)
|
||||
(actor (define (send-to-remote fmt . vs)
|
||||
(spawn (define (send-to-remote fmt . vs)
|
||||
(send! (tcp-outgoing-data id (string->bytes/utf-8 (apply format fmt vs)))))
|
||||
|
||||
(define (say who fmt . vs)
|
||||
|
@ -35,10 +35,10 @@
|
|||
(send! (says user (string-trim (bytes->string/utf-8 bs)))))))
|
||||
|
||||
(define us (tcp-listener 5999))
|
||||
(actor (assert (advertise (observe (tcp-channel _ us _))))
|
||||
(spawn (assert (advertise (observe (tcp-channel _ us _))))
|
||||
(on (asserted (advertise (tcp-channel $them us _)))
|
||||
(define id (seal (list them us)))
|
||||
(actor (stop-when (retracted (advertise (tcp-channel them us _))))
|
||||
(spawn (stop-when (retracted (advertise (tcp-channel them us _))))
|
||||
(stop-when (retracted (tcp-local-open id)))
|
||||
(assert (tcp-remote-open id))
|
||||
(on (message (tcp-channel them us $bs))
|
||||
|
@ -46,5 +46,5 @@
|
|||
(on (message (tcp-outgoing-data id $bs))
|
||||
(send! (tcp-channel us them bs))))))
|
||||
|
||||
(actor (on (asserted (tcp-remote-open $id))
|
||||
(spawn (on (asserted (tcp-remote-open $id))
|
||||
(spawn-session id)))
|
||||
|
|
|
@ -13,12 +13,12 @@
|
|||
(struct tcp-out (id text) #:prefab)
|
||||
(struct tcp-in (id text) #:prefab)
|
||||
|
||||
(actor #:name 'translate-tcp-protocol-into-simpler-sketch
|
||||
(during/actor (observe (tcp-connection _ $us))
|
||||
(spawn #:name 'translate-tcp-protocol-into-simpler-sketch
|
||||
(during/spawn (observe (tcp-connection _ $us))
|
||||
(assert (advertise (observe (tcp-channel _ us _))))
|
||||
(on (asserted (advertise (tcp-channel $them us _)))
|
||||
(define id (seal (list them us)))
|
||||
(actor (stop-when (retracted (advertise (tcp-channel them us _))))
|
||||
(spawn (stop-when (retracted (advertise (tcp-channel them us _))))
|
||||
(stop-when (retracted (tcp-accepted id)))
|
||||
(assert (tcp-connection id us))
|
||||
(on (message (tcp-channel them us $bs))
|
||||
|
@ -32,8 +32,8 @@
|
|||
(struct speak (who what) #:prefab)
|
||||
(struct present (who) #:prefab)
|
||||
|
||||
(actor #:name 'chat-server
|
||||
(during/actor (tcp-connection $id (tcp-listener 5999))
|
||||
(spawn #:name 'chat-server
|
||||
(during/spawn (tcp-connection $id (tcp-listener 5999))
|
||||
(assert (tcp-accepted id))
|
||||
(define me (gensym 'user)) ;; a random user name
|
||||
(assert (present me))
|
||||
|
|
|
@ -9,7 +9,7 @@
|
|||
(struct shutdown () #:prefab)
|
||||
|
||||
(define (spawn-session them us)
|
||||
(actor (define (send-to-remote fmt . vs)
|
||||
(spawn (define (send-to-remote fmt . vs)
|
||||
(send! (outbound (tcp-channel us them (string->bytes/utf-8 (apply format fmt vs))))))
|
||||
|
||||
(define (say who fmt . vs)
|
||||
|
|
|
@ -4,8 +4,8 @@
|
|||
(require/activate syndicate/drivers/tcp)
|
||||
|
||||
(define server-id (tcp-listener 5999))
|
||||
(actor (assert (advertise (observe (tcp-channel _ server-id _))))
|
||||
(during/actor (advertise (tcp-channel $c server-id _))
|
||||
(spawn (assert (advertise (observe (tcp-channel _ server-id _))))
|
||||
(during/spawn (advertise (tcp-channel $c server-id _))
|
||||
(on-start (printf "Accepted connection from ~v\n" c))
|
||||
(assert (advertise (tcp-channel server-id c _)))
|
||||
(on (message (tcp-channel c server-id $bs))
|
||||
|
|
|
@ -16,10 +16,10 @@
|
|||
|
||||
(struct x (v) #:prefab)
|
||||
|
||||
(actor (on (message (x 'ping))
|
||||
(spawn (on (message (x 'ping))
|
||||
(send! (x 'pong))))
|
||||
|
||||
(actor (field [flag 'clear])
|
||||
(spawn (field [flag 'clear])
|
||||
(begin/dataflow
|
||||
(printf "flag: ~v\n" (flag)))
|
||||
|
||||
|
@ -34,5 +34,5 @@
|
|||
(on (message (x 'first))
|
||||
(spec 'ping)))
|
||||
|
||||
(actor (on (message (x $v))
|
||||
(spawn (on (message (x $v))
|
||||
(printf "- ~v\n" v)))
|
||||
|
|
|
@ -29,17 +29,17 @@
|
|||
|
||||
(require/activate syndicate/drivers/timer)
|
||||
|
||||
(actor #:name 'main
|
||||
(spawn #:name 'main
|
||||
(on (message 'trigger)
|
||||
(actor* #:name 'asserter
|
||||
(spawn* #:name 'asserter
|
||||
(assert! 'up)
|
||||
(send! 'done)))
|
||||
(during/actor 'up
|
||||
(during/spawn 'up
|
||||
#:name 'up
|
||||
(on-start (printf "starting\n"))
|
||||
(on-stop (printf "stopping\n"))))
|
||||
|
||||
(actor* #:name 'triggerer
|
||||
(spawn* #:name 'triggerer
|
||||
(until (asserted (observe 'trigger)))
|
||||
(send! 'trigger)
|
||||
(until (message 'done))
|
||||
|
|
|
@ -23,8 +23,8 @@
|
|||
;; the query pattern. Adding `(let ((F field-name)) ...)` in the
|
||||
;; query-value* macro (and friends) avoids the issue.
|
||||
|
||||
(actor (define/query-value w #f ($ w (list 'val _)) w)
|
||||
(spawn (define/query-value w #f ($ w (list 'val _)) w)
|
||||
(begin/dataflow
|
||||
(log-info "w is ~v" (w))))
|
||||
|
||||
(actor (assert (list 'val 123)))
|
||||
(spawn (assert (list 'val 123)))
|
||||
|
|
|
@ -16,7 +16,7 @@
|
|||
|
||||
(struct foo (x y) #:prefab)
|
||||
|
||||
(actor (field [x 123])
|
||||
(spawn (field [x 123])
|
||||
(assert (foo (x) 999))
|
||||
(during (foo (x) $v)
|
||||
(log-info "x=~a v=~a" (x) v)
|
||||
|
|
|
@ -7,22 +7,22 @@
|
|||
(require (only-in racket/string string-trim string-split))
|
||||
|
||||
(let ((e (read-bytes-line-evt (current-input-port) 'any)))
|
||||
(actor #:name 'monitor-shell
|
||||
(spawn #:name 'monitor-shell
|
||||
(stop-when (message (inbound (external-event e (list (? eof-object? _)))))
|
||||
(send! (list "close" ?)))
|
||||
(on (message (inbound (external-event e (list (? bytes? $command-bytes)))))
|
||||
(send! (string-split (string-trim (bytes->string/utf-8 command-bytes)))))))
|
||||
|
||||
(actor #:name 'monitor-opener
|
||||
(spawn #:name 'monitor-opener
|
||||
(on (message (list "open" $name))
|
||||
(actor #:name (list 'monitor name)
|
||||
(spawn #:name (list 'monitor name)
|
||||
(stop-when (message (list "close" name)))
|
||||
(on (asserted (file-content name file->bytes $bs))
|
||||
(log-info "~a: ~v" name bs))))
|
||||
|
||||
;; The driver can track directory "contents" just as well as files.
|
||||
(on (message (list "opendir" $name))
|
||||
(actor #:name (list 'monitor name)
|
||||
(spawn #:name (list 'monitor name)
|
||||
(stop-when (message (list "close" name)))
|
||||
(on (asserted (file-content name directory-list $files))
|
||||
(log-info "~a: ~v" name files)))))
|
||||
|
|
|
@ -32,22 +32,22 @@
|
|||
|
||||
(require/activate syndicate/drivers/timestate)
|
||||
|
||||
(actor (field [var1 1])
|
||||
(spawn (field [var1 1])
|
||||
(assert (list 'var1 (var1)))
|
||||
(on (message 'tick)
|
||||
(var1 (+ (var1) 1))))
|
||||
|
||||
(actor (during (list 'var1 $v)
|
||||
(spawn (during (list 'var1 $v)
|
||||
(assert (list 'var2 (* v 1)))))
|
||||
|
||||
(actor (during (list 'var1 $v1)
|
||||
(spawn (during (list 'var1 $v1)
|
||||
(during (list 'var2 $v2)
|
||||
(assert (list 'var3 (+ v1 v2))))))
|
||||
|
||||
(actor (on (asserted (list $k $v))
|
||||
(spawn (on (asserted (list $k $v))
|
||||
(printf "~v = ~v\n" k v)))
|
||||
|
||||
(actor* (until (asserted (observe 'tick)))
|
||||
(spawn* (until (asserted (observe 'tick)))
|
||||
(sleep 0.1)
|
||||
(printf "---\n")
|
||||
(send! 'tick)
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
#lang syndicate/actor
|
||||
;; Shows that the checks enforcing single-use suspension-resumption are working.
|
||||
|
||||
(actor #:name 'shouldnt-work
|
||||
(spawn #:name 'shouldnt-work
|
||||
(field [k #f])
|
||||
(on-start
|
||||
(flush!)
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
(struct ready (what) #:prefab)
|
||||
(struct entry (key val) #:prefab)
|
||||
|
||||
(actor (assert (ready 'listener))
|
||||
(spawn (assert (ready 'listener))
|
||||
(on (asserted (entry $key _))
|
||||
(log-info "key ~v asserted" key)
|
||||
(until (retracted (entry key _))
|
||||
|
@ -15,7 +15,7 @@
|
|||
(log-info "del binding: ~v -> ~v" key value)))
|
||||
(log-info "key ~v retracted" key)))
|
||||
|
||||
(actor (assert (ready 'other-listener))
|
||||
(spawn (assert (ready 'other-listener))
|
||||
(during (entry $key _)
|
||||
(log-info "(other-listener) key ~v asserted" key)
|
||||
(on-stop (log-info "(other-listener) key ~v retracted" key))
|
||||
|
@ -29,7 +29,7 @@
|
|||
(until (asserted (ready token))
|
||||
(assert (ready token))))
|
||||
|
||||
(actor* (until (asserted (ready 'listener)))
|
||||
(spawn* (until (asserted (ready 'listener)))
|
||||
(until (asserted (ready 'other-listener)))
|
||||
(assert! (entry 'a 1))
|
||||
(assert! (entry 'a 2))
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
|
||||
(supervise
|
||||
#:name 'ward-supervisor
|
||||
(actor #:name 'ward
|
||||
(spawn #:name 'ward
|
||||
(on-start (log-info "Starting ward"))
|
||||
(on-stop (log-info "Stopping ward"))
|
||||
(on (message 'crash)
|
||||
|
@ -16,7 +16,7 @@
|
|||
(log-info "Bye!"))))
|
||||
|
||||
(define (monitor-interest-in thing)
|
||||
(actor #:name (list 'monitor-interest-in thing)
|
||||
(spawn #:name (list 'monitor-interest-in thing)
|
||||
(during (observe thing)
|
||||
(on-start (log-info "Interest in ~v appeared" thing))
|
||||
(on-stop (log-info "Interest in ~v disappeared" thing)))))
|
||||
|
@ -24,7 +24,7 @@
|
|||
(monitor-interest-in 'crash)
|
||||
(monitor-interest-in 'quit)
|
||||
|
||||
(actor* #:name 'main
|
||||
(spawn* #:name 'main
|
||||
(sleep 1)
|
||||
(send! 'crash)
|
||||
(sleep 1)
|
||||
|
|
|
@ -24,13 +24,13 @@
|
|||
(struct outer (v) #:prefab)
|
||||
(struct show () #:prefab)
|
||||
|
||||
(actor (field [v "first"])
|
||||
(spawn (field [v "first"])
|
||||
(assert (outer (v)))
|
||||
(assert (show))
|
||||
(on (message 2)
|
||||
(v "second")))
|
||||
|
||||
(actor (on-start (send! 1))
|
||||
(spawn (on-start (send! 1))
|
||||
(during (outer $v)
|
||||
(on-start (log-info "+outer ~v" v))
|
||||
(on-stop (log-info "-outer ~v" v))
|
||||
|
|
|
@ -3,9 +3,9 @@
|
|||
(require syndicate/threaded)
|
||||
(require/activate syndicate/drivers/timer)
|
||||
|
||||
(actor
|
||||
(during/actor (observe `(fib ,$n ,_))
|
||||
#:actor actor/thread
|
||||
(spawn
|
||||
(during/spawn (observe `(fib ,$n ,_))
|
||||
#:spawn spawn/thread
|
||||
(on-start (log-info "Computing fib ~a..." n))
|
||||
(on-stop (log-info "Leaving fib ~a" n))
|
||||
(assert `(up ,n))
|
||||
|
@ -24,7 +24,7 @@
|
|||
answer))))))))
|
||||
|
||||
(dataspace/thread
|
||||
(actor
|
||||
(spawn
|
||||
(field [tick-count 0])
|
||||
(define (arm!)
|
||||
(log-info "Tick ~v!" (tick-count))
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
(require/activate "fs-shell.rkt")
|
||||
(require/activate "fs-protocol.rkt")
|
||||
|
||||
(actor (field [files (hash)])
|
||||
(spawn (field [files (hash)])
|
||||
(during (observe (file $name _))
|
||||
(on-start (printf "At least one reader exists for ~v\n" name))
|
||||
(on-stop (printf "No remaining readers exist for ~v\n" name))
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
(require/activate "fs-shell.rkt")
|
||||
(require/activate "fs-protocol.rkt")
|
||||
|
||||
(actor (field [files (hash)])
|
||||
(spawn (field [files (hash)])
|
||||
(during (observe (file $name _))
|
||||
(on-start (printf "At least one reader exists for ~v\n" name))
|
||||
(assert (file name (hash-ref (files) name #f)))
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
(require/activate "fs-shell.rkt")
|
||||
(require/activate "fs-protocol.rkt")
|
||||
|
||||
(actor (field [files (hash)])
|
||||
(spawn (field [files (hash)])
|
||||
(on (asserted (observe (file $name _)))
|
||||
(printf "At least one reader exists for ~v\n" name)
|
||||
(until (retracted (observe (file name _)))
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
(require/activate "fs-protocol.rkt")
|
||||
(require racket/set)
|
||||
|
||||
(actor (field [files (hash)] [monitored (set)])
|
||||
(spawn (field [files (hash)] [monitored (set)])
|
||||
(on (asserted (observe (file $name _)))
|
||||
(printf "At least one reader exists for ~v\n" name)
|
||||
(assert! (file name (hash-ref (files) name #f)))
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
(struct m (b) #:prefab)
|
||||
(struct a (v) #:prefab)
|
||||
|
||||
(actor (on (message (m $b))
|
||||
(spawn (on (message (m $b))
|
||||
(printf "Message: ~v\n" b))
|
||||
(on (asserted (a $v))
|
||||
(printf "Asserted: ~v\n" v))
|
||||
|
@ -39,7 +39,7 @@
|
|||
|
||||
(firewall [(allow (a 'ok-kid))]
|
||||
(assert (a 'forbidden-parent))
|
||||
(on-start (actor (assert (a _)))))
|
||||
(on-start (spawn (assert (a _)))))
|
||||
|
||||
(firewall [(allow (a 'ok-kid2))
|
||||
(allow (a 'ok-parent2))]
|
||||
|
|
|
@ -1,17 +1,17 @@
|
|||
#lang syndicate/actor
|
||||
;; Minimal syndicate/actor variation on examples/forward-chaining.rkt.
|
||||
|
||||
(actor (assert `(parent john douglas)))
|
||||
(actor (assert `(parent bob john)))
|
||||
(actor (assert `(parent ebbon bob)))
|
||||
(spawn (assert `(parent john douglas)))
|
||||
(spawn (assert `(parent bob john)))
|
||||
(spawn (assert `(parent ebbon bob)))
|
||||
|
||||
;; This looks like an implication:
|
||||
;; (parent A C) ⇒ ((ancestor A C) ∧ ((ancestor C B) ⇒ (ancestor A B)))
|
||||
;;
|
||||
(actor (during `(parent ,$A ,$C)
|
||||
(spawn (during `(parent ,$A ,$C)
|
||||
(assert `(ancestor ,A ,C))
|
||||
(during `(ancestor ,C ,$B)
|
||||
(assert `(ancestor ,A ,B)))))
|
||||
|
||||
(actor (on (asserted `(ancestor ,$A ,$B))
|
||||
(spawn (on (asserted `(ancestor ,$A ,$B))
|
||||
(log-info "~a is an ancestor of ~a" A B)))
|
||||
|
|
|
@ -17,7 +17,7 @@
|
|||
(define (print-prompt)
|
||||
(printf "> ")
|
||||
(flush-output))
|
||||
(actor (field [reader-count 0])
|
||||
(spawn (field [reader-count 0])
|
||||
(on-start (print-prompt))
|
||||
(stop-when (message (inbound (external-event e (list (? eof-object? _))))))
|
||||
(on (message (inbound (external-event e (list (? bytes? $bs)))))
|
||||
|
@ -25,7 +25,7 @@
|
|||
[(list "open" name)
|
||||
(define reader-id (reader-count))
|
||||
(reader-count (+ (reader-count) 1))
|
||||
(actor (on-start (printf "Reader ~a opening file ~v.\n" reader-id name))
|
||||
(spawn (on-start (printf "Reader ~a opening file ~v.\n" reader-id name))
|
||||
(stop-when (message `(stop-watching ,name)))
|
||||
(on (asserted (file name $contents))
|
||||
(printf "Reader ~a sees that ~v contains: ~v\n"
|
||||
|
|
|
@ -6,7 +6,7 @@
|
|||
(define CHAN "##syndicatelang")
|
||||
(define C (irc-connection "irc.freenode.net" 6667 NICK))
|
||||
|
||||
(actor #:name 'irc-connection-example
|
||||
(spawn #:name 'irc-connection-example
|
||||
|
||||
(on (message (irc-inbound C $who NICK $body))
|
||||
(log-info "~a said to me: ~a" who body)
|
||||
|
|
|
@ -3,15 +3,15 @@
|
|||
(struct echo-req (body) #:prefab)
|
||||
(struct echo-resp (body) #:prefab)
|
||||
|
||||
(actor (field [count 0])
|
||||
(spawn (field [count 0])
|
||||
(on (message (echo-req $body))
|
||||
(send! (echo-resp body))
|
||||
(count (+ (count) 1))))
|
||||
|
||||
(actor (on (message (echo-resp $body))
|
||||
(spawn (on (message (echo-resp $body))
|
||||
(printf "Received: ~v\n" body)))
|
||||
|
||||
(actor* (until (asserted (observe (echo-req _))))
|
||||
(spawn* (until (asserted (observe (echo-req _))))
|
||||
(until (asserted (observe (echo-resp _))))
|
||||
(send! (echo-req 0))
|
||||
(send! (echo-req 1))
|
||||
|
|
|
@ -9,7 +9,7 @@
|
|||
(struct resource-status (resource-id waiter-count) #:prefab)
|
||||
|
||||
(define (spawn-resource resource-id total-available-leases)
|
||||
(actor (field [waiters (make-queue)]
|
||||
(spawn (field [waiters (make-queue)]
|
||||
[free-lease-count total-available-leases])
|
||||
|
||||
(begin/dataflow (log-info "~as available: ~a" resource-id (free-lease-count)))
|
||||
|
@ -46,13 +46,13 @@
|
|||
|
||||
(struct philosopher-status (name status) #:prefab)
|
||||
|
||||
(actor (define/query-hash-set thinkers (philosopher-status $who $status) status who)
|
||||
(spawn (define/query-hash-set thinkers (philosopher-status $who $status) status who)
|
||||
(begin/dataflow
|
||||
(log-info "~a" (for/list (((status names) (in-hash (thinkers))))
|
||||
(format "~a: ~a" status (set->list names))))))
|
||||
|
||||
(define (philosopher name)
|
||||
(actor (field [status 'starting])
|
||||
(spawn (field [status 'starting])
|
||||
(assert (philosopher-status name (status)))
|
||||
|
||||
(stop-when (rising-edge (eq? (status) 'inspired)))
|
||||
|
|
|
@ -31,7 +31,7 @@
|
|||
|
||||
(define (spawn-one)
|
||||
(define p-at-spawn-time (p))
|
||||
(actor #:name (list 'spawn-one p-at-spawn-time)
|
||||
(spawn #:name (list 'spawn-one p-at-spawn-time)
|
||||
(define p-at-start-time (p))
|
||||
(assert `(p-at-spawn-time ,p-at-spawn-time))
|
||||
(assert `(p-at-start-time ,p-at-start-time))
|
||||
|
@ -39,7 +39,7 @@
|
|||
(on (message 'survey)
|
||||
(send! `(survey-response ,(p))))))
|
||||
|
||||
(actor*
|
||||
(spawn*
|
||||
(spawn-one)
|
||||
(parameterize ((p 'first)) (spawn-one))
|
||||
(parameterize ((p 'second)) (spawn-one))
|
||||
|
|
|
@ -2,7 +2,7 @@
|
|||
|
||||
(require racket/set)
|
||||
|
||||
(actor #:name 'queryer
|
||||
(spawn #:name 'queryer
|
||||
(define/query-value as-value 'absent `(item ,$a ,$b) (list a b))
|
||||
(define/query-set as-set `(item ,$a ,$b) (list a b)
|
||||
#:on-add (log-info "as-set adding ~v/~v" a b)
|
||||
|
@ -42,7 +42,7 @@
|
|||
(printf "----------------------------------------\n")
|
||||
(flush-output)))
|
||||
|
||||
(actor* #:name 'mutator
|
||||
(spawn* #:name 'mutator
|
||||
(until (asserted 'observer-in-ds-ready))
|
||||
(assert! `(item a 1))
|
||||
(assert! `(item b 2))
|
||||
|
@ -60,7 +60,7 @@
|
|||
(log-info "Outer level anchor: ~a" anchor)
|
||||
(log-info "Inner level anchor: ~a" (level-anchor))
|
||||
(log-info "Computed meta-level: ~v" LEVEL)
|
||||
(actor #:name 'observer-in-ds
|
||||
(spawn #:name 'observer-in-ds
|
||||
(assert (outbound* LEVEL 'observer-in-ds-ready))
|
||||
(on-start (log-info "observer-in-ds: STARTING"))
|
||||
(define/query-set items (inbound* LEVEL `(item ,$a ,$b)) (list a b))
|
||||
|
|
|
@ -40,7 +40,7 @@
|
|||
|
||||
;; EFFECT: Spawn a queue process named `queue-id`.
|
||||
(define (spawn-queue queue-id)
|
||||
(actor #:name (list 'queue queue-id)
|
||||
(spawn #:name (list 'queue queue-id)
|
||||
(field [waiters (make-queue)])
|
||||
(field [messages (make-queue)])
|
||||
|
||||
|
@ -82,7 +82,7 @@
|
|||
;; Example
|
||||
|
||||
(define (spawn-consumer consumer-id #:variant [variant 'normal])
|
||||
(actor #:name (list 'consumer consumer-id)
|
||||
(spawn #:name (list 'consumer consumer-id)
|
||||
(assert (subscription 'q consumer-id))
|
||||
(on (message (delivery 'q consumer-id $body))
|
||||
(log-info "Consumer ~a got: ~a" consumer-id body)
|
||||
|
@ -90,7 +90,7 @@
|
|||
(error consumer-id
|
||||
"Hark, canst thou hear me? I will play the swan / and die in music.")))))
|
||||
|
||||
(actor (define/query-hash metrics (metric $k $v) k v)
|
||||
(spawn (define/query-hash metrics (metric $k $v) k v)
|
||||
(begin/dataflow (log-info " ~a" (hash->list (metrics)))))
|
||||
|
||||
(spawn-queue 'q)
|
||||
|
@ -98,7 +98,7 @@
|
|||
(spawn-consumer 'c2 #:variant 'crashy)
|
||||
(spawn-consumer 'c3)
|
||||
|
||||
(actor* (until (asserted (observe (delivery _ 'q _))))
|
||||
(spawn* (until (asserted (observe (delivery _ 'q _))))
|
||||
(for ((n (in-range 10)))
|
||||
(send! (delivery #f 'q n))
|
||||
;; (flush!)
|
||||
|
|
|
@ -40,7 +40,7 @@
|
|||
|
||||
;; EFFECT: Spawn a queue process named `queue-id`.
|
||||
(define (spawn-queue queue-id)
|
||||
(actor #:name (list 'queue queue-id)
|
||||
(spawn #:name (list 'queue queue-id)
|
||||
(field [waiters (make-queue)])
|
||||
(field [messages (make-queue)])
|
||||
|
||||
|
@ -80,7 +80,7 @@
|
|||
;; Example
|
||||
|
||||
(define (spawn-consumer consumer-id #:variant [variant 'normal])
|
||||
(actor #:name (list 'consumer consumer-id)
|
||||
(spawn #:name (list 'consumer consumer-id)
|
||||
(assert (subscription 'q consumer-id))
|
||||
(on (message (delivery 'q consumer-id $body))
|
||||
(log-info "Consumer ~a got: ~a" consumer-id body)
|
||||
|
@ -88,7 +88,7 @@
|
|||
(error consumer-id
|
||||
"Hark, canst thou hear me? I will play the swan / and die in music.")))))
|
||||
|
||||
(actor (define/query-hash metrics (metric $k $v) k v)
|
||||
(spawn (define/query-hash metrics (metric $k $v) k v)
|
||||
(begin/dataflow (log-info " ~a" (hash->list (metrics)))))
|
||||
|
||||
(spawn-queue 'q)
|
||||
|
@ -96,7 +96,7 @@
|
|||
(spawn-consumer 'c2 #:variant 'crashy)
|
||||
(spawn-consumer 'c3)
|
||||
|
||||
(actor* (until (asserted (observe (delivery _ 'q _))))
|
||||
(spawn* (until (asserted (observe (delivery _ 'q _))))
|
||||
(for ((n (in-range 10)))
|
||||
(send! (delivery #f 'q n))
|
||||
(when (odd? n) (flush!))
|
||||
|
|
|
@ -43,7 +43,7 @@
|
|||
|
||||
;; EFFECT: Spawn a queue process named `queue-id`.
|
||||
(define (spawn-queue queue-id)
|
||||
(actor #:name (list 'queue queue-id)
|
||||
(spawn #:name (list 'queue queue-id)
|
||||
(field [waiters (make-queue)])
|
||||
(field [messages (make-queue)])
|
||||
|
||||
|
@ -100,7 +100,7 @@
|
|||
;; Example
|
||||
|
||||
(define (spawn-consumer consumer-id initial-credit #:variant [variant 'normal])
|
||||
(actor #:name (list 'consumer consumer-id)
|
||||
(spawn #:name (list 'consumer consumer-id)
|
||||
(assert (subscription 'q consumer-id))
|
||||
(on-start (send! (credit 'q consumer-id initial-credit)))
|
||||
(on (message (delivery 'q consumer-id $body))
|
||||
|
@ -114,7 +114,7 @@
|
|||
[(overloaded) ;; don't issue credit
|
||||
(void)]))))
|
||||
|
||||
(actor (define/query-hash metrics (metric $k $v) k v)
|
||||
(spawn (define/query-hash metrics (metric $k $v) k v)
|
||||
(begin/dataflow (log-info " ~a" (hash->list (metrics)))))
|
||||
|
||||
(spawn-queue 'q)
|
||||
|
@ -122,7 +122,7 @@
|
|||
(spawn-consumer 'c2 2 #:variant 'crashy)
|
||||
(spawn-consumer 'c3 3 #:variant 'overloaded)
|
||||
|
||||
(actor* (until (asserted (observe (delivery _ 'q _))))
|
||||
(spawn* (until (asserted (observe (delivery _ 'q _))))
|
||||
(for ((n (in-range 10)))
|
||||
(send! (delivery #f 'q n))
|
||||
;; (flush!)
|
||||
|
|
|
@ -40,16 +40,16 @@
|
|||
(run-bank-account 'b)
|
||||
(run-bank-account 'c)
|
||||
|
||||
(actor (on (asserted (named-account $name $balance))
|
||||
(spawn (on (asserted (named-account $name $balance))
|
||||
(printf "Named account balance ~a = ~a\n" name balance)))
|
||||
|
||||
(actor (define/query-set running-apps (running-app $id) id)
|
||||
(spawn (define/query-set running-apps (running-app $id) id)
|
||||
(begin/dataflow (printf "Running apps: ~v\n" (running-apps))))
|
||||
|
||||
(let ()
|
||||
(local-require racket/port)
|
||||
(define e (read-bytes-line-evt (current-input-port) 'any))
|
||||
(actor (stop-when (message (inbound (external-event e (list (? eof-object? _))))))
|
||||
(spawn (stop-when (message (inbound (external-event e (list (? eof-object? _))))))
|
||||
(on (message (inbound (external-event e (list (? bytes? $bs)))))
|
||||
(define app-id (bytes->string/utf-8 bs))
|
||||
(printf "Killing ~a\n" app-id)
|
||||
|
|
|
@ -1,13 +1,13 @@
|
|||
#lang syndicate/actor
|
||||
;; Demonstrates that fields may not be passed between actors.
|
||||
|
||||
(actor #:name 'reading-actor
|
||||
(spawn #:name 'reading-actor
|
||||
(on (message `(read-from ,$this-field))
|
||||
(log-info "Trying to read from ~a" this-field)
|
||||
(log-info "Read: ~a" (this-field))
|
||||
(send! `(read-successfully ,this-field))))
|
||||
|
||||
(actor #:name 'requesting-actor
|
||||
(spawn #:name 'requesting-actor
|
||||
(field [a 123])
|
||||
(on-start (send! `(read-from ,a)))
|
||||
(stop-when (message `(read-successfully ,a)))
|
||||
|
|
|
@ -2,7 +2,7 @@
|
|||
;; Demonstrates that fields may used in a child facet of a declaring
|
||||
;; facet, but not the other way around.
|
||||
|
||||
(actor #:name 'reading-actor
|
||||
(spawn #:name 'reading-actor
|
||||
(field [top 123])
|
||||
(on (message `(read-from ,$this-field))
|
||||
(log-info "Trying to read from ~a" this-field)
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
#lang syndicate/actor
|
||||
;; Demonstrates that fields may not be passed between sibling facets.
|
||||
|
||||
(actor (on (message `(read-from ,$this-field))
|
||||
(spawn (on (message `(read-from ,$this-field))
|
||||
(log-info "Trying to read from ~a" this-field)
|
||||
(log-info "Read: ~a" (this-field))
|
||||
(send! `(read-successfully ,this-field)))
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
#lang syndicate/actor
|
||||
;; Demonstrates that fields at actor scope are visible to facets.
|
||||
|
||||
(actor* (field [x 123])
|
||||
(spawn* (field [x 123])
|
||||
(react
|
||||
(on (message `(read-from ,$this-field))
|
||||
(log-info "Trying to read from ~a" this-field)
|
||||
|
|
|
@ -24,9 +24,9 @@
|
|||
|
||||
(define (non-void-field? f) (not (void? (f))))
|
||||
|
||||
(define (cell-expr->actor-expr name expr)
|
||||
(define (cell-expr->spawn-expr name expr)
|
||||
(define bindings (set->list (extract-bindings expr)))
|
||||
`(actor (stop-when (message (set-cell ',name _)))
|
||||
`(spawn (stop-when (message (set-cell ',name _)))
|
||||
(field ,@(for/list [(b bindings)] `[,b (void)]))
|
||||
(assert #:when (andmap non-void-field? (list ,@bindings))
|
||||
(cell ',name
|
||||
|
@ -36,16 +36,16 @@
|
|||
`(on (asserted (cell ',b $value))
|
||||
(,b value)))))
|
||||
|
||||
(actor (on (message (set-cell $name $expr))
|
||||
(define actor-expr (cell-expr->actor-expr name expr))
|
||||
;; (local-require racket/pretty) (pretty-print actor-expr)
|
||||
(eval actor-expr (namespace-anchor->namespace ns))))
|
||||
(spawn (on (message (set-cell $name $expr))
|
||||
(define spawn-expr (cell-expr->spawn-expr name expr))
|
||||
;; (local-require racket/pretty) (pretty-print spawn-expr)
|
||||
(eval spawn-expr (namespace-anchor->namespace ns))))
|
||||
|
||||
(actor (on (asserted (cell $name $value))
|
||||
(spawn (on (asserted (cell $name $value))
|
||||
(printf ">>> ~a ~v\n" name value)
|
||||
(flush-output)))
|
||||
|
||||
(actor (stop-when (message (inbound 'quit)))
|
||||
(spawn (stop-when (message (inbound 'quit)))
|
||||
(on (message (inbound (set-cell $name $expr)))
|
||||
(send! (set-cell name expr)))
|
||||
(void (thread (lambda ()
|
||||
|
|
|
@ -2,19 +2,19 @@
|
|||
|
||||
(require/activate syndicate/drivers/timestate)
|
||||
|
||||
(actor #:name 'demo-timeout
|
||||
(spawn #:name 'demo-timeout
|
||||
(on-start (printf "Starting demo-timeout\n"))
|
||||
(on-stop (printf "Stopping demo-timeout\n"))
|
||||
(stop-when-timeout 3000 (printf "Three second timeout fired\n")))
|
||||
|
||||
(actor #:name 'demo-later-than
|
||||
(spawn #:name 'demo-later-than
|
||||
(on-start (printf "Starting demo-later-than\n"))
|
||||
(on-stop (printf "Stopping demo-later-than\n"))
|
||||
(field [deadline (+ (current-inexact-milliseconds) 5000)])
|
||||
(stop-when (asserted (later-than (deadline)))
|
||||
(printf "Deadline expired\n")))
|
||||
|
||||
(actor #:name 'demo-updating-later-than
|
||||
(spawn #:name 'demo-updating-later-than
|
||||
(field [deadline (current-inexact-milliseconds)])
|
||||
(field [counter 0])
|
||||
(on #:when (< (counter) 10) (asserted (later-than (deadline)))
|
||||
|
|
|
@ -83,7 +83,7 @@
|
|||
;; SELLER
|
||||
;;
|
||||
(define (seller)
|
||||
(actor (field [books (hash "The Wind in the Willows" 3.95
|
||||
(spawn (field [books (hash "The Wind in the Willows" 3.95
|
||||
"Catch 22" 2.22
|
||||
"Candide" 34.95)]
|
||||
[next-order-id 10001483])
|
||||
|
@ -117,7 +117,7 @@
|
|||
|
||||
;; Tell the ordering party their order ID and delivery date.
|
||||
;;
|
||||
(actor
|
||||
(spawn
|
||||
(while-relevant-assert
|
||||
(order title offer-price order-id "March 9th")))]))))
|
||||
|
||||
|
@ -175,7 +175,7 @@
|
|||
(log-info "A learns that the split-proposal for ~v was rejected" title)
|
||||
(try-to-split (+ contribution (/ (- price contribution) 2)))))]))])]))
|
||||
|
||||
(actor* (try-to-buy (list "Catch 22"
|
||||
(spawn* (try-to-buy (list "Catch 22"
|
||||
"Encyclopaedia Brittannica"
|
||||
"Candide"
|
||||
"The Wind in the Willows")
|
||||
|
@ -184,7 +184,7 @@
|
|||
;; Serial SPLIT-DISPOSER
|
||||
;;
|
||||
(define (buyer-b)
|
||||
(actor ;; This actor maintains a record of the amount of money it has to spend.
|
||||
(spawn ;; This actor maintains a record of the amount of money it has to spend.
|
||||
;;
|
||||
(field [funds 5.00])
|
||||
|
||||
|
@ -207,7 +207,7 @@
|
|||
;; this could perhaps be a facet rather than a full actor) to handle the
|
||||
;; actual purchase now that we have agreed on a split.
|
||||
;;
|
||||
(actor* (define-values (order-id delivery-date)
|
||||
(spawn* (define-values (order-id delivery-date)
|
||||
(react/suspend (yield)
|
||||
;; While we are in this state, waiting for order confirmation, take
|
||||
;; the opportunity to signal to our SPLIT-PROPOSER that we accepted
|
||||
|
|
|
@ -5,13 +5,13 @@
|
|||
(require/activate syndicate/drivers/web)
|
||||
(require net/url)
|
||||
|
||||
(actor #:name 'server
|
||||
(spawn #:name 'server
|
||||
(define vh (web-virtual-host "http" ? 9090))
|
||||
|
||||
(assert vh)
|
||||
|
||||
(on (web-request-incoming (id req) vh _ ("ws" ()))
|
||||
(actor
|
||||
(spawn
|
||||
(assert (web-response-websocket id))
|
||||
(stop-when (websocket-connection-closed id) (log-info "Connection dropped"))
|
||||
(stop-when (websocket-message-recv id "quit") (log-info "Received quit command"))
|
||||
|
|
|
@ -12,7 +12,7 @@
|
|||
(until (message (timer-expired timer-id _))
|
||||
(on-start (send! (set-timer timer-id (* sec 1000.0) 'relative)))))
|
||||
|
||||
(actor #:name 'server
|
||||
(spawn #:name 'server
|
||||
(field [counter 0])
|
||||
(assert vh)
|
||||
|
||||
|
@ -20,7 +20,7 @@
|
|||
'inbound
|
||||
($ req (web-request-header _ (web-resource vh `("ws" ())) _ _))
|
||||
_))
|
||||
(actor (assert (web-response-websocket id))
|
||||
(spawn (assert (web-response-websocket id))
|
||||
(stop-when (retracted (observe (websocket-message id 'outbound _)))
|
||||
(log-info "Connection dropped"))
|
||||
(stop-when (message (websocket-message id 'inbound "quit"))
|
||||
|
|
|
@ -12,22 +12,22 @@
|
|||
(struct path-exists (from to) #:prefab) ;; Hmm.
|
||||
(struct min-cost (from to cost) #:prefab)
|
||||
|
||||
(actor (assert (link 1 3 -2))
|
||||
(spawn (assert (link 1 3 -2))
|
||||
(assert (link 2 1 4))
|
||||
(assert (link 2 3 3))
|
||||
(assert (link 3 4 2))
|
||||
(assert (link 4 2 -1)))
|
||||
|
||||
(actor (during (link $from $to $cost)
|
||||
(spawn (during (link $from $to $cost)
|
||||
(assert (path-exists from to))
|
||||
(assert (path from to cost))))
|
||||
|
||||
(actor (during (link $A $B $link-cost)
|
||||
(spawn (during (link $A $B $link-cost)
|
||||
(during (path B $C $path-cost)
|
||||
(assert (path-exists A C))
|
||||
(assert (path A C (+ link-cost path-cost))))))
|
||||
|
||||
(actor (during (path-exists $from $to)
|
||||
(spawn (during (path-exists $from $to)
|
||||
(field [costs (set)] [least +inf.0])
|
||||
(assert (min-cost from to (least)))
|
||||
(on (asserted (path from to $cost))
|
||||
|
@ -38,8 +38,8 @@
|
|||
(costs new-costs)
|
||||
(least (for/fold [(least +inf.0)] [(x new-costs)] (min x least))))))
|
||||
|
||||
(actor (during (path $from $to $cost)
|
||||
(spawn (during (path $from $to $cost)
|
||||
(on-start (displayln `(+ ,(path from to cost))))
|
||||
(on-stop (displayln `(- ,(path from to cost))))))
|
||||
(actor (on (asserted (min-cost $from $to $cost))
|
||||
(spawn (on (asserted (min-cost $from $to $cost))
|
||||
(displayln (min-cost from to cost))))
|
||||
|
|
|
@ -11,23 +11,23 @@
|
|||
(struct path-exists (from to) #:prefab) ;; Hmm.
|
||||
(struct min-cost (from to cost) #:prefab)
|
||||
|
||||
(actor (assert (link 1 3 -2))
|
||||
(spawn (assert (link 1 3 -2))
|
||||
(assert (link 2 1 4))
|
||||
(assert (link 2 3 3))
|
||||
(assert (link 3 4 2))
|
||||
(assert (link 4 2 -1)))
|
||||
|
||||
(actor (during (link $from $to $cost)
|
||||
(spawn (during (link $from $to $cost)
|
||||
(assert (path-exists from to))
|
||||
(assert (path from to (set from to) cost))))
|
||||
|
||||
(actor (during (link $A $B $link-cost)
|
||||
(spawn (during (link $A $B $link-cost)
|
||||
(during (path B $C $seen $path-cost)
|
||||
(assert #:when (not (set-member? seen A)) (path-exists A C))
|
||||
(assert #:when (not (set-member? seen A))
|
||||
(path A C (set-add seen A) (+ link-cost path-cost))))))
|
||||
|
||||
(actor (during (path-exists $from $to)
|
||||
(spawn (during (path-exists $from $to)
|
||||
(field [costs (set)] [least +inf.0])
|
||||
(assert (min-cost from to (least)))
|
||||
(on (asserted (path from to _ $cost))
|
||||
|
@ -38,8 +38,8 @@
|
|||
(costs new-costs)
|
||||
(least (for/fold [(least +inf.0)] [(x new-costs)] (min x least))))))
|
||||
|
||||
(actor (during (path $from $to $seen $cost)
|
||||
(spawn (during (path $from $to $seen $cost)
|
||||
(on-start (displayln `(+ ,(path from to seen cost))))
|
||||
(on-stop (displayln `(- ,(path from to seen cost))))))
|
||||
(actor (on (asserted (min-cost $from $to $cost))
|
||||
(spawn (on (asserted (min-cost $from $to $cost))
|
||||
(displayln (min-cost from to cost))))
|
||||
|
|
|
@ -19,6 +19,6 @@
|
|||
(quit (list (message (deposit +100))
|
||||
(message (deposit -30))))))
|
||||
|
||||
(spawn manager 0 (scn/union (assertion (observe (deposit ?))) (assertion (account 0))))
|
||||
(spawn observer (void) (scn (assertion (observe (account ?)))))
|
||||
(spawn updater (void) (scn (assertion (observe (observe (deposit ?))))))
|
||||
(actor manager 0 (scn/union (assertion (observe (deposit ?))) (assertion (account 0))))
|
||||
(actor observer (void) (scn (assertion (observe (account ?)))))
|
||||
(actor updater (void) (scn (assertion (observe (observe (deposit ?))))))
|
||||
|
|
|
@ -19,6 +19,6 @@
|
|||
(quit (list (message (deposit +100))
|
||||
(message (deposit -30))))))
|
||||
|
||||
(spawn manager 0 (patch-seq (assert (observe (deposit ?))) (assert (account 0))))
|
||||
(spawn observer (void) (assert (observe (account ?))))
|
||||
(spawn updater (void) (assert (observe (observe (deposit ?)))))
|
||||
(actor manager 0 (patch-seq (assert (observe (deposit ?))) (assert (account 0))))
|
||||
(actor observer (void) (assert (observe (account ?))))
|
||||
(actor updater (void) (assert (observe (observe (deposit ?)))))
|
||||
|
|
|
@ -7,7 +7,7 @@
|
|||
#:foreground [foreground "white"]
|
||||
#:font-size [font-size 22]
|
||||
name x y label callback)
|
||||
(spawn (lambda (e s)
|
||||
(actor (lambda (e s)
|
||||
(match e
|
||||
[(message (inbound (mouse-event _ _ _ "button-down"))) (transition s (callback))]
|
||||
[_ #f]))
|
||||
|
@ -29,7 +29,7 @@
|
|||
(define (mouse-sub active-pat)
|
||||
(patch-seq (unsub (inbound (mouse-event ? ? ? ?)))
|
||||
(sub (inbound (mouse-event ? ? active-pat ?)))))
|
||||
(spawn (match-lambda**
|
||||
(actor (match-lambda**
|
||||
[((message (inbound (tick-event))) (idle ticks bx by))
|
||||
(define new-ticks (+ ticks 1))
|
||||
(define displacement (* (cos (* new-ticks 10 1/180 pi)) 4))
|
||||
|
@ -50,7 +50,7 @@
|
|||
(mouse-sub name)
|
||||
(move-to orig-x orig-y))))
|
||||
|
||||
(spawn (lambda (e s)
|
||||
(actor (lambda (e s)
|
||||
(match e
|
||||
[(? patch? p)
|
||||
(define-values (in out)
|
||||
|
|
|
@ -4,7 +4,7 @@
|
|||
(struct set-box (new-value) #:transparent)
|
||||
(struct box-state (value) #:transparent)
|
||||
|
||||
(spawn (lambda (e current-value)
|
||||
(actor (lambda (e current-value)
|
||||
(match-event e
|
||||
[(message (set-box new-value))
|
||||
(log-info "box: taking on new-value ~v" new-value)
|
||||
|
@ -14,7 +14,7 @@
|
|||
(patch-seq (sub (set-box ?))
|
||||
(assert (box-state 0))))
|
||||
|
||||
(spawn (lambda (e s)
|
||||
(actor (lambda (e s)
|
||||
(match-event e
|
||||
[(patch added removed)
|
||||
(transition s (for-trie/list ([(box-state $v) added])
|
||||
|
|
|
@ -7,7 +7,7 @@
|
|||
(define local-handle (tcp-handle 'chat))
|
||||
(define remote-handle (tcp-address "localhost" 5999))
|
||||
|
||||
(spawn/stateless (lambda (e)
|
||||
(actor/stateless (lambda (e)
|
||||
(match e
|
||||
[(? patch/removed?) (quit)]
|
||||
[(message (inbound (external-event _ (list (? eof-object?)))))
|
||||
|
|
|
@ -14,7 +14,7 @@
|
|||
(define (say who fmt . vs)
|
||||
(unless (equal? who user) (send-to-remote "~a ~a\n" who (apply format fmt vs))))
|
||||
(list (send-to-remote "Welcome, ~a.\n" user)
|
||||
(spawn/stateless
|
||||
(actor/stateless
|
||||
(lambda (e)
|
||||
(match e
|
||||
[(message (tcp-channel _ _ bs))
|
||||
|
|
|
@ -14,7 +14,7 @@
|
|||
(define (say who fmt . vs)
|
||||
(unless (equal? who user) (send-to-remote "~a ~a\n" who (apply format fmt vs))))
|
||||
(list (send-to-remote "Welcome, ~a.\n" user)
|
||||
(spawn/stateless
|
||||
(actor/stateless
|
||||
(lambda (e)
|
||||
(match e
|
||||
[(message (inbound (tcp-channel _ _ bs)))
|
||||
|
|
|
@ -17,7 +17,7 @@
|
|||
|
||||
(define (tcp-proxy-process them us)
|
||||
(define id (seal (list them us)))
|
||||
(spawn (lambda (e s)
|
||||
(actor (lambda (e s)
|
||||
(match e
|
||||
[(message (tcp-channel _ _ bs))
|
||||
(transition s (message (tcp-incoming-data id bs)))]
|
||||
|
@ -41,7 +41,7 @@
|
|||
(define (say who fmt . vs)
|
||||
(unless (equal? who user) (send-to-remote "~a ~a\n" who (apply format fmt vs))))
|
||||
(list (send-to-remote "Welcome, ~a.\n" user)
|
||||
(spawn/stateless
|
||||
(actor/stateless
|
||||
(lambda (e)
|
||||
(match e
|
||||
[(message (tcp-incoming-data _ bs))
|
||||
|
@ -68,7 +68,7 @@
|
|||
(observe (tcp-channel (?!) (?! (tcp-listener 5999)) ?))
|
||||
tcp-proxy-process)
|
||||
|
||||
(spawn (lambda (e s)
|
||||
(actor (lambda (e s)
|
||||
(if (patch? e)
|
||||
(transition s
|
||||
(for/list [(id (project-assertions (patch-added e)
|
||||
|
|
|
@ -14,7 +14,7 @@
|
|||
(define (say who fmt . vs)
|
||||
(unless (equal? who user) (send-to-remote "~a ~a\n" who (apply format fmt vs))))
|
||||
(list (send-to-remote "Welcome, ~a.\n" user)
|
||||
(spawn/stateless
|
||||
(actor/stateless
|
||||
(lambda (e)
|
||||
(match e
|
||||
[(message (inbound (tcp-channel _ _ bs)))
|
||||
|
|
|
@ -82,7 +82,7 @@
|
|||
|
||||
(define (db directory)
|
||||
(setup-directory! directory)
|
||||
(spawn (lambda (e old-state)
|
||||
(actor (lambda (e old-state)
|
||||
(match e
|
||||
[(? patch? p)
|
||||
(define-values (added-observations removed-observations)
|
||||
|
@ -102,7 +102,7 @@
|
|||
(define binding-projector (?! (binding ? ? ? ?)))
|
||||
|
||||
(define (async-update key epoch version value on-complete on-conflict)
|
||||
(spawn (lambda (e s)
|
||||
(actor (lambda (e s)
|
||||
(match e
|
||||
[(? patch? p)
|
||||
(match (set->list (trie-project/set/single (patch-added p) binding-projector))
|
||||
|
@ -126,7 +126,7 @@
|
|||
(db "/tmp/durable-key-value-store")
|
||||
|
||||
(define (monitor key)
|
||||
(spawn (lambda (e s)
|
||||
(actor (lambda (e s)
|
||||
(match e
|
||||
[(? patch? p)
|
||||
(define n (project-assertions (patch-added p) (?!)))
|
||||
|
|
|
@ -10,7 +10,7 @@
|
|||
(observe (tcp-channel (?!) server-id ?))
|
||||
(lambda (c)
|
||||
(printf "Accepted connection from ~v\n" c)
|
||||
(spawn (lambda (e state)
|
||||
(actor (lambda (e state)
|
||||
(match e
|
||||
[(? patch/removed?)
|
||||
(printf "Closed connection ~v\n" c)
|
||||
|
|
|
@ -18,7 +18,7 @@
|
|||
(newline)])
|
||||
(printf "========================================\n")
|
||||
#f)
|
||||
(spawn quasi-spy (void) sub-all-except-meta)
|
||||
(actor quasi-spy (void) sub-all-except-meta)
|
||||
|
||||
(define (r e s)
|
||||
(match e
|
||||
|
@ -32,8 +32,8 @@
|
|||
#f)]
|
||||
[_ #f]))
|
||||
|
||||
(spawn-dataspace (spawn r (void) sub-all-except-meta)
|
||||
(spawn b 0 '()))
|
||||
(spawn-dataspace (actor r (void) sub-all-except-meta)
|
||||
(actor b 0 '()))
|
||||
|
||||
(define (echoer e s)
|
||||
(match e
|
||||
|
@ -43,7 +43,7 @@
|
|||
(transition s (message `(print (got-line ,line))))]
|
||||
[_ #f]))
|
||||
|
||||
(spawn echoer
|
||||
(actor echoer
|
||||
(void)
|
||||
(sub (inbound (external-event (read-line-evt (current-input-port) 'any) ?))))
|
||||
|
||||
|
@ -61,7 +61,7 @@
|
|||
[_ #f]))
|
||||
|
||||
(message (set-timer 'tick 1000 'relative))
|
||||
(spawn ticker
|
||||
(actor ticker
|
||||
1
|
||||
(patch-seq (sub (observe (set-timer ? ? ?)))
|
||||
(sub (timer-expired 'tick ?))))
|
||||
|
@ -73,6 +73,6 @@
|
|||
#f]
|
||||
[_ #f]))
|
||||
|
||||
(spawn printer
|
||||
(actor printer
|
||||
(void)
|
||||
(sub `(print ,?)))
|
||||
|
|
|
@ -2,7 +2,7 @@
|
|||
;; Check that nested-world assertions are properly retracted.
|
||||
;; Should print two "Got SCN:" patches - one adding, and one removing (observe 'die).
|
||||
|
||||
#;(spawn (lambda (e s)
|
||||
#;(actor (lambda (e s)
|
||||
(match e
|
||||
[(message 'die) (quit)]
|
||||
[_ #f]))
|
||||
|
@ -11,7 +11,7 @@
|
|||
(sub (observe 'die))))
|
||||
|
||||
(spawn-dataspace
|
||||
(spawn (lambda (e s)
|
||||
(actor (lambda (e s)
|
||||
(match e
|
||||
[(message (inbound 'die)) (quit)]
|
||||
[_ #f]))
|
||||
|
@ -19,7 +19,7 @@
|
|||
(patch-seq (sub (inbound 'die))
|
||||
(sub (inbound (observe 'die))))))
|
||||
|
||||
(spawn (lambda (e s)
|
||||
(actor (lambda (e s)
|
||||
(match e
|
||||
[(? patch? p)
|
||||
(printf "Got SCN:\n")
|
||||
|
|
|
@ -3,7 +3,7 @@
|
|||
;; Demonstrates (hopefully) correct processing of meta-interests when dropping a patch.
|
||||
|
||||
(spawn-dataspace
|
||||
(spawn (lambda (e u)
|
||||
(actor (lambda (e u)
|
||||
(match u
|
||||
[0 (transition 1 '())]
|
||||
[1 (transition 2 (retract (outbound 'a)))]
|
||||
|
|
|
@ -25,7 +25,7 @@
|
|||
(require syndicate/pretty)
|
||||
|
||||
(spawn-dataspace
|
||||
(spawn (lambda (e counter)
|
||||
(actor (lambda (e counter)
|
||||
(and e
|
||||
(let ((new-counter (+ counter 1)))
|
||||
(printf "Received event ~a:\n~a\n" new-counter (syndicate-pretty-print->string e))
|
||||
|
|
|
@ -4,7 +4,7 @@
|
|||
(require syndicate/pretty)
|
||||
|
||||
(spawn-dataspace
|
||||
(spawn (lambda (e counter)
|
||||
(actor (lambda (e counter)
|
||||
(and e
|
||||
(let ((new-counter (+ counter 1)))
|
||||
(printf "Received event ~a:\n~a\n" new-counter (syndicate-pretty-print->string e))
|
||||
|
|
|
@ -61,16 +61,16 @@
|
|||
#f]
|
||||
[_ #f]))
|
||||
|
||||
(run-ground (spawn quasi-spy (void) sub-all-except-meta)
|
||||
(run-ground (actor quasi-spy (void) sub-all-except-meta)
|
||||
(spawn-timer-driver)
|
||||
(message (set-timer 'tick 1000 'relative))
|
||||
(spawn ticker
|
||||
(actor ticker
|
||||
1
|
||||
(patch-seq (sub (observe (set-timer ? ? ?)))
|
||||
(sub (timer-expired 'tick ?))))
|
||||
(spawn-dataspace (spawn r (void) sub-all-except-meta)
|
||||
(spawn b 0 '()))
|
||||
(spawn echoer
|
||||
(spawn-dataspace (actor r (void) sub-all-except-meta)
|
||||
(actor b 0 '()))
|
||||
(actor echoer
|
||||
(void)
|
||||
(sub (inbound (external-event (read-line-evt (current-input-port) 'any) ?))))
|
||||
(spawn printer (void) (sub `(print ,?))))
|
||||
(actor printer (void) (sub `(print ,?))))
|
||||
|
|
|
@ -4,7 +4,7 @@
|
|||
(require (only-in racket/port read-bytes-line-evt))
|
||||
|
||||
(define (spawn-command-listener)
|
||||
(spawn (lambda (e s)
|
||||
(actor (lambda (e s)
|
||||
(match e
|
||||
[(message (inbound (inbound (external-event _ (list #"quit")))))
|
||||
(printf "Quitting just the leaf actor.\n")
|
||||
|
@ -21,7 +21,7 @@
|
|||
(define (sub-to-alarm)
|
||||
(sub (inbound (inbound
|
||||
(external-event (alarm-evt (+ (current-inexact-milliseconds) 1000)) ?)))))
|
||||
(spawn (lambda (e s)
|
||||
(actor (lambda (e s)
|
||||
(match e
|
||||
[(message (inbound (inbound (external-event _ _))))
|
||||
(printf "Tick!\n")
|
||||
|
|
|
@ -4,7 +4,7 @@
|
|||
|
||||
(require rackunit)
|
||||
|
||||
(spawn (lambda (e u)
|
||||
(actor (lambda (e u)
|
||||
(if (< (length u) 3)
|
||||
(transition
|
||||
(append u (list e))
|
||||
|
@ -15,7 +15,7 @@
|
|||
'()
|
||||
(sub 'a))
|
||||
|
||||
(spawn (lambda (e u)
|
||||
(actor (lambda (e u)
|
||||
(if (< (length u) 3)
|
||||
(transition
|
||||
(append u (list e))
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
|
||||
(require syndicate/pretty)
|
||||
|
||||
(spawn (lambda (e s)
|
||||
(actor (lambda (e s)
|
||||
(printf "Subscriber - Aggregate\n")
|
||||
(syndicate-pretty-print s)
|
||||
(printf "Subscriber - Patch\n")
|
||||
|
|
|
@ -7,7 +7,7 @@
|
|||
|
||||
(require syndicate/pretty)
|
||||
|
||||
(spawn (lambda (e s)
|
||||
(actor (lambda (e s)
|
||||
(printf "Subscriber - Aggregate\n")
|
||||
(syndicate-pretty-print s)
|
||||
(printf "Subscriber - Patch\n")
|
||||
|
@ -20,7 +20,7 @@
|
|||
(patch-seq (sub ?)
|
||||
(unsub (inbound ?))))
|
||||
|
||||
(spawn (lambda (e s)
|
||||
(actor (lambda (e s)
|
||||
(printf "Asserter\n")
|
||||
(syndicate-pretty-print e)
|
||||
(newline)
|
||||
|
|
|
@ -5,7 +5,7 @@
|
|||
(require "../demand-matcher.rkt")
|
||||
(require/activate "../drivers/timer.rkt")
|
||||
|
||||
(spawn (lambda (e old-count)
|
||||
(actor (lambda (e old-count)
|
||||
(match e
|
||||
[(? patch?)
|
||||
(define-values (in out) (patch-project/set #:take 2 e `(parent ,(?!) ,(?!))))
|
||||
|
@ -21,7 +21,7 @@
|
|||
|
||||
(define (insert-record record . monitors)
|
||||
(printf "Record ~v inserted, depending on ~v\n" record monitors)
|
||||
(spawn (lambda (e s)
|
||||
(actor (lambda (e s)
|
||||
(match e
|
||||
[(? patch/removed?)
|
||||
(printf "Retracting ~v because dependencies ~v vanished\n"
|
||||
|
@ -41,7 +41,7 @@
|
|||
(insert-record `(parent bob john))
|
||||
(insert-record `(parent ebbon bob))
|
||||
|
||||
(spawn (lambda (e s)
|
||||
(actor (lambda (e s)
|
||||
(match e
|
||||
[(? patch?)
|
||||
(transition s
|
||||
|
@ -55,7 +55,7 @@
|
|||
(void)
|
||||
(sub `(parent ,? ,?)))
|
||||
|
||||
(spawn (lambda (e s)
|
||||
(actor (lambda (e s)
|
||||
(match e
|
||||
[(? patch?)
|
||||
(transition s
|
||||
|
@ -64,7 +64,7 @@
|
|||
`(parent ,(?!) ,(?!))))]
|
||||
(match-define (list A C) AC)
|
||||
(printf "Inductive step for ~v asserted\n" `(parent ,A ,C))
|
||||
(spawn (lambda (e s)
|
||||
(actor (lambda (e s)
|
||||
(define removed-parents
|
||||
(and (patch? e)
|
||||
(trie-project (patch-removed e) `(parent ,(?!) ,(?!)))))
|
||||
|
@ -102,7 +102,7 @@
|
|||
;; (spawn-demand-matcher (observe `(ancestor ,(?!) ,(?!)))
|
||||
;; (advertise `(ancestor ,(?!) ,(?!)))
|
||||
;; (lambda (A B)
|
||||
;; (spawn (lambda (e old-facts)
|
||||
;; (actor (lambda (e old-facts)
|
||||
;; (match e
|
||||
;; [(? patch/removed?) (quit)]
|
||||
;; [(? patch?)
|
||||
|
@ -128,7 +128,7 @@
|
|||
;; (sub `(ancestor ,? ,B))
|
||||
;; (pub `(ancestor ,A ,B))))))
|
||||
|
||||
(spawn (lambda (e s)
|
||||
(actor (lambda (e s)
|
||||
(when (patch? e) (pretty-print-patch e))
|
||||
#f)
|
||||
(void)
|
||||
|
@ -138,7 +138,7 @@
|
|||
(define id (gensym 'after))
|
||||
(if (zero? msec)
|
||||
(thunk)
|
||||
(spawn (lambda (e s) (and (message? e) (quit (thunk))))
|
||||
(actor (lambda (e s) (and (message? e) (quit (thunk))))
|
||||
(void)
|
||||
(list (message (set-timer id msec 'relative))
|
||||
(sub (timer-expired id ?))))))
|
||||
|
|
|
@ -60,7 +60,7 @@
|
|||
(assert (lookup-binding epoch bindings key))))))
|
||||
|
||||
(define (db)
|
||||
(spawn (lambda (e old-state)
|
||||
(actor (lambda (e old-state)
|
||||
(match e
|
||||
[(? patch? p)
|
||||
(define-values (added-observations removed-observations)
|
||||
|
@ -80,7 +80,7 @@
|
|||
(define binding-projector (?! (binding ? ? ? ?)))
|
||||
|
||||
(define (async-update key epoch version value on-complete on-conflict)
|
||||
(spawn (lambda (e s)
|
||||
(actor (lambda (e s)
|
||||
(match e
|
||||
[(? patch? p)
|
||||
(match (set->list (trie-project/set/single (patch-added p) binding-projector))
|
||||
|
@ -104,7 +104,7 @@
|
|||
(db)
|
||||
|
||||
(define (monitor key)
|
||||
(spawn (lambda (e s)
|
||||
(actor (lambda (e s)
|
||||
(match e
|
||||
[(? patch? p)
|
||||
(define n (project-assertions (patch-added p) (?!)))
|
||||
|
|
|
@ -3,7 +3,7 @@
|
|||
(struct echo-req (body) #:prefab)
|
||||
(struct echo-resp (body) #:prefab)
|
||||
|
||||
(spawn (lambda (e count)
|
||||
(actor (lambda (e count)
|
||||
(match e
|
||||
[(message (echo-req body))
|
||||
(transition (+ count 1)
|
||||
|
@ -12,7 +12,7 @@
|
|||
0
|
||||
(sub (echo-req ?)))
|
||||
|
||||
(spawn (lambda (e s)
|
||||
(actor (lambda (e s)
|
||||
(match e
|
||||
[(message (echo-resp body))
|
||||
(printf "Received: ~v\n" body)
|
||||
|
|
|
@ -21,7 +21,7 @@
|
|||
(and (< n 5)
|
||||
(transition (+ n 1) (message (tcp-channel server-id c (string->bytes/utf-8
|
||||
(format "msg ~v\n" n))))))]))
|
||||
(spawn connection-handler
|
||||
(actor connection-handler
|
||||
0
|
||||
(patch-seq (sub (advertise (tcp-channel c server-id ?)))
|
||||
(sub (tcp-channel c server-id ?))
|
||||
|
|
|
@ -9,7 +9,7 @@
|
|||
|
||||
(define (while-relevant-assert P #:noisy? [noisy #f])
|
||||
(define name (format "(while-relevant-assert ~a)" P))
|
||||
(spawn/stateless
|
||||
(actor/stateless
|
||||
#:name name
|
||||
(lambda (e)
|
||||
(match e
|
||||
|
@ -81,7 +81,7 @@
|
|||
[else #f]))
|
||||
|
||||
(define (seller inv)
|
||||
(spawn #:name 'seller
|
||||
(actor #:name 'seller
|
||||
seller-behavior
|
||||
inv
|
||||
(list (sub (observe (book-quote ? ?)))
|
||||
|
@ -96,7 +96,7 @@
|
|||
(match titles
|
||||
['() (log-info "A has bought everything they wanted!") patch-empty]
|
||||
[(cons title remaining-titles)
|
||||
(spawn/stateless
|
||||
(actor/stateless
|
||||
#:name (format "(try-to-buy ~a)" title)
|
||||
(lambda (e)
|
||||
(match e
|
||||
|
@ -120,7 +120,7 @@
|
|||
(try-to-buy remaining-titles budget)]
|
||||
[else
|
||||
(log-offer title initial-offer)
|
||||
(spawn
|
||||
(actor
|
||||
#:name (format "(negotiate-split ~a ~a)" title price)
|
||||
(lambda (e my-contribution)
|
||||
(match e
|
||||
|
@ -158,7 +158,7 @@
|
|||
|
||||
(define (buyer-b funds)
|
||||
(define (complete-purchase title price contrib)
|
||||
(spawn/stateless
|
||||
(actor/stateless
|
||||
#:name (format "(complete-purchase ~a ~a ~a)" title price contrib)
|
||||
(lambda (e)
|
||||
(match e
|
||||
|
@ -173,7 +173,7 @@
|
|||
[_ #f]))
|
||||
(list (assert (split-proposal title price contrib #t))
|
||||
(sub (order title price ? ?)))))
|
||||
(spawn
|
||||
(actor
|
||||
#:name 'buyer-b
|
||||
(lambda (e funds)
|
||||
(match e
|
||||
|
@ -215,4 +215,4 @@
|
|||
"The Wind in the Willows")
|
||||
35.00)
|
||||
|
||||
(buyer-b 5.00)
|
||||
(buyer-b 5.00)
|
||||
|
|
|
@ -10,7 +10,7 @@
|
|||
|
||||
(define (while-relevant-assert P #:noisy? [noisy #f])
|
||||
(define name (format "(while-relevant-assert ~a)" P))
|
||||
(spawn/stateless
|
||||
(actor/stateless
|
||||
#:name name
|
||||
(lambda (e)
|
||||
(match e
|
||||
|
@ -38,7 +38,7 @@
|
|||
(assertion-set-union quotes (assertion (book-quote title (hash-ref inv title #f)))))]
|
||||
[_ trie-empty]))
|
||||
|
||||
;; Event Inventory -> (Values Inventory (ListOf Spawn))
|
||||
;; Event Inventory -> (Values Inventory (ListOf actor))
|
||||
(define (answer-orders e inv)
|
||||
(match e
|
||||
[(scn t)
|
||||
|
@ -85,7 +85,7 @@
|
|||
[else #f]))
|
||||
|
||||
(define (seller inv)
|
||||
(spawn #:name 'seller
|
||||
(actor #:name 'seller
|
||||
seller-behavior
|
||||
inv
|
||||
(scn seller-interests)))
|
||||
|
@ -99,7 +99,7 @@
|
|||
(match titles
|
||||
['() (log-info "A has bought everything they wanted!") (scn trie-empty)]
|
||||
[(cons title remaining-titles)
|
||||
(spawn/stateless
|
||||
(actor/stateless
|
||||
#:name (format "(try-to-buy ~a)" title)
|
||||
(lambda (e)
|
||||
(match e
|
||||
|
@ -123,7 +123,7 @@
|
|||
(try-to-buy remaining-titles budget)]
|
||||
[else
|
||||
(log-offer title initial-offer)
|
||||
(spawn
|
||||
(actor
|
||||
#:name (format "(negotiate-split ~a ~a)" title price)
|
||||
(lambda (e my-contribution)
|
||||
(match e
|
||||
|
@ -160,7 +160,7 @@
|
|||
|
||||
(define (buyer-b funds)
|
||||
(define (complete-purchase title price contrib)
|
||||
(spawn/stateless
|
||||
(actor/stateless
|
||||
#:name (format "(complete-purchase ~a ~a ~a)" title price contrib)
|
||||
(lambda (e)
|
||||
(match e
|
||||
|
@ -175,7 +175,7 @@
|
|||
[_ #f]))
|
||||
(list (scn/union (assertion (split-proposal title price contrib #t))
|
||||
(assertion (observe (order title price ? ?)))))))
|
||||
(spawn
|
||||
(actor
|
||||
#:name 'buyer-b
|
||||
(lambda (e funds)
|
||||
(match e
|
||||
|
@ -217,4 +217,4 @@
|
|||
"The Wind in the Willows")
|
||||
35.00)
|
||||
|
||||
(buyer-b 5.00)
|
||||
(buyer-b 5.00)
|
||||
|
|
Some files were not shown because too many files have changed in this diff Show More
Loading…
Reference in New Issue