Keep track of branches for role effects in turnstile lang
This commit is contained in:
parent
c726fb2bdd
commit
19f915620e
|
@ -80,7 +80,7 @@
|
||||||
;; ν-ep key aggregates endpoint affects:
|
;; ν-ep key aggregates endpoint affects:
|
||||||
;; `Shares`, `Reacts`, and `MakesField`
|
;; `Shares`, `Reacts`, and `MakesField`
|
||||||
;; Note thar MakesField is only an effect, not a type
|
;; Note thar MakesField is only an effect, not a type
|
||||||
;; ν-f key aggregates facet effects (starting a facet) as `Role`s and message sends, `Sends`
|
;; ν-f key aggregates facet effects (starting/stopping a facet) as `Role`s & `Stop`s and message sends, `Sends`
|
||||||
;; ν-s key aggregates spawned actors as `Actor`s
|
;; ν-s key aggregates spawned actors as `Actor`s
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
@ -97,6 +97,11 @@
|
||||||
(define-type-constructor Message #:arity = 1)
|
(define-type-constructor Message #:arity = 1)
|
||||||
(define-type-constructor Field #:arity = 1)
|
(define-type-constructor Field #:arity = 1)
|
||||||
(define-type-constructor Bind #:arity = 1)
|
(define-type-constructor Bind #:arity = 1)
|
||||||
|
;; keep track of branches for facet effects
|
||||||
|
;; (Branch (Listof (Listof Type)))
|
||||||
|
(define-type-constructor Branch #:arity >= 0)
|
||||||
|
;; sequence of effects
|
||||||
|
(define-type-constructor Effs #:arity >= 0)
|
||||||
(define-base-types OnStart OnStop OnDataflow MakesField)
|
(define-base-types OnStart OnStop OnDataflow MakesField)
|
||||||
(define-for-syntax field-prop-name 'fields)
|
(define-for-syntax field-prop-name 'fields)
|
||||||
|
|
||||||
|
@ -394,6 +399,19 @@
|
||||||
;; Conveniences
|
;; Conveniences
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
;; (SyntaxListof (SyntaxListof Type)) -> (U (SyntaxListof Branch) #'())
|
||||||
|
(define-for-syntax (make-Branch tys*)
|
||||||
|
(syntax-parse tys*
|
||||||
|
[()
|
||||||
|
#'()]
|
||||||
|
[(() ...)
|
||||||
|
#'()]
|
||||||
|
[((ty ...) ...)
|
||||||
|
(define effs
|
||||||
|
(for/list ([tys (in-syntax tys*)])
|
||||||
|
(mk-Effs- (syntax->list tys))))
|
||||||
|
#`(#,(mk-Branch- effs))]))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; Syntax
|
;; Syntax
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
@ -506,6 +524,9 @@
|
||||||
;; RoleType -> (Values InputType OutputType SpawnType)
|
;; RoleType -> (Values InputType OutputType SpawnType)
|
||||||
(define-for-syntax (analyze-role-input/output t)
|
(define-for-syntax (analyze-role-input/output t)
|
||||||
(syntax-parse t
|
(syntax-parse t
|
||||||
|
[(~Branch (~Effs τ-r ...) ...)
|
||||||
|
#:with (τi τo τa) (analyze-roles #'(τ-r ... ...))
|
||||||
|
(values #'τi #'τo #'τa)]
|
||||||
[(~Stop name:id τ-r ...)
|
[(~Stop name:id τ-r ...)
|
||||||
#:with (τi τo τa) (analyze-roles #'(τ-r ...))
|
#:with (τi τo τa) (analyze-roles #'(τ-r ...))
|
||||||
(values #'τi #'τo #'τa)]
|
(values #'τi #'τo #'τa)]
|
||||||
|
@ -1570,7 +1591,7 @@
|
||||||
--------
|
--------
|
||||||
[⊢ (if- e_tst- e1- e2-)
|
[⊢ (if- e_tst- e1- e2-)
|
||||||
(⇒ ν-ep (eps1 ... eps2 ...))
|
(⇒ ν-ep (eps1 ... eps2 ...))
|
||||||
(⇒ ν-f (fs1 ... fs2 ...))
|
(⇒ ν-f #,(make-Branch #'((fs1 ...) (fs2 ...))))
|
||||||
(⇒ ν-s (ss1 ... ss2 ...))]]
|
(⇒ ν-s (ss1 ... ss2 ...))]]
|
||||||
[(_ e_tst e1 e2) ≫
|
[(_ e_tst e1 e2) ≫
|
||||||
[⊢ e_tst ≫ e_tst- ⇒ _] ; Any non-false value is truthy.
|
[⊢ e_tst ≫ e_tst- ⇒ _] ; Any non-false value is truthy.
|
||||||
|
@ -1583,7 +1604,7 @@
|
||||||
--------
|
--------
|
||||||
[⊢ (if- e_tst- e1- e2-) (⇒ : τ)
|
[⊢ (if- e_tst- e1- e2-) (⇒ : τ)
|
||||||
(⇒ ν-ep (eps1 ... eps2 ...))
|
(⇒ ν-ep (eps1 ... eps2 ...))
|
||||||
(⇒ ν-f (fs1 ... fs2 ...))
|
(⇒ ν-f #,(make-Branch #'((fs1 ...) (fs2 ...))))
|
||||||
(⇒ ν-s (ss1 ... ss2 ...))]])
|
(⇒ ν-s (ss1 ... ss2 ...))]])
|
||||||
|
|
||||||
(define-typed-syntax (when e s ...+) ≫
|
(define-typed-syntax (when e s ...+) ≫
|
||||||
|
@ -1651,7 +1672,7 @@
|
||||||
------------------------------------------------
|
------------------------------------------------
|
||||||
[⊢ (cond- [pred- s-] ...) (⇒ : (U τ-s ...))
|
[⊢ (cond- [pred- s-] ...) (⇒ : (U τ-s ...))
|
||||||
(⇒ ν-ep (eps ... ...))
|
(⇒ ν-ep (eps ... ...))
|
||||||
(⇒ ν-f (fs ... ...))
|
(⇒ ν-f #,(make-Branch #'((fs ...) ...)))
|
||||||
(⇒ ν-s (ss ... ...))])
|
(⇒ ν-s (ss ... ...))])
|
||||||
|
|
||||||
(define-typed-syntax (match e [p s ...+] ...+) ≫
|
(define-typed-syntax (match e [p s ...+] ...+) ≫
|
||||||
|
@ -1676,7 +1697,7 @@
|
||||||
[_ (error "incomplete pattern match")])
|
[_ (error "incomplete pattern match")])
|
||||||
(⇒ : (U τ-s ...))
|
(⇒ : (U τ-s ...))
|
||||||
(⇒ ν-ep (eps ... ...))
|
(⇒ ν-ep (eps ... ...))
|
||||||
(⇒ ν-f (fs ... ...))
|
(⇒ ν-f #,(make-Branch #'((fs ...) ...)))
|
||||||
(⇒ ν-s (ss ... ...))])
|
(⇒ ν-s (ss ... ...))])
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
Loading…
Reference in New Issue