This commit is contained in:
Sam Caldwell 2018-08-01 11:30:25 -04:00 committed by Sam Caldwell
parent 632c04139b
commit 00bf7d2364
2 changed files with 72 additions and 2 deletions

View File

@ -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))))))

View File

@ -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
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;