blob: 462d391a07bc49260fe24ed84f6d05737e47ce83 (
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
|
(define-module (data writer)
#:use-module (oop goops)
#:use-module (ice-9 match)
#:use-module (data monoid)
#:use-module (control monad)
#:export (writer return-writer))
(read-enable 'curly-infix)
(define-class <writer> ()
(value #:init-keyword #:value)
(monoid #:init-keyword #:monoid))
(define (writer value context)
(make <writer>
#:value value
#:monoid context))
(define-method (>>= (this <writer>)
(proc <procedure>))
(match this (($ <writer> value monoid)
(match (proc value)
(($ <writer> nval ncontext)
(writer nval { monoid <> ", " <> ncontext }))))))
(define (return-writer val)
(writer val ""))
(define-method (write (this <writer>) port)
(match this (($ <writer> value monoid)
(format port "[Writer ~s, ~s]" value monoid))))
|
