diff options
author | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-06-24 04:48:52 +0200 |
---|---|---|
committer | Hugo Hörnquist <hugo@lysator.liu.se> | 2022-06-24 04:48:52 +0200 |
commit | 656fb512bf007abca6a7ac0aef6d035b7d5fce01 (patch) | |
tree | 3e5837bb18b3328ddd7a69f08d71a19730e5d8a8 /monad/either.scm | |
parent | Add MIT-License. (diff) | |
download | scheme-monad-master.tar.gz scheme-monad-master.tar.xz |
Diffstat (limited to 'monad/either.scm')
-rw-r--r-- | monad/either.scm | 33 |
1 files changed, 16 insertions, 17 deletions
diff --git a/monad/either.scm b/monad/either.scm index c597a60..c8f6487 100644 --- a/monad/either.scm +++ b/monad/either.scm @@ -1,30 +1,29 @@ -;;; TODO UNFINISHED - -(define-module (data either) +(define-module (monad either) #:use-module (oop goops) - #:use-module (ice-9 match)) + #:use-module (monad) + #:export (left right) + #:re-export (>>= >> return) + ) (define-class <either> () - (slot #:init-keyword #:slot) - (dir #:init-keyword #:dir #:init-value 'left)) + (slot #:init-keyword #:slot + #:getter unwrap-either)) +(define-class <left> (<either>)) +(define-class <right> (<either>)) (define (left val) "Error values" - (make <either> #:slot val #:dir 'left)) + (make <left> #:slot val)) (define (right val) "Good values" - (make <either> #:slot val #:dir 'right)) + (make <right> #:slot val)) (define-method (write (this <either>) port) - (format port "[~a ~s]" - (slot-ref this 'dir) - (slot-ref this 'slot))) + (format port "#<~a ~s>" (class-name (class-of this)) (unwrap-either this))) -(define-method (>>= (this <either>) - (proc <procedure>)) - (case (slot-ref this 'dir) - ((left) this) - ((right) (match this (($ <either> slot) (proc slot)))))) +(define-method (>>= (this <left>) (_ <procedure>)) this) +(define-method (>>= (this <right>) (proc <procedure>)) + (proc (unwrap-either this))) -(define return-either right) +(define-method (return (_ <either>)) right) |