blob: e964b48118111b5bafd66b966a91324ee7b8fd3f (
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
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
|
(define-module (control monad)
#:use-module (control monad procedures)
#:use-module (srfi srfi-1)
#:use-module (ice-9 match)
#:use-module (ice-9 curried-definitions)
#:replace (do)
#:export (sequence mapM
fmap <$> cmap <*>)
#:re-export (>> >>= return))
(define-syntax do
(syntax-rules (<- let =)
((_ let ptrn = val rest ...)
(match val
(ptrn (do rest ...))))
((_ ptrn <- val rest ...)
(>>= val (match-lambda (ptrn (do rest ...)))))
((_ a) a) ; Base case
((_ token rest ...)
(>> token (do rest ...)))))
;;; ----------------------------------------
(define (fmap f m)
(>>= m (lambda (x) ((return m) (f x)))))
(define <$> fmap)
;; Curried map
(define (cmap f)
(lambda (m) (fmap f m)))
(define (<*> f_ i_)
(do f <- f_
i <- i_
((return f_) (f i))))
;;; ----------------------------------------
;; sequence :: (list (M a)) → M (list a)
(define (sequence in-list)
"Evaluate each monadic action in the structure from left to right, and collect
the results. For a version that ignores the results see sequence_.
https://hackage.haskell.org/package/base-4.12.0.0/docs/Control-Monad.html#g:4"
(define ((f done) item) (append done (list item)))
(fold (lambda (m-item m-done)
#!curly-infix {{ f <$> m-done } <*> m-item })
((return (car in-list)) '())
in-list))
;; mapM :: (a -> M b) x (list a) → M (list b)
(define (mapM proc items)
"Map each element of a structure to a monadic action, evaluate these actions from
left to right, and collect the results. For a version that ignores the results
see mapM_.
https://hackage.haskell.org/package/base-4.12.0.0/docs/Control-Monad.html#g:4"
(sequence (map proc items)))
|
