blob: 06c0e67d647a16a9054b4126abba1d13c2609b6f (
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
58
59
60
61
62
63
64
65
66
67
68
|
;;; Commentary:
;;
;; Your classical optional (Maybe) monad.
;; It has the constructors @code{just} and @code{nothing}.
;;
;;; Code:
(define-module (monad optional)
#:use-module (oop goops)
#:use-module (ice-9 match)
#:use-module (monad)
#:use-module (ice-9 curried-definitions)
#:export (from-just wrap-maybe
nothing just
nothing? just?)
#:re-export (>>= >> return))
(define-class <optional> ()
(slot #:init-value #f
#:init-keyword #:slot)
(just #:init-value #t
#:init-keyword #:just))
(define (nothing) (make <optional> #:just #f))
(define (just obj) (make <optional>
#:just #t
#:slot obj))
(define (nothing? this)
(not (slot-ref this 'just)))
(define (just? this)
(not (nothing? this)))
(define (from-just default maybe-val)
"Returns default if maybe-val is nothing, otherwise
the value embedded in maybe-val"
(if (just? maybe-val)
(slot-ref maybe-val 'slot)
default))
(define ((wrap-maybe proc) . values)
"Wraps a function in an optional monad, where #f returns are translated to
nothing."
(let ((v (apply proc values)))
(if v (just v) (nothing))))
(define-method (write (this <optional>) port)
(if (just? this)
(format port "[Just ~s]" (slot-ref this 'slot))
(format port "[Nothing]")))
(define-method (>>= (this <optional>)
(proc <procedure>))
(cond ((nothing? this) (nothing))
((just? this)
(match this
(($ <optional> slot) (proc slot))))))
(define-method (return (a <optional>)) just)
(define-method (equal? (a <optional>)
(b <optional>))
(or (and (nothing? a) (nothing? b))
(from-just #f (do aa <- a
bb <- b
(just (equal? aa bb))))))
|
