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
|
||||
;; Statements
|
||||
let let* if spawn dataspace start-facet set! begin stop #;unsafe-do
|
||||
;; Derived Forms
|
||||
during
|
||||
;; endpoints
|
||||
assert on
|
||||
;; 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 '()))
|
||||
(let loop ([pat pat])
|
||||
(syntax-parse pat
|
||||
#:datum-literals (tuple discard bind)
|
||||
[(tuple p ...)
|
||||
#`(list 'tuple #,@(stx-map loop #'(p ...)))]
|
||||
#`(#,list-binding 'tuple #,@(stx-map loop #'(p ...)))]
|
||||
[(k:kons1 p)
|
||||
#`(#,(kons1->constructor #'k) #,(loop #'p))]
|
||||
[(bind x:id τ:type)
|
||||
|
@ -777,11 +780,13 @@
|
|||
|
||||
(define-for-syntax (compile-syndicate-pattern pat)
|
||||
(compile-pattern pat
|
||||
#'list-
|
||||
(lambda (id) #`($ #,id))
|
||||
identity))
|
||||
|
||||
(define-for-syntax (compile-match-pattern pat)
|
||||
(compile-pattern pat
|
||||
#'list
|
||||
identity
|
||||
(lambda (exp) #`(==- #,exp))))
|
||||
|
||||
|
@ -831,6 +836,39 @@
|
|||
----------------------------------------------------
|
||||
[⊢ (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
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
|
Loading…
Reference in New Issue