aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@lysator.liu.se>2018-11-16 00:09:13 +0100
committerHugo Hörnquist <hugo@lysator.liu.se>2018-11-16 00:09:13 +0100
commit6269a1345996b96e2194a54c34028ab73d27a004 (patch)
tree415b9f2741657aa0a9ea3efbad7eb8da6abc7cc5
parentAdd modify to (control monad state). (diff)
downloadscheme-monad-6269a1345996b96e2194a54c34028ab73d27a004.tar.gz
scheme-monad-6269a1345996b96e2194a54c34028ab73d27a004.tar.xz
Add fmap instance for state monad.
-rw-r--r--control/monad/state.scm11
1 files changed, 8 insertions, 3 deletions
diff --git a/control/monad/state.scm b/control/monad/state.scm
index 603e387..f7190af 100644
--- a/control/monad/state.scm
+++ b/control/monad/state.scm
@@ -2,8 +2,9 @@
#:use-module (oop goops)
#:use-module (ice-9 match)
#:use-module (control monad)
- #:re-export (>>= >>))
- #:export (return-state run-state get put modify))
+ #:use-module (data functor)
+ #:export (return-state run-state get put modify)
+ #:re-export (>>= >> fmap))
;; Alternative implementation of get.
@@ -71,7 +72,11 @@
((r s)
(list '() (proc s)))))
+(define-stateful-method ((fmap (f <procedure>) (s <state>)) st-list)
+ (match ((proc s) st-list)
+ ((r st)
+ (list (f r) st))))
+
(define-method (run-state (st <state>) init)
"Exec state with init as starting state value and st."
((proc st) (list init init)))
-