diff --git a/racket/typed/core-expressions.rkt b/racket/typed/core-expressions.rkt index 6022be8..b5f6917 100644 --- a/racket/typed/core-expressions.rkt +++ b/racket/typed/core-expressions.rkt @@ -386,11 +386,13 @@ (define x : τ sel) ...)]) (define-typed-syntax (match-define pat:expr e:expr) ≫ - #:with ([x τ] ...) (pat-bindings #'pat) + [⊢ e ≫ e- (⇒ : τ-e)] + #:with pat+ (elaborate-pattern/with-type #'pat #'τ-e) + #:with ([x τ] ...) (pat-bindings #'pat+) ---------------------------------------- [≻ (define-tuple (x ...) - (match e - [pat + (match e- + [pat+ (tuple x ...)]))]) ;; extremely limited match-define for `define-constructor`-d things diff --git a/racket/typed/roles.rkt b/racket/typed/roles.rkt index dd37a04..7801c4d 100644 --- a/racket/typed/roles.rkt +++ b/racket/typed/roles.rkt @@ -193,14 +193,15 @@ [⊢ (syndicate:on-stop s-) (⇒ : ★/t) (⇒ ν-ep (τ-r))]] [(on (a/r/m:asserted/retracted/message p) s ...) ≫ - [⊢ p ≫ p-- (⇒ : τp)] + #:with p/e (elaborate-pattern #'p) + [⊢ p/e ≫ p-- (⇒ : τp)] #:fail-unless (pure? #'p--) "pattern not allowed to have effects" - #:with ([x:id τ:type] ...) (pat-bindings #'p) + #:with ([x:id τ:type] ...) (pat-bindings #'p/e) [[x ≫ x- : τ] ... ⊢ (begin s ...) ≫ s- (⇒ ν-ep (~effs)) (⇒ ν-f (~effs τ-f ...)) (⇒ ν-s (~effs τ-s ...))] - #:with p- (substs #'(x- ...) #'(x ...) (compile-syndicate-pattern #'p)) + #:with p- (substs #'(x- ...) #'(x ...) (compile-syndicate-pattern #'p/e)) #:with τ-r (type-eval #'(Reacts (a/r/m.react-con τp) τ-f ... τ-s ...)) ----------------------------------- [⊢ (syndicate:on (a/r/m.syndicate-kw p-) @@ -271,9 +272,10 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define-typed-syntax (during p s ...) ≫ - #:with inst-p (instantiate-pattern #'p) + #:with p+ (elaborate-pattern #'p) + #:with inst-p (instantiate-pattern #'p+) ---------------------------------------- - [≻ (on (asserted p) + [≻ (on (asserted p+) (start-facet during-inner (on (retracted inst-p) (stop during-inner)) @@ -311,18 +313,20 @@ ;; TODO: #:on-add (define-typed-syntax (define/query-set x:id p e) ≫ - #:with ([y τ] ...) (pat-bindings #'p) + #:with p+ (elaborate-pattern #'p) + #:with ([y τ] ...) (pat-bindings #'p+) ;; e will be re-expanded :/ [[y ≫ y- : τ] ... ⊢ e ≫ e- ⇒ τ-e] ---------------------------------------- [≻ (begin (field [x (Set τ-e) (set)]) - (on (asserted p) + (on (asserted p+) (set! x (set-add (ref x) e))) - (on (retracted p) + (on (retracted p+) (set! x (set-remove (ref x) e))))]) (define-typed-syntax (define/query-hash x:id p e-key e-value) ≫ - #:with ([y τ] ...) (pat-bindings #'p) + #:with p+ (elaborate-pattern #'p) + #:with ([y τ] ...) (pat-bindings #'p+) ;; e-key and e-value will be re-expanded :/ ;; but it's the most straightforward way to keep bindings in sync with ;; pattern @@ -334,9 +338,9 @@ ;; gets their references to pattern variables out of sync with `p` ---------------------------------------- [≻ (begin (field [x (Hash τ-key τ-value) (hash)]) - (on (asserted p) + (on (asserted p+) (set! x (hash-set (ref x) e-key e-value))) - (on (retracted p) + (on (retracted p+) (set! x (hash-remove (ref x) e-key))))]) (define-typed-syntax (stop-when E script ...) ≫