syndicate-lang
/
syndicate-2017
1
0
Fork 0
Code Issues Pull Requests Projects Releases Wiki Activity

elaborate more patterns

This commit is contained in:
Sam Caldwell 2019-05-24 10:05:23 -04:00
parent d91f13bd2c
commit 60c58d2b7b
2 changed files with 20 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
racket/typed/core-expressions.rkt
View File

@ -386,11 +386,13 @@
(define x : τ sel) ...)]) (define x : τ sel) ...)])
(define-typed-syntax (match-define pat:expr e:expr) ≫ (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 ...) [≻ (define-tuple (x ...)
(match e (match e-
[pat [pat+
(tuple x ...)]))]) (tuple x ...)]))])
;; extremely limited match-define for `define-constructor`-d things ;; extremely limited match-define for `define-constructor`-d things

26
racket/typed/roles.rkt
View File

@ -193,14 +193,15 @@
[⊢ (syndicate:on-stop s-) (⇒ : ★/t) [⊢ (syndicate:on-stop s-) (⇒ : ★/t)
(⇒ ν-ep (τ-r))]] (⇒ ν-ep (τ-r))]]
[(on (a/r/m:asserted/retracted/message p) s ...) ≫ [(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" #: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- [[x ≫ x- : τ] ... ⊢ (begin s ...) ≫ s-
(⇒ ν-ep (~effs)) (⇒ ν-ep (~effs))
(⇒ ν-f (~effs τ-f ...)) (⇒ ν-f (~effs τ-f ...))
(⇒ ν-s (~effs τ-s ...))] (⇒ ν-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 ...)) #:with τ-r (type-eval #'(Reacts (a/r/m.react-con τp) τ-f ... τ-s ...))
----------------------------------- -----------------------------------
[⊢ (syndicate:on (a/r/m.syndicate-kw p-) [⊢ (syndicate:on (a/r/m.syndicate-kw p-)
@ -271,9 +272,10 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-typed-syntax (during p s ...) ≫ (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 (start-facet during-inner
(on (retracted inst-p) (on (retracted inst-p)
(stop during-inner)) (stop during-inner))
@ -311,18 +313,20 @@
;; TODO: #:on-add ;; TODO: #:on-add
(define-typed-syntax (define/query-set x:id p e) ≫ (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 :/ ;; e will be re-expanded :/
[[y ≫ y- : τ] ... ⊢ e ≫ e- ⇒ τ-e] [[y ≫ y- : τ] ... ⊢ e ≫ e- ⇒ τ-e]
---------------------------------------- ----------------------------------------
[≻ (begin (field [x (Set τ-e) (set)]) [≻ (begin (field [x (Set τ-e) (set)])
(on (asserted p) (on (asserted p+)
(set! x (set-add (ref x) e))) (set! x (set-add (ref x) e)))
(on (retracted p) (on (retracted p+)
(set! x (set-remove (ref x) e))))]) (set! x (set-remove (ref x) e))))])
(define-typed-syntax (define/query-hash x:id p e-key e-value) ≫ (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 :/ ;; e-key and e-value will be re-expanded :/
;; but it's the most straightforward way to keep bindings in sync with ;; but it's the most straightforward way to keep bindings in sync with
;; pattern ;; pattern
@ -334,9 +338,9 @@
;; gets their references to pattern variables out of sync with `p` ;; gets their references to pattern variables out of sync with `p`
---------------------------------------- ----------------------------------------
[≻ (begin (field [x (Hash τ-key τ-value) (hash)]) [≻ (begin (field [x (Hash τ-key τ-value) (hash)])
(on (asserted p) (on (asserted p+)
(set! x (hash-set (ref x) e-key e-value))) (set! x (hash-set (ref x) e-key e-value)))
(on (retracted p) (on (retracted p+)
(set! x (hash-remove (ref x) e-key))))]) (set! x (hash-remove (ref x) e-key))))])
(define-typed-syntax (stop-when E script ...) ≫ (define-typed-syntax (stop-when E script ...) ≫