aboutsummaryrefslogtreecommitdiff
path: root/module/hnh/util/state-monad.scm
diff options
context:
space:
mode:
Diffstat (limited to 'module/hnh/util/state-monad.scm')
-rw-r--r--module/hnh/util/state-monad.scm22
1 files changed, 21 insertions, 1 deletions
diff --git a/module/hnh/util/state-monad.scm b/module/hnh/util/state-monad.scm
index 67716a5b..91201583 100644
--- a/module/hnh/util/state-monad.scm
+++ b/module/hnh/util/state-monad.scm
@@ -13,7 +13,8 @@
:use-module (ice-9 curried-definitions)
:replace (do mod)
:export (with-temp-state
- <$> return get get* put put* sequence lift))
+ <$> return get get* put put* sequence lift
+ eval-state exec-state))
(define-syntax do
(syntax-rules (<- let =)
@@ -98,3 +99,22 @@
(define (lift proc . arguments)
(do xs <- (sequence arguments)
(return (apply proc xs))))
+
+
+;; Run state, returning value
+(define (eval-state st init)
+ (call-with-values
+ (lambda ()
+ (if (procedure? init)
+ (call-with-values init st)
+ (st init)))
+ (lambda (r . _) r)))
+
+;; Run state, returning state
+(define (exec-state st init)
+ (call-with-values
+ (lambda ()
+ (if (procedure? init)
+ (call-with-values init st)
+ (st init)))
+ (lambda (_ . v) (apply values v))))