blob: 4b10a725e6c9a467c24133b5888593effc63ce89 (
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
|
;;; ???
(define-module (monad monoid)
#:use-module (oop goops)
#:use-module (srfi srfi-1)
#:export (null mappend <>))
(define-generic null)
(define-generic mappend)
(define (<> . args)
(fold mappend (null (car args)) (reverse args)))
;;; Lists
(define-method (mappend (a <pair>) (b <pair>))
(append a b))
(define-method (mappend (a <pair>) (b <null>)) a)
(define-method (mappend (a <null>) (b <pair>)) b)
(define-method (mappend (a <null>) (b <null>)) '())
(define-method (null (a <pair>)) '())
(define-method (null (a <null>)) '())
;;; Strings
(define-method (mappend (a <string>) (b <string>))
(string-append a b))
(define-method (null (a <string>)) "")
|