diff --git a/racket/syndicate/little-actors/core.rkt b/racket/syndicate/little-actors/core.rkt index 9fabfba..81d762e 100644 --- a/racket/syndicate/little-actors/core.rkt +++ b/racket/syndicate/little-actors/core.rkt @@ -61,7 +61,7 @@ ;; an `E` is either ;; ('asserted pat) or ;; ('retracted pat) or -;; (message pat) +;; ('message pat) ;; a `pat` is either ;; $var or @@ -202,7 +202,7 @@ (define (result-bind r f . extra-args) (match r [(continue v σ as fs) - (match (apply f (cons v (cons σ extra-args))) + (match (apply f v σ extra-args) [(continue next-v next-σ more-as more-fs) (continue next-v next-σ (append as more-as) (append fs more-fs))] [s s])] @@ -274,8 +274,7 @@ (actor-state trie-empty ft) (cons (scn assertions) as)))] [`(dataspace ,as ...) - (define boot-actions (for/list ([a (in-list as)]) - (boot-actor a Γ))) + (define boot-actions (for/list ([a (in-list as)]) (boot-actor a Γ))) ;; note the recursive upside-down wrapping of dataspaces-- ;; the upside-down-relay is needed for things to line up properly (spawn-upside-down @@ -355,6 +354,8 @@ (error 'eval-exp "wrong number of arguments; expected ~v, got ~v" (length vars) (length arg-vs))) (define new-env (append (map binding vars arg-vs) clo-env)) (eval-exp body-exp new-env final-sto)))))] + ;; TODO add a predicate + ;; atom? [x (continue x σ (list) (list))])) (module+ test @@ -621,8 +622,8 @@ ;; an OK is (ok σ FacetTree (ListofAction)) (struct ok (sto ft as) #:transparent) -;; run-facets : FacetTree π σ Event -> (U OK Stop) -(define (run-facets ft π parent-sto e) +;; run-all-facets : FacetTree π σ Event -> (U OK Stop) +(define (run-all-facets ft π parent-sto e) (match-define (facet-tree stx env sto children) ft) (define facet-sto (store-concat parent-sto sto)) ;; I'm really not confident about the way the stores are being handled here @@ -633,7 +634,7 @@ [as as] [new-children new-facets]) ([ft (in-list children)]) - (match (run-facets ft π sto e) + (match (run-all-facets ft π sto e) [(ok new-sto new-ft more-as) (values new-sto (append as more-as) @@ -646,6 +647,7 @@ (match-define (store-concat new-parent-sto new-facet-sto) final-sto) (ok new-parent-sto (facet-tree stx env new-facet-sto new-children) final-as)] [(stop (store-concat new-parent-sto new-facet-sto) as) + ;; BUG lose facets created during on-stop (match-define (stop final-parent-sto more-as) (shutdown-facet-tree (facet-tree stx env new-facet-sto children) new-parent-sto)) @@ -660,22 +662,20 @@ ([f (in-list children)]) (π-union π (ft-assertions f extended-env extended-sto)))) -;; actor-behavior : ActorState Event -> Transition +;; actor-behavior : Event ActorState -> Transition ;; leaf behavior function (define (actor-behavior e s) - (cond - [e - (with-handlers ([exn:fail? (lambda (e) (eprintf "exception: ~v\n" e) (quit #:exception e (list)))]) - (match-define (actor-state π-old ft) s) - (match (run-facets ft π-old mt-σ e) - [(ok _ ft as) - (define assertions (ft-assertions ft mt-Γ mt-σ)) - (define next-π (if (scn? e) (scn-trie e) π-old)) - (transition (actor-state next-π ft) - (cons (scn assertions) as))] - [(stop _ as) - (quit as)]))] - [else #f])) + (when e + (with-handlers ([exn:fail? (lambda (e) (eprintf "exception: ~v\n" e) (quit #:exception e (list)))]) + (match-define (actor-state π-old ft) s) + (match (run-all-facets ft π-old mt-σ e) + [(ok _ ft as) + (define assertions (ft-assertions ft mt-Γ mt-σ)) + (define next-π (if (scn? e) (scn-trie e) π-old)) + (transition (actor-state next-π ft) + (cons (scn assertions) as))] + [(stop _ as) + (quit as)])))) ;; run : Program -> Syndicate (define (run p) @@ -860,8 +860,6 @@ (assert "howdy"))) )) -#;(run competing-stop-whens) - ;; should this work? (define store-passing '( @@ -902,4 +900,20 @@ (send! "I am here")))))) (actor (react (on-start (send! "hello")))))) (check-false (run-with-trace (trace (message "I am here")) - do-new-facets-run-immediately))) \ No newline at end of file + do-new-facets-run-immediately))) + +(module+ test + (define maintain-knowledge + '( + (actor (react (on (asserted "hello") + (react (on (asserted "hello") + (printf "do I run?\n")))))) + + (actor (react (assert "hello")))))) + +(module+ test + (define escaping-field + '((actor (react (field x #f) + (on-start (react (field y 10) + (on-start (set! x (lambda (v) (set! y v))))) + ((read x) 5))))))) \ No newline at end of file