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

Add match-event and accept void from behaviour functions

This commit is contained in:
Tony Garnock-Jones 2016-03-01 16:45:29 -05:00
parent 44b0903c91
commit c0b84e1915
2 changed files with 16 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
prospect/core.rkt
View File

@ -33,6 +33,7 @@
event?
action?
match-event
meta-label?
@ -125,6 +126,11 @@
(define (event? x) (or (patch? x) (message? x)))
(define (action? x) (or (event? x) (spawn? x) (quit-network? x)))
(define-syntax-rule (match-event e clause ...)
(match e
clause ...
[_ #f]))
(define (prepend-at-meta pattern level)
(if (zero? level)
pattern
@ -153,19 +159,20 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define (general-transition? v)
(or (not v) (transition? v) (quit? v)))
(or (not v) (transition? v) (quit? v) (void? v)))
(define (ensure-transition v)
(if (general-transition? v)
v
(raise (exn:fail:contract (format "Expected transition, quit or #f; got ~v" v)
(raise (exn:fail:contract (format "Expected transition, quit, #f or (void); got ~v" v)
(current-continuation-marks)))))
(define (clean-transition t)
(match t
[#f #f]
[(quit exn actions) (quit exn (clean-actions actions))]
[(transition state actions) (transition state (clean-actions actions))]))
[(transition state actions) (transition state (clean-actions actions))]
[(? void?) #f]))
(define (clean-actions actions)
(filter (lambda (x) (and (action? x) (not (patch-empty? x)))) (flatten actions)))

15
prospect/examples/bank-account.rkt
View File

@ -5,22 +5,19 @@
(struct deposit (amount) #:prefab)
(define (manager e balance)
(match e
(match-event e
[(message (deposit amount))
(transition (+ balance amount) (patch-seq (retract (account balance))
(assert (account (+ balance amount)))))]
[_ #f]))
(assert (account (+ balance amount)))))]))
(define (observer e _)
(when (patch? e) (for [(balance (project-assertions (patch-added e) (account (?!))))]
(printf "Balance changed to ~a\n" balance)))
#f)
(printf "Balance changed to ~a\n" balance))))
(define (updater e _)
(if (and (patch? e) (trie-non-empty? (patch-added e)))
(quit (list (message (deposit +100))
(message (deposit -30))))
#f))
(when (and (patch? e) (trie-non-empty? (patch-added e)))
(quit (list (message (deposit +100))
(message (deposit -30))))))
(spawn manager 0 (patch-seq (assert (observe (deposit ?))) (assert (account 0))))
(spawn observer (void) (assert (observe (account ?))))