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

sort out relaying in hll interperter

This commit is contained in:
Sam Caldwell 2017-03-07 13:01:11 -05:00
parent df40cc7ba9
commit 079e2da53d
1 changed files with 80 additions and 58 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

138
racket/syndicate/little-actors/core.rkt
View File

@ -272,7 +272,10 @@
[`(dataspace ,as ...) [`(dataspace ,as ...)
(define boot-actions (for/list ([a (in-list as)]) (define boot-actions (for/list ([a (in-list as)])
(boot-actor a Γ))) (boot-actor a Γ)))
(spawn-dataspace boot-actions)])) ;; note the recursive upside-down wrapping of dataspaces--
;; the upside-down-relay is needed for things to line up properly
(spawn-upside-down
(dataspace-actor (cons upside-down-relay boot-actions)))]))
;; eval-exp : exp Γ σ -> (Continue val) ;; eval-exp : exp Γ σ -> (Continue val)
(define (eval-exp e Γ σ) (define (eval-exp e Γ σ)
@ -670,7 +673,7 @@
(define boot-actions (define boot-actions
(for/list ([boot (in-list p)]) (for/list ([boot (in-list p)])
(boot-actor boot mt-Γ))) (boot-actor boot mt-Γ)))
(run-ground boot-actions)) (run-ground (cons upside-down-relay boot-actions)))
;; Actor AsyncChannel Program -> Boolean ;; Actor AsyncChannel Program -> Boolean
;; trace-actor is the first actor spawned inside the program's ground dataspace ;; trace-actor is the first actor spawned inside the program's ground dataspace
@ -684,7 +687,7 @@
(define syndicate-thread (define syndicate-thread
(thread (lambda () (thread (lambda ()
(engine-run timeout (engine-run timeout
(engine (lambda (x) (run-ground (cons trace-actor boot-actions)))))))) (engine (lambda (x) (run-ground (cons trace-actor (cons upside-down-relay boot-actions)))))))))
(define result (define result
(sync (handle-evt chan (sync (handle-evt chan
(lambda (val) #t)) (lambda (val) #t))
@ -724,72 +727,91 @@
(syntax/loc stx (syntax/loc stx
(check-true (run-with-trace any ...)))])) (check-true (run-with-trace any ...)))]))
(define test-program (module+ test
`((actor (react (on-start (printf "hello,world\n"))))))
(define test-program2 (define test-program
`( `((actor (react (on-start (printf "hello,world\n"))))))
(actor (react (on (asserted 5)
(printf "wat\n"))))
(actor (react (assert 5)))))
(test-trace (trace (assertion-added (observe 5)) (define test-program2
(assertion-added 5)) `(
test-program2) (actor (react (on (asserted 5)
(printf "wat\n"))))
(actor (react (assert 5)))))
(test-trace (trace (assertion-added (observe 5))
(assertion-added 5))
test-program2)
(define ping-pong (define ping-pong
`( `(
(actor (react (on (message "ping") (actor (react (on (message "ping")
(printf "ping\n") (printf "ping\n")
(send! "pong")))) (send! "pong"))))
(actor (react (on (message "pong") (actor (react (on (message "pong")
(printf "pong\n") (printf "pong\n")
(send! "ping")) (send! "ping"))
(on-start (send! "ping")))))) (on-start (send! "ping"))))))
(test-trace (trace (message "ping") (test-trace (trace (message "ping")
(message "pong") (message "pong")
(message "ping") (message "ping")
(message "pong") (message "pong")
(message "ping") (message "ping")
(message "pong") (message "pong")
(message "ping") (message "ping")
(message "pong")) (message "pong"))
ping-pong) ping-pong)
(define bank-account (define bank-account
`( `(
(actor (react (field balance 0) (actor (react (field balance 0)
(assert (list "account" (read balance))) (assert (list "account" (read balance)))
(on (message (list "deposit" $amount)) (on (message (list "deposit" $amount))
(set! balance (+ (read balance) amount))))) (set! balance (+ (read balance) amount)))))
(actor (react (on (asserted (list "account" $balance)) (actor (react (on (asserted (list "account" $balance))
(printf "Balance changed to ~a\n" balance)) (printf "Balance changed to ~a\n" balance))
(stop-when (asserted (list "account" 70)) (stop-when (asserted (list "account" 70))
(printf "bye\n")) (printf "bye\n"))
(on-stop (printf "good.\n")))) (on-stop (printf "good.\n"))))
(actor (react (stop-when (asserted (observe (list "deposit" _))) (actor (react (stop-when (asserted (observe (list "deposit" _)))
(send! (list "deposit" +100)) (send! (list "deposit" +100))
(send! (list "deposit" -30))))))) (send! (list "deposit" -30)))))))
(test-trace (trace (assertion-added '(list "account" 0)) (test-trace (trace (assertion-added '(list "account" 0))
(and (assertion-added '(list "account" 100)) (assertion-removed '(list "account" 0))) (and (assertion-added '(list "account" 100))
(and (assertion-added '(list "account" 70)) (assertion-removed '(list "account" 100)))) (assertion-removed '(list "account" 0)))
bank-account (and (assertion-added '(list "account" 70))
#:timeout 5000) (assertion-removed '(list "account" 100))))
bank-account
#:timeout 5000)
(define multi-level-ex (define multi-level-ex
'( '(
(actor (react (on (asserted "hello") (actor (react (on (asserted "hello")
(printf "goodbye")))) (printf "goodbye"))))
(dataspace (actor (react (assert (outbound "hello"))))))) (dataspace (actor (react (assert (outbound "hello")))))))
;; this fails because upside-down doesn't handle relaying right (test-trace (trace (assertion-added "hello"))
#;(test-trace (trace (assertion-added "hello")) multi-level-ex)
multi-level-ex)
(define multi-level-message
'(
(actor (react (on (message "hello"))))
(dataspace (actor (react (on-start (send! (outbound "hello"))))))))
(test-trace (trace (message "hello"))
multi-level-message)
(define multi-level-other-way
'(
(dataspace (actor (react (on (asserted (inbound "gday"))
(send! (outbound "good things"))))))
(actor (react (assert "gday")))))
(test-trace (trace (message "good things"))
multi-level-other-way))
(define ff (define ff
'( '(