diff options
Diffstat (limited to 'module')
-rw-r--r-- | module/hnh/util/state-monad.scm | 22 |
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)))) |