aboutsummaryrefslogtreecommitdiff
path: root/examples
diff options
context:
space:
mode:
Diffstat (limited to 'examples')
-rw-r--r--examples/state.scm46
1 files changed, 30 insertions, 16 deletions
diff --git a/examples/state.scm b/examples/state.scm
index 21efc1b..2594a74 100644
--- a/examples/state.scm
+++ b/examples/state.scm
@@ -1,5 +1,8 @@
-(module (data state)
- (run get put map pure map2 >>=)
+(import (algebraic-structures functor)
+ (algebraic-structures applicative)
+ (algebraic-structures monad))
+
+(module (data state) (run get put)
(import (except scheme map)
(only (chicken base) void assert)
matchable)
@@ -13,12 +16,25 @@
(define (put st)
(lambda (_st)
- (cons (void) st)))
-
- (define (map f m)
+ (cons (void) st))))
+
+(module (data state functor) = (algebraic-structures functor)
+ (import scheme
+ matchable
+ (chicken module))
+ (export map1)
+
+ (define (map1 f m)
(lambda (st)
(match-let ([(x . st*) (m st)])
- (cons (f x) st*))))
+ (cons (f x) st*)))))
+
+(module (data state applicative) = (algebraic-structures applicative)
+ (import scheme
+ matchable
+ (chicken module))
+ (reexport (data state functor))
+ (export pure map2)
(define (pure x)
(lambda (st) (cons x st)))
@@ -27,7 +43,14 @@
(lambda (st)
(match-let* ([(x . st*) (m1 st)]
[(y . st**) (m2 st*)])
- (cons (f x y) st**))))
+ (cons (f x y) st**)))))
+
+(module (data state monad) = (algebraic-structures monad)
+ (import (except scheme map apply)
+ matchable
+ (chicken module))
+ (reexport (data state applicative))
+ (export >>=)
(define (>>= m f)
(lambda (st)
@@ -35,16 +58,7 @@
[(x* . st**) ((f x) st*)])
(cons x* st**)))))
-(import (only (algebraic-structures functor))
- (only (algebraic-structures applicative))
- (only (algebraic-structures monad)))
-(module (data state functor) = ((algebraic-structures functor) (data state)))
-(module (data state applicative) = ((algebraic-structures applicative) (data state)))
-(module (data state monad) = ((algebraic-structures monad) (data state)))
-
(import (prefix (data state) st:)
- (prefix (data state functor) st:)
- (prefix (data state applicative) st:)
(prefix (data state monad) st:))
;; (st:run (st:do (x <- st:get)