stop statement
This commit is contained in:
parent
33af13016b
commit
3705d95856
|
@ -0,0 +1,32 @@
|
||||||
|
#lang typed/syndicate/roles
|
||||||
|
|
||||||
|
;; Expected Output:
|
||||||
|
;; +42
|
||||||
|
;; +18
|
||||||
|
;; +88
|
||||||
|
;; -18
|
||||||
|
|
||||||
|
(define-type-alias ds-type
|
||||||
|
(U (Tuple Int)
|
||||||
|
(Observe (Tuple ★/t))))
|
||||||
|
|
||||||
|
(dataspace ds-type
|
||||||
|
(spawn ds-type
|
||||||
|
(print-role
|
||||||
|
(start-facet doomed
|
||||||
|
(fields)
|
||||||
|
(assert (tuple 18))
|
||||||
|
(on (asserted (tuple 42))
|
||||||
|
(stop doomed
|
||||||
|
(start-facet the-afterlife
|
||||||
|
(fields)
|
||||||
|
(assert (tuple 88))))))))
|
||||||
|
|
||||||
|
(spawn ds-type
|
||||||
|
(start-facet obs
|
||||||
|
(fields)
|
||||||
|
(assert (tuple 42))
|
||||||
|
(on (asserted (tuple (bind x Int)))
|
||||||
|
(printf "+~v\n" x))
|
||||||
|
(on (retracted (tuple (bind x Int)))
|
||||||
|
(printf "-~v\n" x)))))
|
|
@ -6,11 +6,11 @@
|
||||||
require only-in
|
require only-in
|
||||||
;; Types
|
;; Types
|
||||||
Int Bool String Tuple Bind Discard → List
|
Int Bool String Tuple Bind Discard → List
|
||||||
Role Reacts Shares Know ¬Know Message
|
Role Reacts Shares Know ¬Know Message Stop
|
||||||
FacetName Field ★/t
|
FacetName Field ★/t
|
||||||
Observe Inbound Outbound Actor U
|
Observe Inbound Outbound Actor U
|
||||||
;; Statements
|
;; Statements
|
||||||
#;let spawn dataspace start-facet set! #;begin #;stop #;unsafe-do
|
#;let spawn dataspace start-facet set! #;begin stop #;unsafe-do
|
||||||
;; endpoints
|
;; endpoints
|
||||||
assert on
|
assert on
|
||||||
;; expressions
|
;; expressions
|
||||||
|
@ -20,13 +20,12 @@
|
||||||
;; patterns
|
;; patterns
|
||||||
bind discard
|
bind discard
|
||||||
;; primitives
|
;; primitives
|
||||||
+ - * / and or not > < >= <= = equal? displayln
|
+ - * / and or not > < >= <= = equal? displayln printf
|
||||||
;; making types
|
;; making types
|
||||||
define-type-alias
|
define-type-alias
|
||||||
define-constructor
|
define-constructor
|
||||||
;; DEBUG and utilities
|
;; DEBUG and utilities
|
||||||
print-type print-role
|
print-type print-role
|
||||||
(rename-out [printf- printf])
|
|
||||||
;; Extensions
|
;; Extensions
|
||||||
;; match if cond
|
;; match if cond
|
||||||
)
|
)
|
||||||
|
@ -66,6 +65,7 @@
|
||||||
(define-type-constructor Reacts #:arity >= 1)
|
(define-type-constructor Reacts #:arity >= 1)
|
||||||
(define-type-constructor Know #:arity = 1)
|
(define-type-constructor Know #:arity = 1)
|
||||||
(define-type-constructor ¬Know #:arity = 1)
|
(define-type-constructor ¬Know #:arity = 1)
|
||||||
|
(define-type-constructor Stop #:arity >= 1)
|
||||||
(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)
|
||||||
|
@ -350,6 +350,8 @@
|
||||||
;; RoleType -> (Values Type Type)
|
;; RoleType -> (Values Type Type)
|
||||||
(define-for-syntax (analyze-role-input/output t)
|
(define-for-syntax (analyze-role-input/output t)
|
||||||
(syntax-parse t
|
(syntax-parse t
|
||||||
|
[(~Stop name:id τ-r)
|
||||||
|
(analyze-role-input/output #'τ-r)]
|
||||||
[(~Role (name:id)
|
[(~Role (name:id)
|
||||||
(~or (~Shares τ-s)
|
(~or (~Shares τ-s)
|
||||||
(~Reacts τ-if τ-then ...)) ...
|
(~Reacts τ-if τ-then ...)) ...
|
||||||
|
@ -638,6 +640,17 @@
|
||||||
(⇒ f ())
|
(⇒ f ())
|
||||||
(⇒ s ())])
|
(⇒ s ())])
|
||||||
|
|
||||||
|
(define-typed-syntax (stop facet-name:id cont) ≫
|
||||||
|
[⊢ facet-name ≫ facet-name- (⇐ : FacetName)]
|
||||||
|
[⊢ cont ≫ cont- (⇒ a (~effs)) (⇒ r (~effs)) (⇒ s (~effs)) (⇒ f (~effs τ-f ...))]
|
||||||
|
#:with τ (mk-Stop- #'(facet-name- τ-f ...))
|
||||||
|
---------------------------------------------------------------------------------
|
||||||
|
[⊢ (syndicate:stop-facet facet-name- cont-) (⇒ : ★/t)
|
||||||
|
(⇒ s ())
|
||||||
|
(⇒ a ())
|
||||||
|
(⇒ r ())
|
||||||
|
(⇒ f (τ))])
|
||||||
|
|
||||||
(begin-for-syntax
|
(begin-for-syntax
|
||||||
(define-syntax-class asserted-or-retracted
|
(define-syntax-class asserted-or-retracted
|
||||||
#:datum-literals (asserted retracted)
|
#:datum-literals (asserted retracted)
|
||||||
|
@ -719,6 +732,7 @@
|
||||||
|
|
||||||
(define-typed-syntax (spawn τ-c:type s) ≫
|
(define-typed-syntax (spawn τ-c:type s) ≫
|
||||||
#:fail-unless (flat-type? #'τ-c.norm) "Communication type must be first-order"
|
#:fail-unless (flat-type? #'τ-c.norm) "Communication type must be first-order"
|
||||||
|
;; TODO: check that each τ-f is a Role
|
||||||
[⊢ s ≫ s- (⇒ a (~effs)) (⇒ r (~effs)) (⇒ s (~effs)) (⇒ f (~effs τ-f ...))]
|
[⊢ s ≫ s- (⇒ a (~effs)) (⇒ r (~effs)) (⇒ s (~effs)) (⇒ f (~effs τ-f ...))]
|
||||||
;; TODO: s shouldn't refer to facets or fields!
|
;; TODO: s shouldn't refer to facets or fields!
|
||||||
#:with (τ-i τ-o) (analyze-roles #'(τ-f ...))
|
#:with (τ-i τ-o) (analyze-roles #'(τ-f ...))
|
||||||
|
@ -915,6 +929,12 @@
|
||||||
---------------
|
---------------
|
||||||
[⊢ (displayln- e-) (⇒ : ★/t)])
|
[⊢ (displayln- e-) (⇒ : ★/t)])
|
||||||
|
|
||||||
|
(define-typed-syntax (printf e ...+) ≫
|
||||||
|
[⊢ e ≫ e- (⇒ : τ)] ...
|
||||||
|
#:fail-unless (stx-andmap pure? #'(e- ...)) "expression not allowed to have effects"
|
||||||
|
---------------
|
||||||
|
[⊢ (printf- e- ...) (⇒ : ★/t)])
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; Basic Values
|
;; Basic Values
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
Loading…
Reference in New Issue