diff options
author | Hugo Hörnquist <hugo@hornquist.se> | 2018-11-13 00:24:01 +0100 |
---|---|---|
committer | Hugo Hörnquist <hugo@hornquist.se> | 2018-11-13 00:24:01 +0100 |
commit | 431381e3fb2c69a6c5ba84c36440d0cf969e9f29 (patch) | |
tree | 86e4c8478857ed1110c4fbc03cdd066ba3dba5e6 /control/monad | |
parent | run-state, >>=, and >> now correctly defined for <state>. (diff) | |
download | scheme-monad-431381e3fb2c69a6c5ba84c36440d0cf969e9f29.tar.gz scheme-monad-431381e3fb2c69a6c5ba84c36440d0cf969e9f29.tar.xz |
Add define-stateful-method.
Diffstat (limited to '')
-rw-r--r-- | control/monad/state.scm | 35 |
1 files changed, 17 insertions, 18 deletions
diff --git a/control/monad/state.scm b/control/monad/state.scm index 3ebdcc6..e369d5d 100644 --- a/control/monad/state.scm +++ b/control/monad/state.scm @@ -28,26 +28,25 @@ "Creates a state object from a State procedure" (make <state> #:proc proc)) -(define-method (>>= (st <state>) f) - (make-state - (lambda (st-list) - (let ((new-st-list ((proc st) st-list))) - (match new-st-list - ((v _) - ((proc (f v)) new-st-list))))))) +(define-syntax-rule (define-stateful ((proc args ...) st) body ...) + (define (proc args ...) + (make-state + (lambda (st) body ...)))) -(define-method (>> (a <state>) (b <state>)) - (make-state - (lambda (st-list-a) - (let ((st-list-b ((proc a) st-list-a))) - ((proc b) st-list-b))))) +(define-syntax-rule (define-stateful-method ((proc args ...) st) body ...) + (define-method (proc args ...) + (make-state + (lambda (st) body ...)))) -(define-syntax define-stateful - (syntax-rules () - ((_ ((proc args ...) st) body ...) - (define (proc args ...) - (make-state - (lambda (st) body ...)))))) +(define-stateful-method ((>>= (st <state>) f) st-list) + (let ((new-st-list ((proc st) st-list))) + (match new-st-list + ((v _) + ((proc (f v)) new-st-list))))) + +(define-stateful-method ((>> (a <state>) (b <state>)) st-list-a) + (let ((st-list-b ((proc a) st-list-a))) + ((proc b) st-list-b))) (define-stateful ((return-state v) st-list) "Sets the return value to v" |