aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@hornquist.se>2018-11-13 00:08:51 +0100
committerHugo Hörnquist <hugo@hornquist.se>2018-11-13 00:08:51 +0100
commitaed7b1d37cdf6b28f88815af9a2954bbc3113154 (patch)
tree514404c5c328beb7b0bcb1e8fd4392ee90969c76
parentMove state-minimal to examples. (diff)
downloadscheme-monad-aed7b1d37cdf6b28f88815af9a2954bbc3113154.tar.gz
scheme-monad-aed7b1d37cdf6b28f88815af9a2954bbc3113154.tar.xz
Introduce define-stateful macro.
-rw-r--r--control/monad/state.scm29
1 files changed, 15 insertions, 14 deletions
diff --git a/control/monad/state.scm b/control/monad/state.scm
index 7e81b38..a8e7775 100644
--- a/control/monad/state.scm
+++ b/control/monad/state.scm
@@ -40,25 +40,26 @@
(let ((st-list-b ((proc a) st-list-a)))
((proc b) st-list-b))))
-(define (return-state v)
+(define-syntax define-stateful
+ (syntax-rules ()
+ ((_ ((proc args ...) st) body ...)
+ (define (proc args ...)
+ (make-state
+ (lambda (st) body ...))))))
+
+(define-stateful ((return-state v) st-list)
"Sets the return value to v"
- (make-state
- (lambda (st-list)
- (cons v (cdr st-list)))))
+ (cons v (cdr st-list)))
-(define (get)
+(define-stateful ((get) st-list)
"Sets the return value of state to st."
- (make-state
- (lambda (st-list)
- (match st-list
- ((_ st)
- (list st st))))))
+ (match st-list
+ ((_ st)
+ (list st st))))
-(define (put v)
+(define-stateful ((put v) st-list)
"Sets st to v."
- (make-state
- (lambda (st-list)
- (list '() v))))
+ (list '() v))
(define-method (run-state st-proc init)
"Exec state with init as starting state value and st."