From 3cd662e0bb4ae8cf5130a1e47de90c4a241ef3e1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@hornquist.se>
Date: Sat, 10 Nov 2018 01:44:57 +0100
Subject: Optional bindings now much better.

---
 state-monad.scm | 26 +++++++++++++-------------
 1 file changed, 13 insertions(+), 13 deletions(-)

diff --git a/state-monad.scm b/state-monad.scm
index b261d95..d8d96e3 100644
--- a/state-monad.scm
+++ b/state-monad.scm
@@ -38,14 +38,13 @@ runState (return "X") 1
       (format port "[Just ~s]" (slot-ref this 'slot))
       (format port "[Nothing]")))
 
-
 ;; bind :: Monad m => m a -> (a -> m b) -> m b
 ;; return :: Monad m => a -> m a
 ;; map :: Functor f => (a -> b) -> f a -> f b
 
 (define-method (>>= (this <optional>)
                     (proc <procedure>))
-  (cond ((nothing? this) nothing)
+  (cond ((nothing? this) (nothing))
         ((just? this) 
          (match this
            (($ <optional> slot) (proc slot))))))
@@ -59,10 +58,10 @@ runState (return "X") 1
   (concatenate! (map proc this)))
 
 (define-syntax do
-  (syntax-rules (<- let x)
-    ((_ (let var = val) rest ...)
+  (syntax-rules (<- let =)
+    ((_ let var = val rest ...)
      (let ((var val)) (do rest ...)))
-    ((_ (<- ptrn val) rest ...)
+    ((_ ptrn <- val rest ...)
      (<- ptrn val rest ...))
     ((_ a) a)
     ((_ token rest ...)
@@ -72,15 +71,16 @@ runState (return "X") 1
   (lambda (x)
     (syntax-case x (just)
       ((_ (just var) val rest ...)
-       #'(match val
-           (($ <optional> slot)
-            (let ((var slot))
-              rest ...)))))))
+       #'(>>= val (lambda (var) rest ...))))))
 
 ;;; Examples:
 
-(do { (just x) <- (just 10) } x) ; => 10
+(do (just x) <- (just 10)
+    x) ; => 10
+
+(do let y = (just 10)
+    (just x) <- y
+    (+ x 5)) ; => 15
 
-(let ((j (just 10)))
-  (do { (just x) <- j }
-      (+ x 10))) ; => 20
+(do (just x) <- (nothing)
+    (+ x 5)) ; => [Nothing]
-- 
cgit v1.2.3