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

Introduce make-spawn to capture parameterizations. Closes #10.

This commit is contained in:
Tony Garnock-Jones 2016-07-31 17:24:48 -04:00
parent 1fa50e4e6a
commit 4e1bab4b90
7 changed files with 119 additions and 47 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
examples/platformer/lll-main.rkt
View File

@ -914,10 +914,9 @@
;; LevelSpawner
(define (spawn-standalone-assertions . patches)
(<spawn> (lambda ()
(list (lambda (e s) #f)
(transition (void) (patch-seq* patches))
#f))))
(spawn (lambda (e s) #f)
(void)
patches))
(define (spawn-background-image level-size scene)
(match-define (vector level-width level-height) level-size)

2
racket/syndicate/actor.rkt
View File

@ -269,7 +269,7 @@
(syntax-parse stx
[(_ name:name script ...)
(quasisyntax/loc stx
(core:<spawn>
(core:make-spawn
(lambda ()
(list actor-behavior
(boot-actor (lambda () (begin/void-default script ...)))

31
racket/syndicate/core.rkt
View File

@ -45,6 +45,7 @@
unsub
(rename-out [make-quit quit])
make-spawn
(rename-out [spawn-process spawn])
spawn/stateless
@ -162,18 +163,32 @@
(define (make-quit #:exception [exn #f] . actions)
(quit exn actions))
(define (make-spawn spawn-producing-thunk)
(spawn (let ((parameterization (current-parameterization)))
(lambda ()
(call-with-parameterization
parameterization
(lambda ()
(match (spawn-producing-thunk)
[(list (? procedure? raw-beh) (? general-transition? txn) name)
(list (lambda (e s)
(call-with-parameterization parameterization (lambda () (raw-beh e s))))
txn
name)]
[other other]))))))) ;; punt on error checking to dataspace boot code
(define-syntax spawn-process
(syntax-rules ()
[(_ #:name name-exp behavior-exp initial-state-exp initial-action-tree-exp)
(spawn (lambda ()
(list behavior-exp
(transition initial-state-exp initial-action-tree-exp)
name-exp)))]
(make-spawn (lambda ()
(list behavior-exp
(transition initial-state-exp initial-action-tree-exp)
name-exp)))]
[(_ behavior-exp initial-state-exp initial-action-tree-exp)
(spawn (lambda ()
(list behavior-exp
(transition initial-state-exp initial-action-tree-exp)
#f)))]))
(make-spawn (lambda ()
(list behavior-exp
(transition initial-state-exp initial-action-tree-exp)
#f)))]))
(define-syntax spawn/stateless
(syntax-rules ()

57
racket/syndicate/examples/actor/parameters.rkt Normal file
View File

@ -0,0 +1,57 @@
#lang syndicate/actor
;; Demonstrate use of parameters with actors.
;;
;; Per https://github.com/tonyg/syndicate/issues/10, "Parameters don't
;; work well with actors". Output from this program running against
;; buggy Syndicate:
;;
;; spawn-ps: (set)
;; start-ps: (set)
;; ps: (set)
;; start-ps: (set 'unset)
;; spawn-ps: (set 'second 'unset 'first)
;; ps: (set 'unset)
;; Survey-response: 'unset
;; Survey-response: 'unset
;; Survey-response: 'unset
;;
;; ... and against a fixed Syndicate:
;;
;; spawn-ps: (set)
;; start-ps: (set)
;; ps: (set)
;; start-ps: (set 'second 'unset 'first)
;; spawn-ps: (set 'second 'unset 'first)
;; ps: (set 'second 'unset 'first)
;; Survey-response: 'unset
;; Survey-response: 'first
;; Survey-response: 'second
(define p (make-parameter 'unset))
(define (spawn-one)
(define p-at-spawn-time (p))
(actor #:name (list 'spawn-one p-at-spawn-time)
(define p-at-start-time (p))
(react
(assert `(p-at-spawn-time ,p-at-spawn-time))
(assert `(p-at-start-time ,p-at-start-time))
(assert `(p ,(p)))
(on (message 'survey)
(send! `(survey-response ,(p)))))))
(actor
(spawn-one)
(parameterize ((p 'first)) (spawn-one))
(parameterize ((p 'second)) (spawn-one))
(flush!)
(until (asserted (observe 'survey)))
(react (on-start (send! 'survey))
(define/query-set spawn-ps `(p-at-spawn-time ,$v) v)
(define/query-set start-ps `(p-at-start-time ,$v) v)
(define/query-set ps `(p ,$v) v)
(begin/dataflow (printf "spawn-ps: ~v\n" (spawn-ps)))
(begin/dataflow (printf "start-ps: ~v\n" (start-ps)))
(begin/dataflow (printf "ps: ~v\n" (ps)))
(on (message `(survey-response ,$v))
(printf "Survey-response: ~v\n" v))))

20
racket/syndicate/monolithic/core.rkt
View File

@ -122,17 +122,17 @@
(define-syntax spawn-monolithic
(syntax-rules ()
[(_ #:name name-exp behavior-exp initial-state-exp initial-action-tree-exp)
(<spawn> (lambda ()
(list (wrap-monolithic-behaviour behavior-exp)
(differentiate-outgoing (wrap-monolithic-state initial-state-exp)
(clean-actions initial-action-tree-exp))
name-exp)))]
(make-spawn (lambda ()
(list (wrap-monolithic-behaviour behavior-exp)
(differentiate-outgoing (wrap-monolithic-state initial-state-exp)
(clean-actions initial-action-tree-exp))
name-exp)))]
[(_ behavior-exp initial-state-exp initial-action-tree-exp)
(<spawn> (lambda ()
(list (wrap-monolithic-behaviour behavior-exp)
(differentiate-outgoing (wrap-monolithic-state initial-state-exp)
(clean-actions initial-action-tree-exp))
#f)))]))
(make-spawn (lambda ()
(list (wrap-monolithic-behaviour behavior-exp)
(differentiate-outgoing (wrap-monolithic-state initial-state-exp)
(clean-actions initial-action-tree-exp))
#f)))]))
(define-syntax spawn-monolithic/stateless
(syntax-rules ()

27
racket/syndicate/relay.rkt
View File

@ -90,19 +90,20 @@
inbound-constructor
inbound-parenthesis
inner-spawn)
(<spawn> (lambda ()
(define-values (proc initial-transition) (spawn->process+transition inner-spawn))
(define initial-relay-state (relay outbound?
outbound-assertion
outbound-parenthesis
inbound-constructor
inbound-parenthesis
proc))
(list relay-handle-event
(relay-transition (transition-bind (inject-relay-subscription initial-relay-state)
initial-transition)
initial-relay-state)
(process-name proc)))))
(make-spawn (lambda ()
(define-values (proc initial-transition) (spawn->process+transition inner-spawn))
(define initial-relay-state (relay outbound?
outbound-assertion
outbound-parenthesis
inbound-constructor
inbound-parenthesis
proc))
(list relay-handle-event
(relay-transition
(transition-bind (inject-relay-subscription initial-relay-state)
initial-transition)
initial-relay-state)
(process-name proc)))))
(define (pretty-print-relay r p)
(fprintf p "RELAY ~a/~a\n"

22
racket/syndicate/threaded.rkt
View File

@ -27,17 +27,17 @@
#f]))
(define (spawn-threaded-actor spawn-action-thunk)
(<spawn> (lambda ()
(define path (current-actor-path))
(define thd (thread (lambda () (run-thread path spawn-action-thunk))))
(thread (lambda ()
(sync (thread-dead-evt thd))
(send-ground-message (thread-quit #f '()) #:path path)
(signal-background-activity! #f)))
(signal-background-activity! #t)
(list proxy-behaviour
(transition (proxy-state thd) '())
'threaded-proxy))))
(make-spawn (lambda ()
(define path (current-actor-path))
(define thd (thread (lambda () (run-thread path spawn-action-thunk))))
(thread (lambda ()
(sync (thread-dead-evt thd))
(send-ground-message (thread-quit #f '()) #:path path)
(signal-background-activity! #f)))
(signal-background-activity! #t)
(list proxy-behaviour
(transition (proxy-state thd) '())
'threaded-proxy))))
(define (run-thread actor-path spawn-action-thunk)
(define actor-path-rev (reverse actor-path))