From 3d7a71bfdbbc80409ed6baa27c63dbae9c471ca8 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= Date: Mon, 10 Apr 2023 22:40:29 +0200 Subject: Add eval- and exec-state. --- module/hnh/util/state-monad.scm | 22 +++++++++++++++++++++- 1 file changed, 21 insertions(+), 1 deletion(-) 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)))) -- cgit v1.2.3