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 #lang racket/base
(provide actor (provide actor
;; network network
;; background ;; background
state state
@ -241,6 +241,20 @@
[(_ I ...) [(_ I ...)
(expand-state 'actor #'(I ... (return/no-link-result!)) #'() #'() #'() #'())])) (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 ;; Main behavior of HLL actors
@ -351,10 +365,13 @@
perform-pending-patch perform-pending-patch
(lambda (s) (lambda (s)
(define callee-id (gensym linkage-kind)) (define callee-id (gensym linkage-kind))
(define spawn-action (action-fn callee-id (actor-state-self-id s)))
(transition (if blocking? (transition (if blocking?
(store-continuation s callee-id get-next-instr) (store-continuation s callee-id get-next-instr)
s) s)
(action-fn callee-id (actor-state-self-id s)))))) (if (eq? linkage-kind 'network)
(spawn-world spawn-action)
spawn-action)))))
(if blocking? (if blocking?
next-t next-t
(handle-actor-syscall next-t (get-next-instr (void))))] (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 says (who what) #:prefab)
(struct present (who) #:prefab) (struct present (who) #:prefab)
(struct shutdown () #:prefab)
(define (spawn-session them us) (define (spawn-session them us)
(actor (define (send-to-remote fmt . vs) (actor (define (send-to-remote fmt . vs)
@ -28,14 +29,21 @@
(assert (advertise (tcp-channel us them _)) #:meta-level 1) (assert (advertise (tcp-channel us them _)) #:meta-level 1)
(on (message (tcp-channel them us $bs) #: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-tcp-driver)
(spawn-world (%%boot
(%%boot (lambda ()
(lambda () (actor
(actor (define us (tcp-listener 5000))
(forever (assert (advertise (observe (tcp-channel _ us _))) #:meta-level 1) (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) (on (asserted (advertise (tcp-channel $them us _)) #:meta-level 1)
(spawn-session them us))))))) (spawn-session them us))))
)))