Add define-stateful-method.

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"