blob: e5dc89d0c92b32be5de87ef0786d6c05299c9b4f (
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
|
(define-module (control monad)
#:use-module (control monad procedures)
;; #:use-module (control monad syntax)
#:export (do <-)
;; #:re-export (>>= do <-)
)
(define-syntax do
(syntax-rules (<- let =)
((_ let var = val rest ...)
(let ((var val)) (do rest ...)))
((_ ptrn <- val rest ...)
(<- ptrn val rest ...))
((_ a) a)
((_ token rest ...)
(begin token (do rest ...)))))
(define-syntax <-
(syntax-rules (just writer)
((_ (just var) val rest ...)
(>>= val (lambda (var) rest ...)))
((_ (writer var) val rest ...)
(>>= val (lambda (var) rest ...))))
#;
(lambda (x)
(syntax-case x (just writer)
((_ (just var) val rest ...)
#'(>>= val (lambda (var) rest ...)))
((_ (writer var) val rest ...)
#'(>>= val (lambda (var) rest ...)))
#;
((_ (left var) val rest ...) ;
#'(>>= val (lambda (var) rest ...)))
#;
((_ (right var) val rest ...) ;
#'(>>= val (lambda (var) rest ...))))))
|
