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

Add `network` to actor.rkt

This commit is contained in:
Tony Garnock-Jones 2015-12-12 06:45:15 +13:00
parent debd191992
commit bd0278297b
2 changed files with 34 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
prospect/actor.rkt
View File

@ -1,7 +1,7 @@
#lang racket/base
(provide actor
;; network
network
;; background
state
@ -241,6 +241,20 @@
[(_ I ...)
(expand-state 'actor #'(I ... (return/no-link-result!)) #'() #'() #'() #'())]))
;; Spawn whole networks
(define-syntax (network stx)
(syntax-parse stx
[(_ I ...)
(expand-state 'network
#'(I
...
(do! (quit-world))
(return/no-link-result!))
#'()
#'()
#'()
#'())]))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Main behavior of HLL actors
@ -351,10 +365,13 @@
perform-pending-patch
(lambda (s)
(define callee-id (gensym linkage-kind))
(define spawn-action (action-fn callee-id (actor-state-self-id s)))
(transition (if blocking?
(store-continuation s callee-id get-next-instr)
s)
(action-fn callee-id (actor-state-self-id s))))))
(if (eq? linkage-kind 'network)
(spawn-world spawn-action)
spawn-action)))))
(if blocking?
next-t
(handle-actor-syscall next-t (get-next-instr (void))))]

22
prospect/examples/actor/chat.rkt
View File

@ -6,6 +6,7 @@
(struct says (who what) #:prefab)
(struct present (who) #:prefab)
(struct shutdown () #:prefab)
(define (spawn-session them us)
(actor (define (send-to-remote fmt . vs)
@ -28,14 +29,21 @@
(assert (advertise (tcp-channel us them _)) #:meta-level 1)
(on (message (tcp-channel them us $bs) #:meta-level 1)
(send! (says user (string-trim (bytes->string/utf-8 bs))))))))
(define input-string (string-trim (bytes->string/utf-8 bs)))
(if (equal? input-string "quit-world")
(send! (shutdown))
(send! (says user input-string)))))))
(spawn-tcp-driver)
(spawn-world
(%%boot
(lambda ()
(actor (define us (tcp-listener 5000))
(forever (assert (advertise (observe (tcp-channel _ us _))) #:meta-level 1)
(%%boot
(lambda ()
(actor
(network (define us (tcp-listener 5000))
(until (message (shutdown))
(assert (advertise (observe (tcp-channel _ us _))) #:meta-level 1)
(on (asserted (advertise (tcp-channel $them us _)) #:meta-level 1)
(spawn-session them us)))))))
(spawn-session them us))))
)))