From 431381e3fb2c69a6c5ba84c36440d0cf969e9f29 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@hornquist.se>
Date: Tue, 13 Nov 2018 00:24:01 +0100
Subject: Add define-stateful-method.

---
 control/monad/state.scm | 35 +++++++++++++++++------------------
 1 file changed, 17 insertions(+), 18 deletions(-)

(limited to 'control/monad/state.scm')

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"
-- 
cgit v1.2.3