during
This commit is contained in:
parent
632c04139b
commit
00bf7d2364
|
@ -0,0 +1,32 @@
|
||||||
|
#lang typed/syndicate/roles
|
||||||
|
|
||||||
|
;; Expected Output
|
||||||
|
;; +GO
|
||||||
|
;; +ready
|
||||||
|
;; -GO
|
||||||
|
;; -ready
|
||||||
|
|
||||||
|
(define-type-alias ds-type
|
||||||
|
(U (Tuple String) (Observe (Tuple ★/t))))
|
||||||
|
|
||||||
|
(dataspace ds-type
|
||||||
|
(spawn ds-type
|
||||||
|
(start-facet _
|
||||||
|
(fields)
|
||||||
|
(during (tuple "GO")
|
||||||
|
(assert (tuple "ready")))))
|
||||||
|
(spawn ds-type
|
||||||
|
(start-facet flag
|
||||||
|
(fields)
|
||||||
|
;; type error when this was mistakenly just "GO"
|
||||||
|
(assert (tuple "GO"))
|
||||||
|
(on (asserted (tuple "ready"))
|
||||||
|
(stop flag))))
|
||||||
|
(spawn ds-type
|
||||||
|
(start-facet obs
|
||||||
|
(fields)
|
||||||
|
(during (tuple (bind s String))
|
||||||
|
(on start
|
||||||
|
(printf "+~a\n" s))
|
||||||
|
(on stop
|
||||||
|
(printf "-~a\n" s))))))
|
|
@ -11,6 +11,8 @@
|
||||||
Observe Inbound Outbound Actor U
|
Observe Inbound Outbound Actor U
|
||||||
;; Statements
|
;; Statements
|
||||||
let let* if spawn dataspace start-facet set! begin stop #;unsafe-do
|
let let* if spawn dataspace start-facet set! begin stop #;unsafe-do
|
||||||
|
;; Derived Forms
|
||||||
|
during
|
||||||
;; endpoints
|
;; endpoints
|
||||||
assert on
|
assert on
|
||||||
;; expressions
|
;; expressions
|
||||||
|
@ -754,13 +756,14 @@
|
||||||
[_
|
[_
|
||||||
#'()]))
|
#'()]))
|
||||||
|
|
||||||
(define-for-syntax (compile-pattern pat bind-id-transformer exp-transformer)
|
;; TODO - figure out why this needs different list identifiers
|
||||||
|
(define-for-syntax (compile-pattern pat list-binding bind-id-transformer exp-transformer)
|
||||||
(define (l-e stx) (local-expand stx 'expression '()))
|
(define (l-e stx) (local-expand stx 'expression '()))
|
||||||
(let loop ([pat pat])
|
(let loop ([pat pat])
|
||||||
(syntax-parse pat
|
(syntax-parse pat
|
||||||
#:datum-literals (tuple discard bind)
|
#:datum-literals (tuple discard bind)
|
||||||
[(tuple p ...)
|
[(tuple p ...)
|
||||||
#`(list 'tuple #,@(stx-map loop #'(p ...)))]
|
#`(#,list-binding 'tuple #,@(stx-map loop #'(p ...)))]
|
||||||
[(k:kons1 p)
|
[(k:kons1 p)
|
||||||
#`(#,(kons1->constructor #'k) #,(loop #'p))]
|
#`(#,(kons1->constructor #'k) #,(loop #'p))]
|
||||||
[(bind x:id τ:type)
|
[(bind x:id τ:type)
|
||||||
|
@ -777,11 +780,13 @@
|
||||||
|
|
||||||
(define-for-syntax (compile-syndicate-pattern pat)
|
(define-for-syntax (compile-syndicate-pattern pat)
|
||||||
(compile-pattern pat
|
(compile-pattern pat
|
||||||
|
#'list-
|
||||||
(lambda (id) #`($ #,id))
|
(lambda (id) #`($ #,id))
|
||||||
identity))
|
identity))
|
||||||
|
|
||||||
(define-for-syntax (compile-match-pattern pat)
|
(define-for-syntax (compile-match-pattern pat)
|
||||||
(compile-pattern pat
|
(compile-pattern pat
|
||||||
|
#'list
|
||||||
identity
|
identity
|
||||||
(lambda (exp) #`(==- #,exp))))
|
(lambda (exp) #`(==- #,exp))))
|
||||||
|
|
||||||
|
@ -831,6 +836,39 @@
|
||||||
----------------------------------------------------
|
----------------------------------------------------
|
||||||
[⊢ (x- e-) (⇒ : ★/t)])
|
[⊢ (x- e-) (⇒ : ★/t)])
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Derived Forms
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(define-typed-syntax (during p s ...) ≫
|
||||||
|
#:with inst-p (instantiate-pattern #'p)
|
||||||
|
----------------------------------------
|
||||||
|
[≻ (on (asserted p)
|
||||||
|
(start-facet during-inner
|
||||||
|
(fields)
|
||||||
|
(on (retracted inst-p)
|
||||||
|
(stop during-inner))
|
||||||
|
s ...))])
|
||||||
|
|
||||||
|
;; TODO - reconcile this with `compile-pattern`
|
||||||
|
(define-for-syntax (instantiate-pattern pat)
|
||||||
|
(let loop ([pat pat])
|
||||||
|
(syntax-parse pat
|
||||||
|
#:datum-literals (tuple discard bind)
|
||||||
|
[(tuple p ...)
|
||||||
|
#`(tuple #,@(stx-map loop #'(p ...)))]
|
||||||
|
[(k:kons1 p)
|
||||||
|
#`(k #,(loop #'p))]
|
||||||
|
[(bind x:id τ)
|
||||||
|
#'x]
|
||||||
|
[discard
|
||||||
|
#'_]
|
||||||
|
[(~constructor-exp ctor p ...)
|
||||||
|
(define/with-syntax uctor (untyped-ctor #'ctor))
|
||||||
|
#`(ctor #,@(stx-map loop #'(p ...)))]
|
||||||
|
[_
|
||||||
|
pat])))
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; Expressions
|
;; Expressions
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
Loading…
Reference in New Issue