blob: 707dc0b85d1af9c8d4d92d92b31d10e40d7865ee (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
|
(define-module (control monad procedures)
#:use-module (oop goops)
#:use-module (srfi srfi-1) ; concatenate!
#:export (>> >>= return))
(define-generic return)
(define-method (return (a <top>)) identity)
(define-method (return (a <pair>)) list)
(define-generic >>=)
(define-method (>>= (a <top>) (proc <procedure>))
(proc a))
(define-method (>>= (this <null>) proc) '())
(define-method (>>= (this <pair>)
(proc <procedure>))
(concatenate! (map proc this)))
(define-generic >>)
(define-method (>> (a <top>) (b <top>))
(>>= a (lambda args b)))
(define-method (>> (a <null>) (b <null>)) '())
(define-method (>> (a <pair>) (b <null>)) '())
(define-method (>> (a <null>) (b <pair>)) '())
(define-method (>> (a <pair>) (b <pair>))
(concatenate! (map (const b) a)))
;; bind :: Monad m => m a -> (a -> m b) -> m b
;; return :: Monad m => a -> m a
;; map :: Functor f => (a -> b) -> f a -> f b
|
