aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@hornquist.se>2018-11-10 18:43:54 +0100
committerHugo Hörnquist <hugo@hornquist.se>2018-11-10 18:43:54 +0100
commit2754eae6d0c66b2838dc7566904d920ce216dddc (patch)
tree6a15ee7ee897e6b7aed4a5ef412a804516addf77
parentFix problem with do notation being really broken. (diff)
downloadscheme-monad-2754eae6d0c66b2838dc7566904d920ce216dddc.tar.gz
scheme-monad-2754eae6d0c66b2838dc7566904d920ce216dddc.tar.xz
Fixed up examples.
-rw-r--r--data/optional.scm9
-rw-r--r--data/writer.scm5
-rw-r--r--examples.scm45
3 files changed, 16 insertions, 43 deletions
diff --git a/data/optional.scm b/data/optional.scm
index a1968f0..e71c10d 100644
--- a/data/optional.scm
+++ b/data/optional.scm
@@ -5,8 +5,8 @@
#:export (nothing just
nothing? just?
return-optional)
- #:re-export (>>=)
- )
+ ;; TODO is this reexport needed?
+ #:re-export (>>=))
(define-class <optional> ()
(slot #:init-value #f
@@ -40,8 +40,3 @@
((just? this)
(match this
(($ <optional> slot) (proc slot))))))
-
-#;
-(define-method (mappend (a <optional>) (b <optional>))
- (match a
- (($ ))))
diff --git a/data/writer.scm b/data/writer.scm
index b79c670..462d391 100644
--- a/data/writer.scm
+++ b/data/writer.scm
@@ -3,7 +3,7 @@
#:use-module (ice-9 match)
#:use-module (data monoid)
#:use-module (control monad)
- #:export (writer))
+ #:export (writer return-writer))
(read-enable 'curly-infix)
@@ -23,6 +23,9 @@
(($ <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))))
diff --git a/examples.scm b/examples.scm
index a2f2319..3b67f60 100644
--- a/examples.scm
+++ b/examples.scm
@@ -10,52 +10,27 @@
(data optional)
(data writer))
-(do (just x) <- (just 10)
+(do x <- (just 10)
x) ; => 10
(do let y = (just 10)
- (just x) <- y
+ x <- y
(+ x 5)) ; => 15
-(do (just x) <- (nothing)
+(do x <- (nothing)
(+ x 5)) ; => [Nothing]
-;;;
+(do x <- (just 10)
+ y <- (just 20)
+ (+ x y)) ; => 30
-(do let either = left 10
- (left x) <- either
- x) ; EVALUATION ERROR
+;;;
;; Int -> Writer Int String
(define (log-number n)
(writer n (format #f "Got nuber: ~a" n)))
-(define (mult-with-log)
- (do (writer a) <- (log-number 3)
- (writer b) <- (log-number 5)
- (* a b)))
-
-(do (writer a) <- (log-number 1)
- a) ; EVALUATION ERROR
-
-(begin { (log-number 1) >>= log-number })
-;; => [Writer 1, "Got nuber: 1, Got nuber: 1"]
-
-(do (writer a) <- (log-number 3)
- (writer b) <- (log-number 5)
+(do a <- (log-number 3)
+ b <- (log-number 5)
(writer (* a b) ""))
-;; EVALUATION ERROR
-;; => [Writer 3, "Got nuber: 3, base"]
-
-(log-number 3) ; => [Writer 3, "Got nuber: 3"]
-(just 1) ; => [Just 1]
-
-(do let y = 5
- (just x) <- (just 10)
- (just (* x y)))
-;; => [Just 50]
-
-;;; TODO
-;;; '<- and 'let can't be used after '<-
-
-
+;; => [Writer 15, "Got nuber: 3, Got nuber: 5, "]