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

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,21 +727,23 @@
(syntax/loc stx (syntax/loc stx
(check-true (run-with-trace any ...)))])) (check-true (run-with-trace any ...)))]))
(define test-program (module+ test
(define test-program
`((actor (react (on-start (printf "hello,world\n")))))) `((actor (react (on-start (printf "hello,world\n"))))))
(define test-program2 (define test-program2
`( `(
(actor (react (on (asserted 5) (actor (react (on (asserted 5)
(printf "wat\n")))) (printf "wat\n"))))
(actor (react (assert 5))))) (actor (react (assert 5)))))
(test-trace (trace (assertion-added (observe 5)) (test-trace (trace (assertion-added (observe 5))
(assertion-added 5)) (assertion-added 5))
test-program2) test-program2)
(define ping-pong (define ping-pong
`( `(
(actor (react (on (message "ping") (actor (react (on (message "ping")
(printf "ping\n") (printf "ping\n")
@ -748,7 +753,7 @@
(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")
@ -758,7 +763,7 @@
(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)))
@ -775,22 +780,39 @@
(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)))
(and (assertion-added '(list "account" 70))
(assertion-removed '(list "account" 100))))
bank-account bank-account
#:timeout 5000) #: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
'( '(
(actor (react (on (message 5) (actor (react (on (message 5)