Add project-assertions convenience routine.

This commit is contained in:
Tony Garnock-Jones 2016-01-18 17:33:26 -05:00
parent aa9677dbe1
commit 1d28908600
8 changed files with 14 additions and 11 deletions

4
FAQ.md
View File

@ -164,8 +164,8 @@
(compile-projection (?! `(posn ,? ,?)))) (compile-projection (?! `(posn ,? ,?))))
``` ```
with the same example yields `(set (list ('posn 2 3))`. with the same example yields `(set (list ('posn 2 3))`.
- `matcher-project/set/single` is like calling `set-first` on the result of - `matcher-project/set/single` is like mapping `car` over the result of
`matcher-project/set` `matcher-project/set`. See also `project-assertions`.
- `patch-project/set` uses `values` to return the result of matching a projection - `patch-project/set` uses `values` to return the result of matching a projection
against both the added and removed bits of a patch. against both the added and removed bits of a patch.

View File

@ -29,6 +29,7 @@
matcher-project matcher-project
matcher-project/set matcher-project/set
matcher-project/set/single matcher-project/set/single
project-assertions
event? event?
action? action?

View File

@ -19,7 +19,7 @@
(spawn (lambda (e s) (spawn (lambda (e s)
(match e (match e
[(patch added removed) [(patch added removed)
(for [(balance (matcher-project/set/single added (compile-projection (account (?!)))))] (for [(balance (project-assertions added (account (?!))))]
(printf "Balance changed to ~a\n" balance)) (printf "Balance changed to ~a\n" balance))
#f] #f]
[_ #f])) [_ #f]))

View File

@ -18,9 +18,7 @@
(spawn (lambda (e s) (spawn (lambda (e s)
(match e (match e
[(patch added removed) [(patch added removed)
(transition s (for/list [(v (matcher-project/set/single (transition s (for/list [(v (project-assertions added (box-state (?!))))]
added
(compile-projection (box-state (?!)))))]
(log-info "client: learned that box's value is now ~v" v) (log-info "client: learned that box's value is now ~v" v)
(message (set-box (+ v 1)))))] (message (set-box (+ v 1)))))]
[_ #f])) [_ #f]))

View File

@ -73,9 +73,8 @@
(spawn (lambda (e s) (spawn (lambda (e s)
(if (patch? e) (if (patch? e)
(transition s (transition s
(for/list [(id (matcher-project/set/single (for/list [(id (project-assertions (patch-added e)
(patch-added e) (tcp-remote-open (?!))))]
(compile-projection (tcp-remote-open (?!)))))]
(spawn-session id))) (spawn-session id)))
#f)) #f))
(void) (void)

View File

@ -129,7 +129,7 @@
(spawn (lambda (e s) (spawn (lambda (e s)
(match e (match e
[(? patch? p) [(? patch? p)
(define n (matcher-project/set/single (patch-added p) (compile-projection (?!)))) (define n (project-assertions (patch-added p) (?!)))
(for [(b n)] (printf "binding update: ~v\n" b)) (for [(b n)] (printf "binding update: ~v\n" b))
#f] #f]
[_ #f])) [_ #f]))

View File

@ -107,7 +107,7 @@
(spawn (lambda (e s) (spawn (lambda (e s)
(match e (match e
[(? patch? p) [(? patch? p)
(define n (matcher-project/set/single (patch-added p) (compile-projection (?!)))) (define n (project-assertions (patch-added p) (?!)))
(for [(b n)] (printf "binding update: ~v\n" b)) (for [(b n)] (printf "binding update: ~v\n" b))
#f] #f]
[_ #f])) [_ #f]))

View File

@ -50,6 +50,7 @@
matcher-key-set/single matcher-key-set/single
matcher-project/set matcher-project/set
matcher-project/set/single matcher-project/set/single
project-assertions ;; composition of matcher-project/set/single with compile-projection
;; Printing and Serialization ;; Printing and Serialization
pretty-print-matcher pretty-print-matcher
@ -818,6 +819,10 @@
(define-syntax-rule (matcher-project/set/single arg ...) (define-syntax-rule (matcher-project/set/single arg ...)
(matcher-key-set/single (matcher-project arg ...))) (matcher-key-set/single (matcher-project arg ...)))
;; Ultra-convenience form.
(define (project-assertions m . ps)
(matcher-project/set/single m (compile-projection* ps)))
;; struct-type -> Symbol ;; struct-type -> Symbol
;; Extract just the name of the given struct-type. ;; Extract just the name of the given struct-type.
(define (struct-type-name st) (define (struct-type-name st)