2017-10-18 18:11:38 +00:00
|
|
|
#lang typed/syndicate
|
|
|
|
|
2017-12-13 17:16:10 +00:00
|
|
|
(define-constructor (account balance)
|
|
|
|
#:type-constructor AccountT
|
|
|
|
#:with Account (AccountT Int)
|
|
|
|
#:with AccountRequest (AccountT ★))
|
|
|
|
|
|
|
|
(define-constructor (deposit amount)
|
|
|
|
#:type-constructor DepositT
|
|
|
|
#:with Deposit (DepositT Int)
|
|
|
|
#:with DepositRequest (DepositT ★))
|
|
|
|
|
2017-10-18 18:11:38 +00:00
|
|
|
(define-type-alias ds-type
|
2017-12-13 17:16:10 +00:00
|
|
|
(U Account
|
|
|
|
(Observe AccountRequest)
|
|
|
|
(Observe (Observe AccountRequest))
|
|
|
|
Deposit
|
|
|
|
(Observe DepositRequest)
|
|
|
|
(Observe (Observe DepositRequest))))
|
2017-10-18 18:11:38 +00:00
|
|
|
|
|
|
|
(dataspace ds-type
|
|
|
|
|
|
|
|
(spawn ds-type
|
|
|
|
(facet _
|
|
|
|
(fields [balance Int 0])
|
2017-12-13 17:16:10 +00:00
|
|
|
(assert (account (ref balance)))
|
|
|
|
(on (asserted (deposit (bind amount Int)))
|
2017-10-18 18:11:38 +00:00
|
|
|
(set! balance (+ (ref balance) amount)))))
|
|
|
|
|
|
|
|
(spawn ds-type
|
|
|
|
(facet _
|
|
|
|
(fields)
|
2017-12-13 17:16:10 +00:00
|
|
|
(on (asserted (account (bind amount Int)))
|
2017-10-18 18:11:38 +00:00
|
|
|
(displayln amount))))
|
|
|
|
|
|
|
|
(spawn ds-type
|
|
|
|
(facet _
|
|
|
|
(fields)
|
2017-12-13 17:16:10 +00:00
|
|
|
(on (asserted (observe (deposit discard)))
|
2017-10-18 18:11:38 +00:00
|
|
|
(facet _
|
|
|
|
(fields)
|
2017-12-13 17:16:10 +00:00
|
|
|
(assert (deposit 100))
|
|
|
|
(assert (deposit -30)))))))
|
2017-10-18 18:11:38 +00:00
|
|
|
|
|
|
|
#|
|
|
|
|
;; Hello-worldish "bank account" example.
|
|
|
|
|
|
|
|
(struct account (balance) #:prefab)
|
|
|
|
(struct deposit (amount) #:prefab)
|
|
|
|
|
|
|
|
(spawn (field [balance 0])
|
|
|
|
(assert (account (balance)))
|
|
|
|
(on (message (deposit $amount))
|
|
|
|
(balance (+ (balance) amount))))
|
|
|
|
|
|
|
|
(spawn (on (asserted (account $balance))
|
|
|
|
(printf "Balance changed to ~a\n" balance)))
|
|
|
|
|
|
|
|
(spawn* (until (asserted (observe (deposit _))))
|
|
|
|
(send! (deposit +100))
|
|
|
|
(send! (deposit -30)))
|
|
|
|
|#
|