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

Make HLL `dataspace` no longer automatically `quit-dataspace`. Fixes #20.

This commit is contained in:
Tony Garnock-Jones 2017-09-25 23:52:29 +01:00
parent 4a4f43b2cb
commit 6c4ae38499
9 changed files with 92 additions and 86 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
examples/netstack/incremental-highlevel/main.rkt
View File

@ -41,11 +41,12 @@
(on (message (inbound (tcp-channel them us $bs)))
(send! (says user (string-trim (bytes->string/utf-8 bs)))))))
(define us (tcp-listener 5999))
(dataspace #:name 'chat-dataspace
(define us (tcp-listener 5999))
(forever (assert (outbound (advertise (observe (tcp-channel _ us _)))))
(on (asserted (inbound (advertise (tcp-channel $them us _))))
(spawn-session them us)))))
(spawn #:name 'chat-server
(assert (outbound (advertise (observe (tcp-channel _ us _)))))
(on (asserted (inbound (advertise (tcp-channel $them us _))))
(spawn-session them us)))))
(let ((dst (udp-listener 6667)))
(spawn #:name 'udp-echo-program
@ -61,25 +62,25 @@
(send! `(counter ,(counter)))
(counter (+ (counter) 1))))
(forever (define us (tcp-listener 80))
(assert (outbound (advertise (observe (tcp-channel _ us _)))))
(during/spawn (inbound (advertise (tcp-channel ($ them (tcp-address _ _)) us _)))
#:name (list 'webserver-session them)
(log-info "Got connection from ~v" them)
(assert (outbound (advertise (tcp-channel us them _))))
(on (message (inbound (tcp-channel them us _)))) ;; ignore input
(define us (tcp-listener 80))
(spawn (assert (outbound (advertise (observe (tcp-channel _ us _)))))
(during/spawn (inbound (advertise (tcp-channel ($ them (tcp-address _ _)) us _)))
#:name (list 'webserver-session them)
(log-info "Got connection from ~v" them)
(assert (outbound (advertise (tcp-channel us them _))))
(on (message (inbound (tcp-channel them us _)))) ;; ignore input
(on-start (send! 'bump))
(on (message `(counter ,$counter))
(define response
(string->bytes/utf-8
(format (string-append
"HTTP/1.0 200 OK\r\n\r\n"
"<h1>Hello world from syndicate-netstack!</h1>\n"
"<p>This is running on syndicate's own\n"
"<a href='https://github.com/tonyg/syndicate/'>\n"
"TCP/IP stack</a>.</p>\n"
"<p>There have been ~a requests prior to this one.</p>\n")
counter)))
(send! (outbound (tcp-channel us them response)))
(stop-facet (current-facet-id)))))))
(on-start (send! 'bump))
(on (message `(counter ,$counter))
(define response
(string->bytes/utf-8
(format (string-append
"HTTP/1.0 200 OK\r\n\r\n"
"<h1>Hello world from syndicate-netstack!</h1>\n"
"<p>This is running on syndicate's own\n"
"<a href='https://github.com/tonyg/syndicate/'>\n"
"TCP/IP stack</a>.</p>\n"
"<p>There have been ~a requests prior to this one.</p>\n")
counter)))
(send! (outbound (tcp-channel us them response)))
(stop-facet (current-facet-id)))))))

25
examples/platformer/hll-main.rkt
View File

@ -671,17 +671,17 @@
;; kills the dataspace.
(define (wait-for-level-termination)
(react/suspend (done)
(assert (outbound (level-running)))
(stop-when (retracted (game-piece-configuration player-id _ _ _))
(log-info "Player died! Terminating level.")
(play-sound-sequence 270328)
(done))
(stop-when (message (inbound (level-completed)))
(log-info "Level completed! Terminating level.")
(play-sound-sequence 270330)
(send! (outbound (add-to-score 100)))
(done))))
(spawn
(assert (outbound (level-running)))
(on (retracted (game-piece-configuration player-id _ _ _))
(log-info "Player died! Terminating level.")
(play-sound-sequence 270328)
(quit-dataspace!))
(on (message (inbound (level-completed)))
(log-info "Level completed! Terminating level.")
(play-sound-sequence 270330)
(send! (outbound (add-to-score 100)))
(quit-dataspace!))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; LevelSpawner
@ -816,5 +816,4 @@
(spawn-keyboard-integrator)
(spawn-scene-manager)
(dataspace (spawn-score-keeper)
(spawn-level-spawner 0)
(forever))
(spawn-level-spawner 0))

10
racket/syndicate/actor.rkt
View File

@ -57,6 +57,7 @@
patch!
perform-actions!
flush!
quit-dataspace!
syndicate-effects-available?
@ -342,10 +343,7 @@
(syntax-parse stx
[(_ name:name script ...)
(quasisyntax/loc stx
(let ((spawn-action (core:dataspace-actor
#:name name.N
(actor-action script ...
(schedule-action! (core:quit-dataspace))))))
(let ((spawn-action (core:dataspace-actor #:name name.N (actor-action script ...))))
(if (syndicate-effects-available?)
(schedule-action! spawn-action)
spawn-action)))]))
@ -1322,6 +1320,10 @@
(until (core:message ack)
(on-start (send! ack))))
(define (quit-dataspace!)
(ensure-in-script! 'quit-dataspace!)
(schedule-action! (core:quit-dataspace)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (format-field-descriptor d)

4
racket/syndicate/dataspace.rkt
View File

@ -177,6 +177,10 @@
[(<actor> boot initial-assertions)
(invoke-process (mux-next-pid (dataspace-mux w)) ;; anticipate pid allocation
(lambda ()
(when (not (trie? initial-assertions))
(error 'actor
"actor initial assertions must be trie; was ~v"
initial-assertions))
(match (boot)
[(and results (list (? procedure?) (? general-transition?) _))
results]

33
racket/syndicate/examples/actor/chat-no-quit-world.rkt
View File

@ -7,24 +7,23 @@
(struct says (who what) #:prefab)
(struct present (who) #:prefab)
(dataspace (define us (tcp-listener 5999))
(forever
(assert (outbound (advertise (observe (tcp-channel _ us _)))))
(during/spawn (inbound (advertise (tcp-channel $them us _)))
(assert (outbound (advertise (tcp-channel us them _))))
(define us (tcp-listener 5999))
(dataspace (spawn (assert (outbound (advertise (observe (tcp-channel _ us _)))))
(during/spawn (inbound (advertise (tcp-channel $them us _)))
(assert (outbound (advertise (tcp-channel us them _))))
(define (send-to-remote fmt . vs)
(send! (outbound (tcp-channel us them (string->bytes/utf-8 (apply format fmt vs))))))
(define (send-to-remote fmt . vs)
(send! (outbound (tcp-channel us them (string->bytes/utf-8 (apply format fmt vs))))))
(define user (gensym 'user))
(define user (gensym 'user))
(on-start (send-to-remote "Welcome, ~a.\n" user))
(assert (present user))
(on (message (inbound (tcp-channel them us $bs)))
(send! (says user (string-trim (bytes->string/utf-8 bs)))))
(on-start (send-to-remote "Welcome, ~a.\n" user))
(assert (present user))
(on (message (inbound (tcp-channel them us $bs)))
(send! (says user (string-trim (bytes->string/utf-8 bs)))))
(during (present $who)
(unless (equal? who user)
(on-start (send-to-remote "~a arrived.\n" who))
(on-stop (send-to-remote "~a departed.\n" who))
(on (message (says who $what)) (send-to-remote "~a says: ~a\n" who what)))))))
(during (present $who)
(unless (equal? who user)
(on-start (send-to-remote "~a arrived.\n" who))
(on-stop (send-to-remote "~a departed.\n" who))
(on (message (says who $what)) (send-to-remote "~a says: ~a\n" who what)))))))

40
racket/syndicate/examples/actor/chat.rkt
View File

@ -8,27 +8,27 @@
(struct present (who) #:prefab)
(struct shutdown () #:prefab)
(dataspace (define us (tcp-listener 5999))
(until (message (shutdown))
(assert (outbound (advertise (observe (tcp-channel _ us _)))))
(during/spawn (inbound (advertise (tcp-channel $them us _)))
(assert (outbound (advertise (tcp-channel us them _))))
(define us (tcp-listener 5999))
(dataspace (spawn (on (message (shutdown)) (quit-dataspace!))
(assert (outbound (advertise (observe (tcp-channel _ us _)))))
(during/spawn (inbound (advertise (tcp-channel $them us _)))
(assert (outbound (advertise (tcp-channel us them _))))
(define (send-to-remote fmt . vs)
(send! (outbound (tcp-channel us them (string->bytes/utf-8 (apply format fmt vs))))))
(define (send-to-remote fmt . vs)
(send! (outbound (tcp-channel us them (string->bytes/utf-8 (apply format fmt vs))))))
(define user (gensym 'user))
(define user (gensym 'user))
(on-start (send-to-remote "Welcome, ~a.\n" user))
(assert (present user))
(on (message (inbound (tcp-channel them us $bs)))
(define input-string (string-trim (bytes->string/utf-8 bs)))
(if (equal? input-string "quit-dataspace")
(send! (shutdown))
(send! (says user input-string))))
(on-start (send-to-remote "Welcome, ~a.\n" user))
(assert (present user))
(on (message (inbound (tcp-channel them us $bs)))
(define input-string (string-trim (bytes->string/utf-8 bs)))
(if (equal? input-string "quit-dataspace")
(send! (shutdown))
(send! (says user input-string))))
(during (present $who)
(unless (equal? who user)
(on-start (send-to-remote "~a arrived.\n" who))
(on-stop (send-to-remote "~a departed.\n" who))
(on (message (says who $what)) (send-to-remote "~a says: ~a\n" who what)))))))
(during (present $who)
(unless (equal? who user)
(on-start (send-to-remote "~a arrived.\n" who))
(on-stop (send-to-remote "~a departed.\n" who))
(on (message (says who $what)) (send-to-remote "~a says: ~a\n" who what)))))))

3
racket/syndicate/examples/actor/fib-server.rkt
View File

@ -50,4 +50,5 @@
(until (rising-edge (= (counter) 2)))
(log-info "Quitting main")
(until (message (inbound (timer-expired 'wait _)))
(on-start (send! (outbound (set-timer 'wait 100 'relative))))))
(on-start (send! (outbound (set-timer 'wait 100 'relative)))))
(quit-dataspace!))

3
racket/syndicate/examples/actor/query-set.rkt
View File

@ -65,5 +65,4 @@
(on-start (log-info "observer-in-ds: STARTING"))
(define/query-set items (inbound* LEVEL `(item ,$a ,$b)) (list a b))
(on (message (inbound* LEVEL 'dump))
(log-info "observer-in-ds: ~v" (items))))
(forever)))
(log-info "observer-in-ds: ~v" (items))))))

9
racket/syndicate/examples/actor/sandbox-os.rkt
View File

@ -29,12 +29,13 @@
(dataspace (define id (symbol->string (gensym 'app)))
(printf "Starting app ~a\n" id)
(schedule-action! (program-boot-actions 'syndicate/examples/actor/bank-account))
(forever
(spawn
(assert (outbound (running-app id)))
(stop-when (message (inbound (kill-app id)))
(printf "Received signal for app ~a\n" id))
(on (message (inbound (kill-app id)))
(printf "Received signal for app ~a\n" id)
(quit-dataspace!))
(during (account $balance)
(assert (outbound (named-account name balance)))))))
(assert (outbound (named-account name balance)))))))
(run-bank-account 'a)
(run-bank-account 'b)